Question

我是Delphi的新手，但我需要修复Delphi代码，以便在执行“Service start”时安装网络磁盘。默认情况下，当我的应用程序通过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不能正常工作（对我来说不清楚）。

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

将服务登录设置为具有所需文件的正确（和测试）网络读/写/执行权限的帐户。请记住默认情况下使用“系统”帐户运行的服务，这对于访问本地资源是可以的，但对于网络资源则没有那么好。
要为允许在其他用户的上下文中启动'alestart.exe'的人更改ShellExecute方法（该服务作为系统运行，请在其配置中存储启动'alestart的用户凭据。 exe'进程。要在不同用户的上下文中启动进程，可以使用CreateProcessWithLogonW API调用。为此，您的进程必须启用SeImpersonatePrivilege。

问候。

如何在Delphi Service中安装网络磁盘？

1 个答案: