Delphi2009的Indy全接触之TCP篇_indy delphi 实例_昆山人在上海的博客

相关文章推荐

老实的打火机 · ifstream::rdbuf - C++ ...· 4 天前 ·

聪明伶俐的手套 · JAVA_编辑图片功能_图片内嵌图片_Buf ...· 1 月前 ·

任性的小熊猫 · os.environ['mapreduce_ ...· 2 月前 ·

怕考试的西瓜 · 黑芝麻智能巨亏数十亿：大客户依赖症显著，自动 ...· 1 年前 ·

气宇轩昂的毛巾 · Python cv2 播Video - ...· 1 年前 ·

我在Delphi盒子[ http://www.2ccc.com/ ]上找到了一个基于TCP协议的聊天及文件传书工具，于是把他改写成D2009版本的代码。
源代码下载地址： http://www.2ccc.com/article.asp?articleid=3894
步骤如下：
新建服务端工程如下图：
注意：里面使用了线程池TIdSchedulerOfThreadPool控件。关于他的使用范例可参照：http://blog.csdn.net/applebomb/archive/2007/10/29/1854603.aspx
代码如下：

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, SyncObjs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
IdSocketHandle, IdGlobal, IdContext, StdCtrls, ComCtrls, XPMan, Menus,
IdScheduler, IdSchedulerOfThread, IdSchedulerOfThreadPool, IdIPWatch;
type
TUser = class (TObject)
private
FIP,
FUserName: string ;
FPort: Integer;
FSelected: Boolean;
FContext: TIdContext;
FLock: TCriticalSection;
FCommandQueues: TThreadList;
FListItem: TListItem;
FWorkSize: Int64;
procedure SetContext( const Value: TIdContext);
procedure SetListItem( const Value: TListItem);
protected
procedure DoWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
public
constructor Create( const AIP, AUserName: string ; APort: Integer; AContext: TIdContext); reintroduce;
destructor Destroy; override;
procedure Lock;
procedure Unlock;
property IP: string read FIP;
property Port: Integer read FPort;
property UserName: string read FUserName;
property Selected: Boolean read FSelected write FSelected;
property Context: TIdContext read FContext write SetContext;
property CommandQueues: TThreadList read FCommandQueues;
property ListItem: TListItem read FListItem write SetListItem;
end ;
const
WM_REFRESH_USERS = WM_USER + 330 ;
type
TRefreshParam = (rpRefreshAll, rpAppendItem, rpDeleteItem);
PCmdRec = ^TCmdRec;
TCmdRec = record
Cmd: string ;
end ;
TMainForm = class (TForm)
IdTCPServer: TIdTCPServer;
lvUsers: TListView;
Memo1: TMemo;
btnSendFileToClient: TButton;
XPManifest1: TXPManifest;
dlgOpenSendingFile: TOpenDialog;
edtMsg: TEdit;
pmRefresh: TPopupMenu;
mmiRefresh: TMenuItem;
pmClearMemo: TPopupMenu;
miClearLog: TMenuItem;
IdSchedulerOfThreadPool1: TIdSchedulerOfThreadPool;
IdIPWatch: TIdIPWatch;
procedure btnSendFileToClientClick(Sender: TObject);
procedure edtMsgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure IdTCPServerConnect(AContext: TIdContext);
procedure IdTCPServerDisconnect(AContext: TIdContext);
procedure IdTCPServerExecute(AContext: TIdContext);
procedure lvUsersChange(Sender: TObject; Item: TListItem; Change: TItemChange);
procedure miClearLogClick(Sender: TObject);
procedure mmiRefreshClick(Sender: TObject);
private
{ Private declarations }
FUsers: TThreadList;
FLockUI: TCriticalSection;
procedure ClearUsers;
procedure RefreshUsersInListView;
procedure DeleteUserInListView(AClient: TUser);
procedure AddUserInListView(AClient: TUser);
procedure SendFileToUser(AUser: TUser; const FileName: string );
procedure SendTextToUser(AUser: TUSer; const Text: string );
procedure LockUI;
procedure UnlockUI;
procedure WMRefreshUsers( var Msg: TMessage); message WM_REFRESH_USERS;
public
{ Public declarations }
end ;
var
MainForm: TMainForm;
implementation
{$R *.dfm}
{ TUser }
constructor TUser . Create( const AIP, AUserName: string ; APort: Integer; AContext: TIdContext);
begin
FLock := TCriticalSection . Create;
FIP := AIP;
FPort := APort;
FUserName := AUserName;
Context := AContext;
FCommandQueues := TThreadList . Create;
end ;
destructor TUser . Destroy;
begin
FCommandQueues . Free;
FLock . Free;
inherited ;
end ;
procedure TUser . SetContext( const Value: TIdContext);
begin
if FContext <> nil then FContext . Data := nil ;
if Value <> nil then Value . Data := Self;
FContext := Value;
end ;
procedure TUser . Lock;
begin
FLock . Enter;
end ;
procedure TUser . Unlock;
begin
FLock . Leave;
end ;
procedure TUser . SetListItem( const Value: TListItem);
begin
if FListItem <> Value then
FListItem := Value;
if Value <> nil then Value . Data := Self;
end ;
function GetPercentFrom(Int, Total: Int64): Double;
begin
if (Int = 0 ) or (Total = 0 ) then
Result := 0
else if Int = Total then
Result := 100
else begin
Result := Int / (Total / 100 );
end ;
end ;
procedure TUser . DoWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
var
NewPercent: string ;
begin
if ListItem <> nil then
begin
NewPercent := IntToStr(Trunc(GetPercentFrom(AWorkCount,
FWorkSize))) + '%' ;
if ListItem . SubItems[ 1 ] <> NewPercent then ListItem . SubItems[ 1 ] := NewPercent;
end ;
end ;
{ TForm1 }
var
FormHanlde: HWND = 0 ;
procedure TMainForm . btnSendFileToClientClick(Sender: TObject);
var
I: Integer;
Client: TUser;
cmds: TList;
CmdRec: PCmdRec;
SendUserCount: Integer;
begin
if dlgOpenSendingFile . Execute then
begin
lvUsers . Enabled := False;
try
SendUserCount := 0 ;
for I := 0 to lvUsers . Items . Count - 1 do
if lvUsers . Items[I].Checked then
begin
Client := TUser(lvUsers . Items[I].Data);
cmds := Client . CommandQueues . LockList;
try
New(CmdRec);
CmdRec^.Cmd := Format( 'SENDF %s' , [dlgOpenSendingFile . FileName]);
cmds . Add(CmdRec);
Inc(SendUserCount);
finally
Client . CommandQueues . UnlockList;
end ;
end ;
finally
lvUsers . Enabled := True;
end ;
if SendUserCount <= 0 then
MessageDlg( '没有可以发送文件的用户存在！' , mtError, [mbOK], 0 );
end ;
end ;
procedure TMainForm . FormCreate(Sender: TObject);
begin
FormHanlde := Self . Handle;
FUsers := TThreadList . Create;
FLockUI := TCriticalSection . Create;
with IdTCPServer . Bindings . Add do
begin
IP := IdIPWatch . LocalIP;
Port := 3030 ;
end ;
IdTCPServer . Active := True;
end ;
procedure TMainForm . FormClose(Sender: TObject; var Action: TCloseAction);
begin
FormHanlde := 0 ;
if IdTCPServer . Active then IdTCPServer . Active := False;
ClearUsers;
FUsers . Free;
FLockUI . Free;
end ;
procedure TMainForm . ClearUsers;
var
lst: TList;
I: Integer;
User: TUser;
begin
lst := FUsers . LockList;
try
for I := 0 to lst . Count - 1 do
begin
User := lst[I];
if User <> nil then User . Context := nil ;
User . Free;
end ;
FUsers . Clear;
finally
FUsers . UnlockList;
end ;
end ;
procedure TMainForm . IdTCPServerConnect(AContext: TIdContext);
var
Client: TUser;
AUserName: string ;
lst: TList;
I: Integer;
begin
AUserName := AContext . Connection . IOHandler . ReadLn;
if AUserName = '' then
begin
AContext . Connection . IOHandler . WriteLn( 'NO_USER_NAME' );
AContext . Connection . Disconnect;
Exit;
end ;
lst := FUsers . LockList;
try
for I := 0 to lst . Count - 1 do
if SameText(TUser(lst[I]).UserName, AUserName) then
begin
AContext . Connection . IOHandler . WriteLn( 'USER_ALREADY_LOGINED' );
AContext . Connection . Disconnect;
Exit;
end ;
Client := TUser . Create(AContext . Binding . PeerIP, AUserName,
AContext . Binding . PeerPort, AContext);
lst . Add(Client);
Client . Lock;
try
Client . Context . Connection . IOHandler . WriteLn( 'LOGINED' );
finally
Client . Unlock;
end ;
finally
FUsers . UnlockList;
end ;
SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpAppendItem), Integer(Client));
end ;
procedure TMainForm . IdTCPServerDisconnect(AContext: TIdContext);
var
Client: TUser;
begin
Client := TUser(AContext . Data);
if Client <> nil then
begin
Client . Lock;
try
Client . Context := nil ;
finally
Client . Unlock;
end ;
FUsers . Remove(Client);
SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpDeleteItem), Integer(Client));
Client . Free;
end ;
end ;
procedure TMainForm . IdTCPServerExecute(AContext: TIdContext);
var
Client: TUser;
Msg, Cmd: string ;
cmds: TList;
CmdRec: PCmdRec;
begin
Client := TUser(AContext . Data);
if Client <> nil then
begin
Client . Lock;
try
AContext . Connection . IOHandler . CheckForDataOnSource( 250 );
if not AContext . Connection . IOHandler . InputBufferIsEmpty then
begin
Msg := AContext . Connection . IOHandler . ReadLn(enUTF8);
if FormHanlde <> 0 then
begin
LockUI;
try
Memo1 . Lines . Add(Format( 'IP: %s 的 %s 用户说："%s"' , [Client . IP, Client . UserName, Msg]));
finally
UnlockUI;
end ;
end ;
end ;
cmds := Client . CommandQueues . LockList;
try
if cmds . Count > 0 then
begin
CmdRec := cmds[ 0 ];
Cmd := CmdRec . Cmd;
cmds . Delete( 0 );
Dispose(CmdRec);
end
else Cmd := '' ;
finally
Client . CommandQueues . UnlockList;
end ;
if Cmd = '' then Exit;
if Pos( 'SENDF' , Cmd) = 1 then
begin
if FormHanlde <> 0 then
begin
LockUI;
try
Memo1 . Lines . Add(Format( '发送文件到 %s（IP: %s）' , [Client . UserName, CLient . IP]));
finally
UnlockUI;
end ;
end ;
SendFileToUser(Client, Trim(Copy(Cmd, 6 , Length(Cmd))));
end
else if Pos( 'SENDT' , Cmd) = 1 then
begin
if FormHanlde <> 0 then
begin
LockUI;
try
Memo1 . Lines . Add(Format( '发送文本信息到 %s（IP: %s），文本内容: "%s"' , [Client . UserName, Client . IP, Trim(Copy(Cmd, 6 , Length(Cmd)))]));
finally
UnlockUI;
end ;
end ;
SendTextToUser(Client, Trim(Copy(Cmd, 6 , Length(Cmd))));
end ;
finally
Client . Unlock;
end ;
end ;
end ;
procedure TMainForm . SendFileToUser(AUser: TUser; const FileName: string );
var
FStream: TFileStream;
Str: string ;
begin
if AUser . Context <> nil then
with AUser . Context do
begin
Connection . IOHandler . WriteLn(Format( 'FILE %s' , [ExtractFileName(FileName)]));
Str := Connection . IOHandler . ReadLn;
if SameText(Str, 'SIZE' ) then
begin
FStream := TFileStream . Create(FileName, fmOpenRead or
fmShareDenyWrite);
try
Connection . IOHandler . Write(ToBytes(FStream . Size));
Str := Connection . IOHandler . ReadLn;
if SameText(Str, 'READY' ) then
begin
Connection . IOHandler . LargeStream := True;
Connection . OnWork := AUser . DoWork;
AUser . FWorkSize := FStream . Size;
Connection . IOHandler . Write(FStream, FStream . Size);
Connection . OnWork := nil ;
Connection . IOHandler . LargeStream := False;
Str := Connection . IOHandler . ReadLn;
if FormHanlde <> 0 then
begin
LockUI;
try
if SameText(Str, 'OK' ) then
Memo1 . Lines . Add(Format( '用户: %s （IP: %s）已成功接收文件。' , [AUser . UserName, AUser . IP]))
else
Memo1 . Lines . Add(Format( '传输终止！用户： %s ，IP: %s' , [AUser . UserName, AUser . IP]));
finally
UnlockUI;
end ;
end ;
Connection . IOHandler . WriteLn( 'DONE' );
end ;
finally
FStream . Free;
end ;
end ;
end ;
end ;
procedure TMainForm . WMRefreshUsers( var Msg: TMessage);
begin
if Msg . Msg = WM_REFRESH_USERS then
begin
case TRefreshParam(Msg . WParam) of
rpRefreshAll: begin
RefreshUsersInListView;
end ;
rpAppendItem: begin
AddUserInListView(TUser(Msg . LParam));
end ;
rpDeleteItem: begin
DeleteUserInListView(TUser(Msg . LParam));
end ;
end ;
end ;
end ;
procedure TMainForm . DeleteUserInListView(AClient: TUser);
begin
if AClient . ListItem <> nil then
AClient . ListItem . Delete;
end ;
procedure TMainForm . edtMsgKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
var
I: Integer;
Client: TUser;
cmds: TList;
CmdRec: PCmdRec;
begin
if Key = VK_RETURN then
begin
lvUsers . Enabled := False;
try
for I := 0 to lvUsers . Items . Count - 1 do
begin
if I = 0 then Memo1 . Lines . Add( '' );
if lvUsers . Items[I].Checked then
begin
Client := TUser(lvUsers . Items[I].Data);
if Client <> nil then
begin
cmds := Client . CommandQueues . LockList;
try
New(CmdRec);
CmdRec^.Cmd := Format( 'SENDT %s' , [edtMsg . Text]);
cmds . Add(CmdRec);
finally
Client . CommandQueues . UnlockList;
end ;
end ;
end ;
end ;
edtMsg . Clear;
finally
lvUsers . Enabled := True;
end ;
Key := 0 ;
end ;
end ;
procedure TMainForm . RefreshUsersInListView;
var
lst: TList;
I: Integer;
begin
lvUsers . Items . BeginUpdate;
try
lvUsers . Clear;
lst := FUsers . LockList;
try
for I := 0 to lst . Count - 1 do
SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpAppendItem),
Integer(lst[I]));
finally
FUsers . UnlockList;
end ;
finally
lvUsers . Items . EndUpdate;
end ;
end ;
procedure TMainForm . LockUI;
begin
FLockUI . Enter;
end ;
procedure TMainForm . UnlockUI;
begin
FLockUI . Leave;
end ;
procedure TMainForm . SendTextToUser(AUser: TUSer; const Text: string );
begin
if AUser . Context <> nil then
with AUser . Context do
begin
Connection . IOHandler . WriteLn(Text, enUTF8);
end ;
end ;
procedure TMainForm . AddUserInListView(AClient: TUser);
var
Item: TListItem;
begin
Item := lvUsers . Items . Add;
Item . Caption := AClient . UserName;
AClient . ListItem := Item;
Item . SubItems . Add(Format( '%s[%d]' , [AClient . IP, AClient . Port]));
Item . SubItems . Add( 'N/A' );
Item . Checked := AClient . Selected;
end ;
procedure TMainForm . lvUsersChange(Sender: TObject; Item: TListItem; Change:
TItemChange);
begin
if (Change = ctState) and (Item . Data <> nil ) then
TUser(Item . Data).Selected := Item . Checked;
end ;
procedure TMainForm . miClearLogClick(Sender: TObject);
begin
LockUI;
try
Memo1 . Lines . Clear;
finally
UnlockUI;
end ;
end ;
procedure TMainForm . mmiRefreshClick(Sender: TObject);
begin
SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpRefreshAll), 0 );
end ;
end .

