program GetServerInfoSocket;

uses Windows, WinSvc, WinSock;

type
  PServerInfo = ^TServerInfo;
  TServerInfo = record
    ServerName : string[200];
    ServerCode : DWORD;
  end;

const ServiceName = 'GetServerInfo';

var DispatchTable       : array [0..1] of TServiceTableEntry;
    ServiceStatus       : SERVICE_STATUS;
    ServiceStatusHandle : SERVICE_STATUS_HANDLE;

    hService, hSCManager: SC_HANDLE;
    ExeName             : PChar;
    CNSize              : DWORD = 200;

    Par                 : PWideChar;

    SI    : TServerInfo;
    SIPtr : PServerInfo;

procedure ServiceCtrlHandler(ControlCode: DWORD); stdcall;
begin
  case ControlCode of
    SERVICE_CONTROL_PAUSE : begin
      ServiceStatus.dwCurrentState := SERVICE_PAUSED;
    end;

    SERVICE_CONTROL_CONTINUE : begin
      ServiceStatus.dwCurrentState := SERVICE_RUNNING;
    end;

    SERVICE_CONTROL_STOP : begin
      with ServiceStatus do begin
        dwWin32ExitCode := 0;
        dwCurrentState  := SERVICE_STOPPED;
        dwCheckPoint    := 0;
        dwWaitHint      := 0;
      end;
    end;

    SERVICE_CONTROL_INTERROGATE : ;
  end;
  SetServiceStatus(ServiceStatusHandle, ServiceStatus);
end;

procedure SendServerInfo;
var S : TSocket;
    Addr : TSockAddr;
    Data : TWSAData;
begin
  SIPtr := @SI;

  WSAStartup($101, Data);
  S := Socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  Addr.sin_family := AF_INET;
  Addr.sin_port := htons(2212);
  Addr.sin_addr.S_addr := inet_addr('127.0.0.1');
  //FillChar(Addr.sin_zero, SizeOf(Addr.sin_zero), 0);
  if connect(S, Addr, SizeOf(TSockAddr)) <> 0 then begin
    closesocket(S);
    Exit;
  end else
    send(S, SIPtr^, SizeOf(SI), 0);

  closesocket(S);
end;

procedure ServiceProc(dwArgc: DWORD; var szArgv : array of PChar); stdcall;
var
  CN       : PChar;
  CNSize   : DWORD;
  VolumeName,
  FileSystemName     : array [0..MAX_PATH-1] of Char;
  VolumeSerialNo     : DWORD;
  MaxComponentLength,
  FileSystemFlags    : DWORD;
begin
  with ServiceStatus do begin
    dwServiceType      := SERVICE_WIN32;
    dwCurrentState     := SERVICE_START_PENDING;
    dwControlsAccepted :=
      SERVICE_ACCEPT_STOP or SERVICE_ACCEPT_PAUSE_CONTINUE or SERVICE_ACCEPT_SHUTDOWN;
    dwWin32ExitCode           := NO_ERROR;
    dwServiceSpecificExitCode := 0;
    dwCheckPoint              := 0;
    dwWaitHint                := 0;
  end;

  ServiceStatusHandle := RegisterServiceCtrlHandler(ServiceName, @ServiceCtrlHandler);

  with ServiceStatus do begin
    dwCurrentState := SERVICE_RUNNING;
    dwCheckPoint   := 0;
    dwWaitHint     := 0;
  end;

  if not SetServiceStatus(ServiceStatusHandle, ServiceStatus) then Exit;

  // ******************** Головний код служби **********************************
  CNSize := MAX_COMPUTERNAME_LENGTH + 1;
  GetMem(CN, CNSize);
  if GetComputerName(CN, CNSize) then SI.ServerName := string(CN)
    else SI.ServerName := '???';
  FreeMem(CN, CNSize);

  GetVolumeInformation(PChar('C:\'), VolumeName, MAX_PATH, @VolumeSerialNo,
    MaxComponentLength, FileSystemFlags, FileSystemName, MAX_PATH);
  SI.ServerCode := VolumeSerialNo;

  repeat
    if ServiceStatus.dwCurrentState = SERVICE_RUNNING then begin
      SendServerInfo;
    end;
    Sleep(2000);
  until ServiceStatus.dwCurrentState = SERVICE_STOPPED;

  // ***************************************************************************
end;

begin
  // ************** Встановлення і запуск служби *******************************
  if ParamStr(1)='/install' then begin
    ExeName := PChar(ParamStr(0));
    hSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
    if hSCManager <> 0 then begin
      hService := CreateService(hSCManager, ServiceName, 'Надсилання інформації про сервер',
        SERVICE_ALL_ACCESS, SERVICE_WIN32_OWN_PROCESS, SERVICE_DEMAND_START,
        SERVICE_ERROR_NORMAL, ExeName, nil, nil, nil, nil, nil);
      if hService <> 0 then begin
        Par := nil;
        StartService(hService, 0, Par);
        CloseServiceHandle(hService);
      end;
    end;
    CloseServiceHandle(hSCManager);
    Exit;
  // ************* Зупинка і видалення служби **********************************
  end else if ParamStr(1) = '/uninstall' then begin
    hSCManager := OpenSCManager(nil, nil, SC_MANAGER_ALL_ACCESS);
    if hSCManager <> 0 then begin
      hService := OpenService(hSCManager, ServiceName, SERVICE_ALL_ACCESS);
      if hService <> 0 then begin
        ControlService(hService, SERVICE_CONTROL_STOP, ServiceStatus);
        DeleteService(hService);
      end;
      CloseServiceHandle(hService);
    end;
    CloseServiceHandle(hSCManager);
    Exit;
  end;

  // ************** Запуск служби **********************************************
  DispatchTable[0].lpServiceName := ServiceName;
  DispatchTable[0].lpServiceProc := @ServiceProc;

  DispatchTable[1].lpServiceName := nil;
  DispatchTable[1].lpServiceProc := nil;

  StartServiceCtrlDispatcher(DispatchTable[0]);
end.
