Delphi跨平台TCP库的封装

本文整理自网络，侵删。

 Delphi的跨平台框架FireMonkey下的TCP组件默认自带INDY的，但我个人在使用某些特别的库的时候喜欢再封装一层，封装为简单的对外公开的接口，这里分享一下基于indy的封装的tcp的请求的库。以下代码基于Delphi 10.2。

{   单元名：跨平台的TCP客户端库封装  作者：5bug  网站:http://www.5bug. wang }unit uCPTcpClient;interfaceuses System.Classes, System.SysUtils, IdTCPClient, IdGlobal;type  TOnRevDataEvent = procedure(const pData: Pointer; const pSize: Cardinal) of object;  TCPTcpClient = class  private    FConnected: Boolean;    FHost: string;    FPort: Integer;    FOnRevDataEvent: TOnRevDataEvent;    FOnDisconnectEvent: TNotifyEvent;  type    TTcpThreadType = (tt_Send, tt_Recv, tt_Handle);    TCPTcpThread = class(TThread)    private      FOnExecuteProc: TProc;    protected      procedure Execute; override;    public      property OnExecuteProc: TProc read FOnExecuteProc write FOnExecuteProc;    end;    TTcpDataRecord = class(TMemoryStream);  protected    FTCPClient: TIdTCPClient;    FSendDataList: TThreadList;    FRecvDataList: TThreadList;    FCahceDataList: TThreadList;    FTcpThread: array [TTcpThreadType] of TCPTcpThread;    procedure InitThread;    procedure FreeThread;    procedure ExcuteSendProc;    procedure ExcuteRecvProc;    procedure ExcuteHandleProc;    procedure ExcuteDisconnect;    procedure ClearData;    function PushToSendCahce(const AData: Pointer; const ASize: NativeInt): Boolean;  public    constructor Create();    destructor Destroy; override;    procedure InitHostAddr(const AHost: string; const APort: Integer);    function TryConnect: Boolean;    procedure DisConnect;    function Send(const AData: Pointer; const ASize: NativeInt): Boolean;    property Connected: Boolean read FConnected;    property Host: string read FHost;    property Port: Integer read FPort;    property OnRevDataEvent: TOnRevDataEvent read FOnRevDataEvent write FOnRevDataEvent;    property OnDisconnectEvent: TNotifyEvent read FOnDisconnectEvent write FOnDisconnectEvent;  end;implementationuses uLogSystem;{ TCPTcpClient }procedure TCPTcpClient.ClearData;var  I: Integer;  ADataRecord: TTcpDataRecord;begin  with FSendDataList.LockList do    try      for I := 0 to Count - 1 do      begin        ADataRecord := Items[I];        FreeAndNil(ADataRecord);      end;      Clear;    finally      FSendDataList.UnlockList;    end;  with FRecvDataList.LockList do    try      for I := 0 to Count - 1 do      begin        ADataRecord := Items[I];        FreeAndNil(ADataRecord);      end;      Clear;    finally      FRecvDataList.UnlockList;    end;  with FCahceDataList.LockList do    try      for I := 0 to Count - 1 do      begin        ADataRecord := Items[I];        FreeAndNil(ADataRecord);      end;      Clear;    finally      FCahceDataList.UnlockList;    end;end;constructor TCPTcpClient.Create;begin  FTCPClient := TIdTCPClient.Create(nil);  FTCPClient.ConnectTimeout := 5000;  FTCPClient.ReadTimeout := 5000;  InitThread;end;destructor TCPTcpClient.Destroy;begin  FreeThread;  FTCPClient.Free;  inherited;end;procedure TCPTcpClient.DisConnect;begin  ExcuteDisconnect;end;procedure TCPTcpClient.ExcuteDisconnect;begin  FConnected := False;  FTCPClient.DisConnect;  if MainThreadID = CurrentThreadId then  begin    if Assigned(FOnDisconnectEvent) then      FOnDisconnectEvent(Self);  end  else  begin    TThread.Synchronize(FTcpThread[tt_Recv],      procedure      begin        if Assigned(FOnDisconnectEvent) then          FOnDisconnectEvent(Self);      end);  end;end;procedure TCPTcpClient.ExcuteHandleProc;var  I: Integer;  ADataRecord: TTcpDataRecord;begin  // 不要长时间锁住收数据的列队  with FRecvDataList.LockList do    try      while Count > 0 do      begin        ADataRecord := Items[0];        FCahceDataList.Add(ADataRecord);        ｄｅｌｅｔｅ(0);      end;    finally      FRecvDataList.UnlockList;    end;  with FCahceDataList.LockList do    try      while Count > 0 do      begin        ADataRecord := Items[0];        ｄｅｌｅｔｅ(0);        TThread.Synchronize(FTcpThread[tt_Handle],          procedure          begin            if Assigned(FOnRevDataEvent) then              FOnRevDataEvent(ADataRecord.Memory, ADataRecord.Size);            FreeAndNil(ADataRecord);          end);      end;    finally      FCahceDataList.UnlockList;    end;end;procedure TCPTcpClient.ExcuteRecvProc;var  ADataRecord: TTcpDataRecord;  ADataSize: Integer;begin  if FConnected then  begin    try      FTCPClient.Socket.CheckForDataOnSource(1);      ADataSize := FTCPClient.IOHandler.InputBuffer.Size;      if ADataSize > 0 then      begin        ADataRecord := TTcpDataRecord.Create;        with FRecvDataList.LockList do          try            Add(ADataRecord);          finally            FRecvDataList.UnlockList;          end;        FTCPClient.Socket.ReadStream(ADataRecord, ADataSize);      end;      FTCPClient.Socket.CheckForDisconnect(False, True);    except      ExcuteDisconnect;    end;  end;  Sleep(1);end;function TCPTcpClient.PushToSendCahce(const AData: Pointer; const ASize: NativeInt): Boolean;var  ADataRecord: TTcpDataRecord;begin  Result := False;  if FConnected then  begin    ADataRecord := TTcpDataRecord.Create;    ADataRecord.Write(AData^, ASize);    with FSendDataList.LockList do      try        Add(ADataRecord);      finally        FSendDataList.UnlockList;      end;    Result := True;  end;end;procedure TCPTcpClient.ExcuteSendProc;var  ADataRecord: TTcpDataRecord;begin  if FConnected then  begin    ADataRecord := nil;    with FSendDataList.LockList do      try        if Count > 0 then        begin          ADataRecord := Items[0];          ｄｅｌｅｔｅ(0);        end;      finally        FSendDataList.UnlockList;      end;    if ADataRecord <> nil then    begin      FTCPClient.IOHandler.Write(ADataRecord);      FreeAndNil(ADataRecord);    end;  end;  Sleep(1);end;procedure TCPTcpClient.InitThread;var  I: Integer;  AThreadType: TTcpThreadType;begin  FSendDataList := TThreadList.Create;  FRecvDataList := TThreadList.Create;  FCahceDataList := TThreadList.Create;  for AThreadType := Low(TTcpThreadType) to High(TTcpThreadType) do  begin    FTcpThread[AThreadType] := TCPTcpThread.Create(True);    FTcpThread[AThreadType].FreeOnTerminate := False;    case AThreadType of      tt_Send:        FTcpThread[AThreadType].OnExecuteProc := ExcuteSendProc;      tt_Recv:        FTcpThread[AThreadType].OnExecuteProc := ExcuteRecvProc;      tt_Handle:        FTcpThread[AThreadType].OnExecuteProc := ExcuteHandleProc;    end;    FTcpThread[AThreadType].Start;  end;end;procedure TCPTcpClient.FreeThread;var  I: Integer;  AThreadType: TTcpThreadType;begin  for AThreadType := Low(TTcpThreadType) to High(TTcpThreadType) do  begin    if FTcpThread[AThreadType].Suspended then{$WARN SYMBOL_DEPRECATED OFF}      FTcpThread[AThreadType].Resume;{$WARN SYMBOL_DEPRECATED ON}    FTcpThread[AThreadType].Terminate;    FTcpThread[AThreadType].WaitFor;    FTcpThread[AThreadType].Free;    FTcpThread[AThreadType] := nil;  end;  ClearData;  FSendDataList.Free;  FRecvDataList.Free;  FCahceDataList.Free;end;procedure TCPTcpClient.InitHostAddr(const AHost: string; const APort: Integer);begin  FHost := AHost;  FPort := APort;end;function TCPTcpClient.Send(const AData: Pointer; const ASize: NativeInt): Boolean;begin  Result := PushToSendCahce(AData, ASize);end;function TCPTcpClient.TryConnect: Boolean;begin  try    FTCPClient.Host := FHost;    FTCPClient.Port := FPort;    FTCPClient.Connect;    FConnected := True;  except    on E: Exception do    begin      FConnected := False;    end;  end;  Result := FConnected;end;{ TCPTcpClient.TCPTcpThread }procedure TCPTcpClient.TCPTcpThread.Execute;begin  inherited;  while not Terminated do  begin    if Assigned(FOnExecuteProc) then      FOnExecuteProc;  end;end;end. 

相关阅读 >>

Delphi2007在win7系统下的日期问题

Delphi中获取guid的函数

Delphi字符串拆分(字符数限制)

Delphi tchart分析报告

Delphi xe 移动平台 showmodal 范例

Delphi在pagecontrol1上面的分页动态创建edit组件

Delphi timer定时器使用

实现拖动无标题窗口的5种方法

Delphi tapplication.onexception

Delphi thread类的创建及使用(关于线程函数的传递例子)

更多相关阅读请进入《Delphi》频道 >>