Measure/Encrypt/NetClient/CorrespondClient.pas

unit CorrespondClient;

interface

uses IdTCPClient, EnctyptClientData, Windows, SysUtils, Classes;

type
  TScCorrespondClient = class;

  TThrds = class(TThread)
  private
    FCorrpdClient: TScCorrespondClient;
  protected
    procedure HandlerMessage; virtual;
    procedure Execute; override;
  public
    constructor Create(CorrpdClient: TScCorrespondClient);
  end;

  TRecevieThrds = class(TThrds)
  protected
    procedure HandlerMessage; override;
  end;

  TSendThrds = class(TThrds)
  protected
    procedure HandlerMessage; override;
  end;

  TScCorrespondClient = class
  private
    FIP: string;
    FUser: Integer;
    FIdTcpClient: TIdTCPClient;
    FEncryptData: TScEnryptClient;
    FReceiveThrds: TRecevieThrds;
    FSendThrds: TSendThrds;
    function SendMessages(const AIP: string; AUser, AAction: Integer): Boolean;
    procedure ReceiveMessages(var AText: string);
    function CheckMessage(const MsgText: string): Boolean;
    procedure DoOnDisconnect(Sender: TObject);
  public
    constructor Create;
    destructor Destroy; override;

    function ConnectServer(APort: Integer; const AIP: string): Boolean;
    procedure CloseConnection;
    procedure ResumeThrds;

    function ReadDogData(AAddr, ABytes, AAction: Integer; Data: PByte): Boolean;
    function QuestConnect(AAction: Integer): Boolean;

    property IP: string read FIP write FIP;
    property UserID: Integer read FUser write FUser;
  end;

implementation

uses Forms, IdTCPConnection;

{ TScCorrespondClient }

function TScCorrespondClient.CheckMessage(const MsgText: string): Boolean;
begin
  if SameText(MsgText, 'SUCCESS') then
    Result := True
  else
  begin
    Result := False;
    if SameText(MsgText, 'ISFULL') then
      MessageBox(0, PChar('服务器已满，连接失败！'), PChar('提示'), MB_OK or MB_ICONERROR);
  end;
end;

procedure TScCorrespondClient.CloseConnection;
begin
  FIdTcpClient.Disconnect;
end;

function TScCorrespondClient.ConnectServer(APort: Integer; const AIP: string): Boolean;
begin
  Result := True;
  FIdTcpClient.Host := AIP;
  FIdTcpClient.Port := APort;
  FIdTcpClient.Disconnect;
  try
    FIdTcpClient.Connect(1000);
  except
    Result := False;
    CloseConnection;
  {  MessageBox(0, PChar('可能服务器没打开 或者 网线没插好 或者 您输入的端口号或IP不正确！'),
      PChar('连接服务器失败'), MB_OK or MB_ICONINFORMATION);     }
  end;
end;

constructor TScCorrespondClient.Create;
begin
  FIdTcpClient := TIdTCPClient.Create(nil);
  FEncryptData := TScEnryptClient.Create;
//FIdTcpClient.OnDisconnected := DoOnDisconnect;
end;

destructor TScCorrespondClient.Destroy;
begin
{  if FSendThrds <> nil then
    FSendThrds.Terminate;
  if FReceiveThrds <> nil then
    FReceiveThrds.Terminate;  }
  FreeAndNil(FIdTcpClient);
  FEncryptData.Free;
  inherited;
end;

procedure TScCorrespondClient.DoOnDisconnect(Sender: TObject);
begin

end;

function TScCorrespondClient.QuestConnect(AAction: Integer): Boolean;
var
  sText: string;
begin
  Result := SendMessages(FIP, FUser, AAction);
  if not Result then Exit;
  if AAction <> 1 then
  begin
    ReceiveMessages(sText);
    Result := CheckMessage(sText);
  end;
end;

function TScCorrespondClient.ReadDogData(AAddr, ABytes, AAction: Integer;
  Data: PByte): Boolean;
var
  b: Byte;
  I, iValue: Integer;
  sText: string;
begin
  Result := SendMessages(IntToStr(AAddr), ABytes, AAction);
  if not Result then Exit;
  if AAction <> 1 then
  begin
    ReceiveMessages(sText);
    if SameText(sText, '') then Result := False
    else
    begin
      if (AAddr = 0) and (ABytes = 0) then
      begin
        b := $FF;
        iValue := StrToInt(sText);
        for I := 1 to SizeOf(iValue) do
        begin
          Data^ := iValue and b;
          iValue := iValue shr 8;
          Inc(Data);
        end;
      end
      else
      begin
//        SetLength(arrData, ABytes);
//        Move(sText[1], arrData[0], ABytes);
        for I := 1 to ABytes do
        begin
          Data^ := Ord(sText[I]);
          Inc(Data);
        end;
      end;
    end;
  end;
end;

procedure TScCorrespondClient.ReceiveMessages(var AText: string);
begin
  if FIdTcpClient.Connected then
  begin
    try
      AText := FIdTcpClient.ReadLn(#13#10, 1000, 100);
      AText := FEncryptData.DeEncryptData(AText);
    except
      AText := '';
    end;
  end;
end;

procedure TScCorrespondClient.ResumeThrds;
begin
  FReceiveThrds := TRecevieThrds.Create(Self);
  FSendThrds := TSendThrds.Create(Self);
end;

function TScCorrespondClient.SendMessages(const AIP: string; AUser, AAction: Integer): Boolean;
var
  sText: string;
begin
  Result := True;
  if Assigned(FIdTcpClient) and FIdTcpClient.Connected then
  begin
    sText := FEncryptData.EncryptData(AIP, AUser, AAction);
    try
      FIdTcpClient.WriteLn(sText);
    except
      FIdTcpClient.Disconnect;
      
      Result := False;
    end;
  end
  else Result := False;
end;

{ TThrds }

constructor TThrds.Create(CorrpdClient: TScCorrespondClient);
begin
  FCorrpdClient := CorrpdClient;
  FreeOnTerminate := True;     
  inherited Create(False);
end;

procedure TThrds.Execute;
begin
  inherited;
  HandlerMessage;
end;

procedure TThrds.HandlerMessage;
begin

end;

{ TRecevieThrds }

procedure TRecevieThrds.HandlerMessage;
var
  sText: string;
begin
  while True do
  begin
    try
      if Self.Terminated then Break;
      sText := FCorrpdClient.FIdTcpClient.ReadLn('', 1000, 100);
      if Self.Terminated then Break;      
      sText := FCorrpdClient.FEncryptData.DeEncryptData(sText);
      if not FCorrpdClient.CheckMessage(sText) then
      begin
        FCorrpdClient.CloseConnection;

        Break;
      end;
    except    
      Break;
    end;
  end;
end;

{ TSendThrds }

procedure TSendThrds.HandlerMessage;
begin
  while True do
  begin
    Sleep(10000);
    if Self.Terminated then Break;
    if not Assigned(FCorrpdClient) then Break;
//    if not FCorrpdClient.SendMessages(9) then Break;
  end; 
end;

end.