如何在Delphi服務中安裝網絡磁盤？

我是Delphi新手，但我需要修復Delphi代碼，以便在執行「服務啓動」時安裝網絡磁盤。默認情況下，當通過Windows Service啓動我的應用程序時，應用程序無法訪問網絡磁盤，因此解決方案是將UNC映射腳本插入到我的服務中。你能幫我解決這個問題嗎？如何在Delphi服務中安裝網絡磁盤？

Thx很多。

unit ALFTSASvcUnit; 


interface 

uses 
    Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, ShellAPI, TLHelp32, StrUtils; 

type 
    TALFTSAService = class(TService) 
    procedure ServiceStart(Sender: TService; var Started: Boolean); 
    procedure ServiceStop(Sender: TService; var Stopped: Boolean); 
    procedure ServiceExecute(Sender: TService); 
    private 
    { Private declarations } 
    function CountSAAProcs(ProcName : string) : integer; 
    public 
    function GetServiceController: TServiceController; override; 
    { Public declarations } 
    end; 

var 
    ALFTSAService: TALFTSAService; 
    ALLIANCE : string; 
    ARCH : string; 

implementation 

{$R *.DFM} 

function TALFTSAService.CountSAAProcs(ProcName : string) : integer; 
var 
    MyHandle : THandle; 
    Struct: TProcessEntry32; 
begin 
    Result := 0; 
    MyHandle:=CreateToolHelp32SnapShot(TH32CS_SNAPPROCESS, 0); 
    Struct.dwSize:=Sizeof(TProcessEntry32); 
    if Process32First(MyHandle, Struct) then 
    begin 
    if AnsiStartsText(ProcName, Struct.szExeFile) then 
     inc(Result); 
    while Process32Next(MyHandle, Struct) do 
     if AnsiStartsText(ProcName, Struct.szExeFile) then 
     inc(Result); 
    end; 
    CloseHandle(MyHandle); 
// LogMessage('Number of BS_ processes = ' + IntToStr(Result), EVENTLOG_INFORMATION_TYPE); 
end; 

procedure ServiceController(CtrlCode: DWord); stdcall; 
begin 
    ALFTSAService.Controller(CtrlCode); 
end; 

function TALFTSAService.GetServiceController: TServiceController; 
begin 
    Result := ServiceController; 
end; 

procedure TALFTSAService.ServiceStart(Sender: TService; 
    var Started: Boolean); 
begin 
    ALLIANCE := 'C:\Alliance\Access'; 
    ARCH := 'win32'; 

    if (ALLIANCE <> '') and (ARCH <> '') then 
    begin 
    ShellExecute(0, 'open', PChar(ALLIANCE + '\BSS\BIN\' + ARCH + '\alestart.exe'), '', nil, SW_SHOWNORMAL) ; 
    while (CountSAAProcs('bs_') < 5) do 
     Sleep(10000); 
    while (CountSAAProcs('mxs_') < 8) do 
     Sleep(10000); 
    end 
    else 
    begin 
    LogMessage('Unable to find SWIFTAlliance environment variables %ALLIANCE%, %ARCH%'); 
    Status:=csStopped; 
    end; 
end; 

procedure TALFTSAService.ServiceStop(Sender: TService; var Stopped: Boolean); 
begin 
    ShellExecute(0, 'open', PChar(ALLIANCE + '\BSS\BIN\' + ARCH + '\alestop.exe'), '', nil, SW_SHOWNORMAL) ; 
    while (CountSAAProcs('bs_') > 0) do 
    Sleep(10000); 
    Sleep (10000); 
    while (CountSAAProcs('aleempty') > 0) do 
    Sleep(5000); 
    Sleep(5000); 
end; 

procedure TALFTSAService.ServiceExecute(Sender: TService); 
const 
    SecBetweenRuns = 60; 
var 
    Count: Integer; 
begin 
    Count := 0; 
    while not Terminated do 
    begin 
    Inc(Count); 
    if Count >= SecBetweenRuns then 
    begin 
     Count := 0; 
     if (CountSAAProcs('bs_') < 4) then 
     begin 
     Status:=csStopped; 
     Break; 
     end; 
    end; 
    Sleep(1000); 
    ServiceThread.ProcessRequests(False); 
    end; 
end; 

end.

來源

2010-01-22 Dmitry

什麼？「問題「你有嗎？什麼不正確？還有，你應該嘗試減少你的代碼到相關章節。 – jpfollenius 2010-01-22 15:32:53

哦，因爲這是你的第一個問題：歡迎來到SO！ :) – jpfollenius 2010-01-22 15:37:36

親愛的粉碎者，謝謝你; 一切工作正常，除了訪問我的應用程序中由上述服務啓動的共享磁盤。我是初學者，我無法確定要插入網絡驅動器的位置和功能（如cmd中的「net use」） – Dmitry 2010-01-22 15:41:57

它看起來像這不是德爾福的問題，假設是ShellExecute什麼不好（對我不清楚）。

在這種情況下，它可能是一個[網絡]文件權限的問題，我建議你兩種不同的解決方案之間進行選擇：

要爲服務的登錄設置適當的帳戶（和測試）網絡讀/寫/執行所需文件的權限。請記住默認情況下使用「系統」帳戶運行的服務，這對於訪問本地資源來說是可以的，但對於網絡資源來說並不好。
要更改您的ShellExecute方法，允許在不同用戶的上下文中啓動'alestart.exe'（該服務作爲系統運行，並在其配置中存儲用戶憑據以啓動'alestart'）。 exe文件」的過程。要在可以使用CreateProcessWithLogonW API調用不同的用戶的情況下啓動的過程。在這個爲了你的工作過程必須已經啓用了SeImpersonatePrivilege。

問候。

來源

2010-01-22 16:26:09 jachguate

謝謝jachguate，我會嘗試插入CreateProcessWithLogonW而不是ShellExecute – Dmitry 2010-01-22 17:36:11

如何在Delphi服務中安裝網絡磁盤？

回答

相關問題