SocketServer サービスが、英語版以外の Windows上で起動に失敗する

概要: SocketServerサービスが、英語版以外の Windows XPまたは Visuta で起動に失敗します

DataSnap SocketServerサービスは、英語版の Windows上では正しく起動しますが、英語版以外の Windows上では起動に失敗します。この理由は、サービスが “ローカルシステム”のアカウント下で起動する際に、固定されたユーザー名が使用されるためです。この問題を解決するには、ロケール特有のローカルシステムのユーザー名を検索する必要があります。

Delphi7の場合は (Delphiインストールディレクトリ)\Source\Vcl、Delphi7以降のバージョンの場合は、(BDSインストールディレクトリ)\source\Win32\db ディレクトリ内の “ScktSrvr.dpr” の修正が必要となります。

一度、再ビルドされたサービスは、正常に動作します。

function  LocalSystemUserName : string;
const
   SECURITY_LOCAL_SYSTEM_RID       :DWORD = $00000012;
   SECURITY_NT_AUTHORITY : SID_IDENTIFIER_AUTHORITY  =  (Value:(0,0,0,0,0,5));
var
  sia                : SID_IDENTIFIER_AUTHORITY;
  NameSize,
  DomainSize: DWORD;
  pAccountSid : PSID;
  UsrName,DomainName : string;
  SidNameUse    : SID_NAME_USE;
begin
  Result := 'SYSTEM';
  sia := SECURITY_NT_AUTHORITY;
  Win32Check(AllocateAndInitializeSid(sia,1,SECURITY_LOCAL_SYSTEM_RID,
        0, 0, 0, 0, 0, 0, 0, pAccountSid));
  if pAccountSid <> nil then
    try
          NameSize   := 0;
          DomainSize := 0;
          //this will fail but will return the correct buffer sizes
          LookupAccountSID(nil, pAccountSid, nil, NameSize, nil, DomainSize, SidNameUse);
          //buffer to small error
          if (GetLastError = $7A) and ((NameSize > 0) and (DomainSize > 0))  then 
          begin
            SetLength(UsrName,NameSize);
            SetLength(DomainName,DomainSize);
            Win32Check(LookupAccountSID(nil, pAccountSid,PChar(UsrName), NameSize, 
PChar(DomainName), DomainSize, SidNameUse));
            SetLength(UsrName,NameSize);
            Result := UsrName;
          end;
    finally
      FreeSid(pAccountSid);
    end;
end;
function StartService: Boolean;
var
  Mgr, Svc: Integer;
  UserName, ServiceStartName: string;
  Config: Pointer;
  Size: DWord;
begin
  Result := False;
  Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  if Mgr <> 0 then
  begin
    Svc := OpenService(Mgr, PChar(SServiceName), SERVICE_ALL_ACCESS);
    Result := Svc <> 0;
    if Result then
    begin
      QueryServiceConfig(Svc, nil, 0, Size);
      Config := AllocMem(Size);
      try
        QueryServiceConfig(Svc, Config, Size, Size);
        ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
        if CompareText(ServiceStartName, 'LocalSystem') = 0 then
           ServiceStartName := LocalSystemUserName;         
        //Moved 
        Size := 256;
        SetLength(UserName, Size);
        GetUserName(PChar(UserName), Size);
        SetLength(UserName, StrLen(PChar(UserName)));
        Result := CompareText(UserName, ServiceStartName) = 0;
      finally
        Dispose(Config);
      end;
      CloseServiceHandle(Svc);
    end;
    CloseServiceHandle(Mgr);
  end;

end;