How to mount network disks within Delphi Service?

Question

Dear Sirs, I am newbie in Delphi, but I need to fix Delphi code in order to make network disks to be mounted when "Service start" is executed. By default when my application is started via Windows Service network disks are not accessible for application, so the solution is to insert UNC mapping script in my service. Can you help me with this issue?

Thx a lot.

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

It looks like this is not a Delphi problem, supposing is the ShellExecute what doesn't work well (not clear to me).

In this case, it could be a [network] file permissions issue, and I suggest you to choose between two different solutions:

• To set the logon for the service to an account with proper (and tested) network read/write/execute rights for the required files. Remember the services run with the 'system' account by default, which is OK for accesing local resources, but not as good for network ones.
• To change your ShellExecute approach for one who permits the start of the 'alestart.exe' in the context of a different user (the service runs as system, stores in it's configuration the credentials of the user to start the 'alestart.exe' process. To start a process in the context of a different user you can use the CreateProcessWithLogonW API call. In order of this to work your process must have enabled the SeImpersonatePrivilege.

regards.