如何在Delphi Service中挂载网盘？

Question

我是新手在Delphi，但我需要修复Delphi代码，以便使网络磁盘挂载时，“服务启动”是执行。默认情况下，当我的应用程序通过Windows服务启动时，应用程序无法访问网络磁盘，因此解决方案是在我的服务中插入UNC映射脚本。你能帮我解决这个问题吗？

非常感谢。

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.

Answer 1

看起来这不是Delphi的问题，假设是ShellExecute不能很好地工作(我不清楚)。

在这种情况下，可能是网络文件权限问题，我建议您在两种不同的解决方案中进行选择：

• ，将服务的登录设置为对所需文件具有适当的(经过测试的)网络读/写/执行权限的帐户。记住，默认情况下，服务以“system”帐户运行，这对于访问本地资源是可以的，但对于网络资源则不是那么好。
• 将您的ShellExecute方法更改为允许在不同用户的上下文中启动“alestart.exe”的用户(该服务以system身份运行，在其配置中存储用户启动“alestart.exe”进程的凭据)。要在不同用户的上下文中启动进程，可以使用CreateProcessWithLogonW应用编程接口调用。为了使其正常工作，您的进程必须启用SeImpersonatePrivilege.

致以问候。