然后是客户端：
代码如下：

unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, IdBaseComponent, IdComponent, IdGlobal, IdTCPConnection, IdTCPClient,
ExtCtrls, StdCtrls, ComCtrls, XPMan;
type
TForm1 = class (TForm)
IdTCPClient: TIdTCPClient;
btnConnect: TButton;
tmrCheckServerMsg: TTimer;
btnDisconect: TButton;
edtMsg: TEdit;
pbProgress: TProgressBar;
mmoInfo: TMemo;
XPManifest1: TXPManifest;
procedure btnConnectClick(Sender: TObject);
procedure btnDisconectClick(Sender: TObject);
procedure edtMsgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure IdTCPClientWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
procedure tmrCheckServerMsgTimer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
uses TypInfo;
{$R *.dfm}
procedure TForm1.btnConnectClick(Sender: TObject);
var
Response: string ;
UserName: string ;
HostName: array[0..MAX_COMPUTERNAME_LENGTH] of char ;
Length: DWORD;
begin
IdTCPClient.ConnectTimeout := 5000;
IdTCPClient.Connect;
//UserName := Format('U%.5d', [Random(99999)]);
Length := SizeOf(HostName);
GetComputerName(HostName, Length);
UserName := HostName;
IdTCPClient.IOHandler.WriteLn(UserName);
Response := IdTCPClient.IOHandler.ReadLn;
if SameText(Response, 'LOGINED' ) then
begin
btnDisconect.Enabled := True;
btnConnect.Enabled := False;
tmrCheckServerMsg.Enabled := True;
Caption := 'Client - ' + UserName;
end
else raise Exception.CreateFmt( '登录失败: "%s"' , [Response]);
end;
procedure TForm1.btnDisconectClick(Sender: TObject);
begin
btnConnect.Enabled := True;
btnDisconect.Enabled := False;
tmrCheckServerMsg.Enabled := False;
Caption := 'Client' ;
IdTCPClient.Disconnect;
end;
procedure TForm1.edtMsgKeyDown(Sender: TObject; var Key: Word; Shift:
TShiftState);
begin
if Key = VK_RETURN then
begin
if not IdTCPClient.Connected then Exit;
if edtMsg.Text <> '' then
begin
IdTCPClient.IOHandler.WriteLn(edtMsg.Text, enUTF8);
mmoInfo.Lines.Add(Format( '发送消息: "%s"' , [edtMsg.Text]));
edtMsg.Clear;
end;
Key := 0;
end;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
try
if IdTCPClient.Connected then
btnDisconect.Click;
except
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Randomize;
IdTCPClient.Host := '192.168.2.148' ;
IdTCPClient.Port := 3030;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
btnConnect.Click;
end;
procedure TForm1.IdTCPClientWork(ASender: TObject; AWorkMode: TWorkMode;
AWorkCount: Int64);
begin
pbProgress.Position := AWorkCount;
Application.ProcessMessages;
end;
type
TSizeType = (stB, stK, stM, stG, stT);
function FormatFileSize(Size: Extended; MaxSizeType: TSizeType; var ReturnSizeType: TSizeType;
const IncludeComma: Boolean = True): string ; overload;
const
FormatStr: array[Boolean] of string = ( '0.##' , '#,##0.##' ); { do not localize}
var
DivCount: Integer;
begin
ReturnSizeType := stB;
DivCount := 0;
while (Size >= 1024) and (ReturnSizeType <> MaxSizeType) do
begin
Size := Size / 1024;
Inc(DivCount);
case DivCount of
1: ReturnSizeType := stK;
2: ReturnSizeType := stM;
3: ReturnSizeType := stG;
4: ReturnSizeType := stT;
end;
end;
Result := FormatFloat(FormatStr[IncludeComma], Size);
end;
function FormatFileSize(Size: Extended; MaxSizeType: TSizeType;
const IncludeComma: Boolean = True): string ; overload;
resourcestring
RSC_BYTE = '字节' ;
var
ReturnSt: TSizeType;
begin
Result := FormatFileSize(Size, stT, ReturnSt, True) + ' ' +
Copy(GetEnumName(TypeInfo(TSizeType), Ord(ReturnSt)), 3, 1);
if ReturnSt = stB then
begin
Delete(Result, Length(Result), 1);
Result := Result + RSC_BYTE;
end
else
Result := Result + 'B' ; { do not localize}
end;
procedure TForm1.tmrCheckServerMsgTimer(Sender: TObject);
var
CmdStr: string ;
FSize: Int64;
FStream: TFileStream;
SaveFileName: string ;
begin
CmdStr := '' ;
if IdTCPClient.Connected then
begin
IdTCPClient.IOHandler.CheckForDataOnSource(250);
if not IdTCPClient.IOHandler.InputBufferIsEmpty then
begin
tmrCheckServerMsg.Enabled := False;
try
CmdStr := IdTCPClient.IOHandler.ReadLn(enUTF8);
CmdStr := System.UTF8Encode(CmdStr);
if SameText(Copy(CmdStr, 1, 4), 'FILE' ) then
begin
SaveFileName := Trim(Copy(CmdStr, 5, Length(CmdStr)));
mmoInfo.Lines.Add( '准备接收文件....' );
IdTCPClient.IOHandler.WriteLn( 'SIZE' );
FSize :=IdTCPClient.IOHandler.ReadInt64(False);
if FSize > 0 then
begin
pbProgress.Max := FSize;
pbProgress.Position := 0;
mmoInfo.Lines.Add( '文件大小 =' + FormatFileSize(FSize, stK) + '; 正在接收中...' );
IdTCPClient.IOHandler.WriteLn( 'READY' );
while True do
begin
if FileExists(ExtractFilePath(ParamStr(0)) + SaveFileName) then
SaveFileName := '~' + SaveFileName
else Break;
end;
FStream := TFileStream.Create(ExtractFilePath(ParamStr(0))
+ SaveFileName,
fmCreate);
try
IdTCPClient.IOHandler.LargeStream := True;
IdTCPClient.IOHandler.ReadStream(FStream, FSize);
IdTCPClient.IOHandler.LargeStream := False;
IdTCPClient.IOHandler.WriteLn( 'OK' );
if IdTCPClient.IOHandler.ReadLn = 'DONE' then
mmoInfo.Lines.Add( '接收成功！' )
finally
FStream.Free;
end;
end
else begin
mmoInfo.Lines.Add( '接收失败！' );
IdTCPClient.IOHandler.WriteLn( 'CANCEL' );
end;
end
else
mmoInfo.Lines.Add( '接收文本信息: ' + CmdStr)
finally
tmrCheckServerMsg.Enabled := True;
end;
end;
end;
end;
end.

