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.