unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs,
  ExtCtrls, WinSock;

type
  TsrvGetServerInfoVCL = class(TService)
    procedure ServiceExecute(Sender: TService);
  private
    { Private declarations }
  public
    function GetServiceController: TServiceController; override;
    procedure SendServerInfo;
  end;

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

var
  srvGetServerInfoVCL: TsrvGetServerInfoVCL;

  SI    : TServerInfo;
  SIPtr : PServerInfo;


implementation

{$R *.DFM}

procedure ServiceController(CtrlCode: DWord); stdcall;
begin
  srvGetServerInfoVCL.Controller(CtrlCode);
end;

function TsrvGetServerInfoVCL.GetServiceController: TServiceController;
begin
  Result := ServiceController;
end;

procedure TsrvGetServerInfoVCL.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 TsrvGetServerInfoVCL.ServiceExecute(Sender: TService);
var
  hMail    : THandle;
  WriteCnt : integer;
  CN       : PChar;
  CNSize   : DWORD;
  VolumeName,
  FileSystemName     : array [0..MAX_PATH-1] of Char;
  VolumeSerialNo     : DWORD;
  MaxComponentLength,
  FileSystemFlags    : DWORD;
begin
  // ******************** Головний код служби **********************************
  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;

  SIPtr := @SI;

  while not Terminated do begin
    if Status = csRunning then begin
      SendServerInfo;
    end;
    Sleep(2000);
    ServiceThread.ProcessRequests(false);
  end;

  CloseHandle(hMail);
  // ***************************************************************************
end;

end.