这组控件我是在 Delphi 2007精简版中用到的,之所以用它的起因很简单: 1.Id Tcp Server中有Connected和DisConnected事件,易于进行管理,而且当Client非正常关闭也可以用. 2.阻塞方式的通信方式虽然"笨"点,但当一个"笨"办法有效,那它就不是一个笨办法. 3.由于是 Tcp 方式的连接,可靠性高了很多,而且使得内网连接也可靠了许多. 一.关于组件的一般无错最近有个项目需要用到socket通信，对于socket的网络异常处理（程序异常退出或者网络掉了）及重连纠结了好久，网上虽然有很多资料，但是都是从一个地方转过来的，不够详细，查了很久的资料才弄出来的，原来的出处给忘了。环境： delphi 7+ indy 控件（dephi7自带）工作需要才用 delphi 7，建议使用 delphi 2007及以上版本， delphi 2007里面带的 indy 控件版本 delphi 2010版采用的T TCP Server 和T TCP Client控件编写的 TCP 通信实例，客户端和服务端可以相互发送信息并测量通信时间。TChart控件动态显示时间曲线。主要知识点：1.多线程的使用和线程安全之临界区保护 2. TCP 通信机制 3.发送接收难点方法的使用 SendBuf和ReceiveBuf 4.CRC校验算法备注：为方便自己测试客户端和服务端程序写在了一起，可以进行拆分进而实现客户端和服务端的相互发送类似于聊天小程序 Indy 10有一个组件叫IdSchedulerOfThreadPool，网上没有其相关使用代码，好在有源代码，于是自己看。其实用起来也还比较简单，主要是实现了维护一个线程池的功能，功能不是很强。不过基于该组件的开发，也可以为我们省了不少代码，增强了些功能。与该线程池使用相关的类主要有：TIdSchedulerOfThreadPool 这个不用说TIdTask(in IdTask.pas) 需最近要写一个上位机软件，需要用到id tcp server来接收客户端发来的数据，但是发现id tcp server这个控件比较难控制，总是出现一些未知的错误，网上也找不到相关资料，只能自己一步步来研究了，经过１天的摸索，终于大功告成，共享出来，希望大家少走弯路。 FClientList: TList;　　//用来存放客户端连接 maxconnect:integer;　//最大连接数 proce... procedure TfmxMain.FormCreate(Sender: TObject); LIOHandleSSL: TIdServerIOHandlerSSLOpenSSL; LScheduler_SessionsThreadPool :TIdSchedulerOfThreadPool; begin //1.产生 Indy 桥接服务器(即: Indy 服务器的Http(s)协议的Web代理的连接器) //:TIdHTTPWebBrokerBridge的实例FServer: 关于 Delphi 中 Indy 控件， TCP 通信实时性问题。 Indy 的 TCP 通信，最常采用的是阻塞方式。也就是说，如果是 TCP 的客户端，需要一个子线程来查询是否有数据到达。服务器端是由 Indy 的Server自己生成一个子线程，然后在子线程中循环调用回调函数（事件），实现事件的响应模式，对使用者来讲，和其他控件的事件响应编程方法一致。虽然编程方法一致，但是有个问题，就是线程的执行效率的问题。具体的