unit Unit1; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, IdContext, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer, IdTCPConnection, IdTCPClient; type TForm4 = class(TForm) Button1: TButton; Button2: TButton; IdTCPServer1: TIdTCPServer; Button3: TButton; Memo1: TMemo; IdTCPClient1: TIdTCPClient; Button4: TButton; Button5: TButton; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure IdTCPServer1Execute(AContext: TIdContext); procedure Button3Click(Sender: TObject); procedure Button4Click(Sender: TObject); procedure Button5Click(Sender: TObject); private { Private declarations } public { Public declarations } end; TMyThread = class(TThread) protected procedure Execute; override; end; TSMSHead = packed record SequenceID: Integer; CommandID: Integer; TotalLength: Integer; end; PSMSHead = ^TSMSHead; TSMSConnect = packed record Head: TSMSHead; UID: array [0 .. 19] of char; PWD: array [0 .. 19] of char; Version: Byte; end; PSMSConnect = ^TSMSConnect; var Form4: TForm4; CS: TRTLCriticalSection; implementation {$R *.dfm} function MyFun(p: Pointer): Integer; stdcall; var i: Integer; begin EnterCriticalSection(CS); for i := 0 to 500 do begin Form4.Canvas.Lock; Form4.Canvas.TextOut(10, 10, 'threadid=' + IntToStr(GetCurrentThreadId()) + ',' + IntToStr(i)); Form4.Canvas.Unlock; Sleep(10); end; Result := 0; LeaveCriticalSection(CS); end; procedure TForm4.Button1Click(Sender: TObject); var ID: THandle; begin CreateThread(nil, 0, @MyFun, nil, 0, ID); CreateThread(nil, 0, @MyFun, nil, 0, ID); CreateThread(nil, 0, @MyFun, nil, 0, ID); CreateThread(nil, 0, @MyFun, nil, 0, ID); end; { TMyThread } procedure TMyThread.Execute; var i: Integer; begin FreeOnTerminate := True; { 这可以让线程执行完毕后随即释放 } EnterCriticalSection(CS); for i := 0 to 500 do begin Form4.Canvas.Lock; Form4.Canvas.TextOut(100, 100, 'threadid=' + IntToStr(GetCurrentThreadId()) + ',' + IntToStr(i)); Form4.Canvas.Unlock; Sleep(10); end; LeaveCriticalSection(CS); end; procedure TForm4.Button2Click(Sender: TObject); var mythread: TMyThread; begin mythread := TMyThread.Create(True); mythread.Start; mythread := TMyThread.Create(True); mythread.Start; mythread := TMyThread.Create(True); mythread.Start; mythread := TMyThread.Create(True); mythread.Start; end; procedure TForm4.Button3Click(Sender: TObject); begin IdTCPServer1.DefaultPort := 9999; IdTCPServer1.Active := True; end; procedure TForm4.Button4Click(Sender: TObject); begin IdTCPClient1.Host := '127.0.0.1'; IdTCPClient1.Port := 9999; // IdTCPClient1.Connect; end; procedure TForm4.Button5Click(Sender: TObject); var pkt: TSMSConnect; buf: TBytes; begin // 填写pkt pkt.Head.SequenceID := 1000; pkt.Head.CommandID := 119; StrLCopy(pkt.UID, 'I love you ', SizeOf(pkt.UID)); StrLCopy(pkt.PWD, 'I love you 你的密码 ', SizeOf(pkt.PWD)); // 准备缓冲区数据 SetLength(buf, SizeOf(TSMSConnect)); Move(pkt, buf[0], SizeOf(TSMSConnect)); IdTCPClient1.Connect; IdTCPClient1.Socket.Write(buf); IdTCPClient1.Disconnect; end; procedure TForm4.FormCreate(Sender: TObject); begin InitializeCriticalSection(CS); end; procedure TForm4.FormDestroy(Sender: TObject); begin DeleteCriticalSection(CS); end; //http://www.ylzx8.cn/windows/delphi/56833.html //http://www.cnblogs.com/railgunman/archive/2010/08/31/1814112.html //http://blog.csdn.net/lee576/article/details/3235956 procedure TForm4.IdTCPServer1Execute(AContext: TIdContext); var pkt: PSMSConnect; buf: TBytes; begin SetLength(buf, SizeOf(TSMSConnect)); AContext.Connection.Socket.ReadBytes(buf, SizeOf(TSMSConnect), False); pkt := PSMSConnect(@buf[0]); Assert(pkt.Head.SequenceID = 1000); Memo1.Lines.Add(pkt.UID); Memo1.Lines.Add(pkt.PWD); end; end.