home *** CD-ROM | disk | FTP | other *** search
/ QBasic & Borland Pascal & C / Delphi5.iso / Runimage / Delphi50 / Source / Vcl / SCKTSRVR.DPR < prev    next >
Encoding:
Text File  |  1999-08-11  |  2.6 KB  |  89 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       Borland Delphi Visual Component Library         }
  5. {       Borland Socket Server source code               }
  6. {                                                       }
  7. {       Copyright (c) 1997,99 Inprise Corporation       }
  8. {                                                       }
  9. {*******************************************************}
  10.  
  11. program ScktSrvr;
  12.  
  13. uses
  14.   SvcMgr, Forms, Windows, SysUtils, WinSvc, ScktCnst,
  15.   ScktMain in 'ScktMain.pas' {SocketForm};
  16.  
  17. {$R *.RES}
  18.  
  19. function Installing: Boolean;
  20. begin
  21.   Result := FindCmdLineSwitch('INSTALL',['-','\','/'], True) or
  22.             FindCmdLineSwitch('UNINSTALL',['-','\','/'], True);
  23. end;
  24.  
  25. function StartService: Boolean;
  26. var
  27.   Mgr, Svc: Integer;
  28.   UserName, ServiceStartName: string;
  29.   Config: Pointer;
  30.   Size: DWord;
  31. begin
  32.   Result := False;
  33.   Mgr := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
  34.   if Mgr <> 0 then
  35.   begin
  36.     Svc := OpenService(Mgr, PChar(SServiceName), SERVICE_ALL_ACCESS);
  37.     Result := Svc <> 0;
  38.     if Result then
  39.     begin
  40.       QueryServiceConfig(Svc, nil, 0, Size);
  41.       Config := AllocMem(Size);
  42.       try
  43.         QueryServiceConfig(Svc, Config, Size, Size);
  44.         ServiceStartName := PQueryServiceConfig(Config)^.lpServiceStartName;
  45.         if CompareText(ServiceStartName, 'LocalSystem') = 0 then
  46.           ServiceStartName := 'SYSTEM';
  47.       finally
  48.         Dispose(Config);
  49.       end;
  50.       CloseServiceHandle(Svc);
  51.     end;
  52.     CloseServiceHandle(Mgr);
  53.   end;
  54.   if Result then
  55.   begin
  56.     Size := 256;
  57.     SetLength(UserName, Size);
  58.     GetUserName(PChar(UserName), Size);
  59.     SetLength(UserName, StrLen(PChar(UserName)));
  60.     Result := CompareText(UserName, ServiceStartName) = 0;
  61.   end;
  62. end;
  63.  
  64. begin
  65.   if not Installing then
  66.   begin
  67.     CreateMutex(nil, True, 'SCKTSRVR');
  68.     if GetLastError = ERROR_ALREADY_EXISTS then
  69.     begin
  70.       MessageBox(0, PChar(SAlreadyRunning), SApplicationName, MB_ICONERROR);
  71.       Halt;
  72.     end;
  73.   end;
  74.   if Installing or StartService then
  75.   begin
  76.     SvcMgr.Application.Initialize;
  77.     SocketService := TSocketService.CreateNew(SvcMgr.Application, 0);
  78.     SvcMgr.Application.CreateForm(TSocketForm, SocketForm);
  79.     SvcMgr.Application.Run;
  80.   end else
  81.   begin
  82.     Forms.Application.ShowMainForm := False;
  83.     Forms.Application.Initialize;
  84.     Forms.Application.CreateForm(TSocketForm, SocketForm);
  85.     SocketForm.Initialize(False);
  86.     Forms.Application.Run;
  87.   end;
  88. end.
  89.