rltserver.dpr

一般的数据库管理系统 uses Classes, SConnectEx, TltConst, ExtCtrls, MMSystem, Types, windows, TltLogic , Sy

program RltServer;

uses
  SvcMgr,
  Forms,
  Windows,
  SysUtils,
  WinSvc,
  ScktCnst,
  ScktMain in 'ScktMain.pas' {SocketForm},
  TltLogic in 'TltLogic.pas',
  TltConst in 'TltConst.pas',
  rltSvr in 'rltSvr.pas',
  DAU in 'DAU.pas',
  SConnectEx in '..\Client\SConnectEx.pas';

{$R *.RES}

function Installing: Boolean;
begin
  Result := FindCmdLineSwitch('INSTALL',['-','\','/'], True) or
            FindCmdLineSwitch('UNINSTALL',['-','\','/'], True);
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 := 'SYSTEM';
      finally
        Dispose(Config);
      end;
      CloseServiceHandle(Svc);
    end;
    CloseServiceHandle(Mgr);
  end;
  if Result then
  begin
    //得到用户名称
    Size := 256;
    SetLength(UserName, Size);
    GetUserName(PChar(UserName), Size);
    SetLength(UserName, StrLen(PChar(UserName)));
    //用户名与服务启动名称相同
    Result := CompareText(UserName, ServiceStartName) = 0;
  end;
end;

begin
  //非启动服务，创建原子，保证唯一实例；
  if not Installing then
  begin
    CreateMutex(nil, True, 'RltServer');
    if GetLastError = ERROR_ALREADY_EXISTS then
    begin
      MessageBox(0, PChar(SAlreadyRunning), SApplicationName, MB_ICONERROR);
      Halt;
    end;
  end;
  //如果是启动服务
  if Installing or StartService then
  begin
    SvcMgr.Application.Initialize;
    SocketService := TSocketService.CreateNew(SvcMgr.Application, 0);
    SvcMgr.Application.CreateForm(TSocketForm, SocketForm);
  SvcMgr.Application.Run;
  end else
  begin//否则作为一般应用启动；
    Forms.Application.ShowMainForm := False;
    Forms.Application.Initialize;
    Forms.Application.CreateForm(TSocketForm, SocketForm);
    SocketForm.Initialize(False);
    Forms.Application.Run;
  end;
end.