Measure/Encrypt/多用户网络版/Server/ServerServices.pas

unit ServerServices;

interface

uses CorrespondService, ClientInfoService, SoftDogService, WinSock, SysUtils,
  Windows, Classes, Forms, TypeUnit;

type
  TScServer = class;

  TCheckDogThrds = class(TThread)
  private
    FServer: TScServer;
  protected
    procedure CheckDog;
    procedure Execute; override;
  public
    constructor Create(Server: TScServer);
  end;


  TScServer = class
  private
    FCorrespondService: TScCorrespondService;
    FClientInfoService: TClientInfoDM;
    FSoftDogService: TScSoftDog;
    FCDThrds: TCheckDogThrds;

    function GetPort: string;
    procedure SetPort(const Value: string);
    function CheckDog: Boolean;
  public
    constructor Create;
    destructor Destroy; override;

    function ServerIP: string;
    function OpenServer: Boolean;
    procedure DeleteClient;
    procedure CloseServer;

    property Port: string read GetPort write SetPort;
    property ClientInfoService: TClientInfoDM read FClientInfoService;
  end;

implementation

{ TScServer }

function TScServer.CheckDog: Boolean;
begin
  Result := FSoftDogService.ReadUserDog;
  if Result then
    with FSoftDogService do
      FCorrespondService.SetMaxLinks(V0MaxLinks, V1MaxLinks, V2MaxLinks)
  else
    MessageBox(0, PChar('没检测到加密狗！'), PChar('打开失败'), MB_OK or MB_ICONERROR);
end;

procedure TScServer.CloseServer;
begin
  FCorrespondService.CloseService;
end;

constructor TScServer.Create;
begin
  FCorrespondService := TScCorrespondService.Create;
  FClientInfoService := TClientInfoDM.Create(nil);
  FSoftDogService := TScSoftDog.Create;

  FCorrespondService.SoftDog := FSoftDogService;

  FCorrespondService.ClientInfoService := FClientInfoService;
end;

procedure TScServer.DeleteClient;
begin
  FCorrespondService.DeleteClientThrds;
end;

destructor TScServer.Destroy;
begin
  if Assigned(FCDThrds) then
    FCDThrds.Terminate;
  FreeAndNil(FCorrespondService);
  FreeAndNil(FClientInfoService);
  FreeAndNil(FSoftDogService);
  inherited;
end;

function TScServer.GetPort: string;
begin
  Result := Format('%s%d', ['端口号：', FCorrespondService.Port]);
end;

function TScServer.OpenServer: Boolean;
begin
  if CheckDog then
  begin
    Result := FCorrespondService.Open;
    FCDThrds := TCheckDogThrds.Create(Self);
  end;
end;

function TScServer.ServerIP: string;
var
  wsData: TWSAData;
  sName: string;
  host: PHostEnt;
begin
  sName := '';
  Result := 'IP:';
  WSAStartup(2, wsData);
  host := gethostbyname(Pchar(sName));
  if host <> nil then
    Result := Result + Format('%d.%d.%d.%d', [Byte(host^.h_addr^[0]), Byte(host^.h_addr^[1]),
      Byte(host^.h_addr^[2]), Byte(host^.h_addr^[3])]);
  WSACleanup;
end;

procedure TScServer.SetPort(const Value: string);
begin
  if Value = '' then Exit;
  FCorrespondService.Port := StrToInt(Value);
end;

{ TCheckDogThrds }

procedure TCheckDogThrds.CheckDog;
var
  blFlag: Boolean;
  ieTimes: Integer;
begin
  ieTimes := 0;
  blFlag := False;
  while True do
  begin
    if not blFlag then ieTimes := 0;
    Sleep(3000);
    if Self.Terminated then Break;
    if not Assigned(FServer) then Break;
    if not Assigned(FServer.FSoftDogService) then Break;

    Sleep(3000);
    if Self.Terminated then Break;
    if not Assigned(FServer) then Break;
    if not Assigned(FServer.FSoftDogService) then Break;

    Sleep(4000);
    if Self.Terminated then Break;
    if not Assigned(FServer) then Break;
    if not Assigned(FServer.FSoftDogService) then Break;
    if Self.Terminated then Break;
    if not FServer.FSoftDogService.ReadUserDog then
    begin
      if ieTimes < 1 then
      begin
        Inc(ieTimes);
        blFlag := True;
      end
      else
      begin
        FServer.CloseServer;
        SendMessage(Application.MainForm.Handle, SM_Status, 0, 0);
        MessageBox(0, pchar('没检测到加密狗！'), pchar('提示'), MB_OK or MB_ICONINFORMATION);
        Break;
      end;
    end
    else blFlag := False;
  end;
  if Assigned(FServer) then FServer.CloseServer;
end;

constructor TCheckDogThrds.Create(Server: TScServer);
begin
  FServer := Server;
  FreeOnTerminate := True;
  inherited Create(False);
end;

procedure TCheckDogThrds.Execute;
begin
  inherited;
  CheckDog;
end;

end.