Delphi跨平台TCP库的封装
Delphi的跨平台框架FireMonkey下的TCP组件默认自带INDY的，但我个人在使用某些特别的库的时候喜欢再封装一层，封装为简单的对外公开的接口，这里分享一下基于indy的封装的tcp的请求的库。以下代码基于Delphi 10.2。
{
单元名：跨平台的TCP客户端库封装
作者：5bug
网站:http://www.5bug. wang
}
unit uCPTcpClient;
interface
uses 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;
implementation
uses 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);
Delete(0);
end;
finally
FRecvDataList.UnlockList;
end;
with FCahceDataList.LockList do
try
while Count > 0 do
begin
ADataRecord := Items[0];
Delete(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];
Delete(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.
|
|
联系电话：
020-00000000
联系电话：
020-00000000
联系电话：
020-12345678