我在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
代碼如下：
1.unit Unit1;
2.
3.interface
4.
5.uses
6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7. Dialogs, SyncObjs, IdBaseComponent, IdComponent, IdCustomTCPServer, IdTCPServer,
8. IdSocketHandle, IdGlobal, IdContext, StdCtrls, ComCtrls, XPMan, Menus,
9. IdScheduler, IdSchedulerOfThread, IdSchedulerOfThreadPool, IdIPWatch;
10.
11.type
12. TUser = class(TObject)
13. private
14. FIP,
15. FUserName: string;
16. FPort: Integer;
17. FSelected: Boolean;
18. FContext: TIdContext;
19. FLock: TCriticalSection;
20. FCommandQueues: TThreadList;
21. FListItem: TListItem;
22. FWorkSize: Int64;
23. procedure SetContext(const Value: TIdContext);
24. procedure SetListItem(const Value: TListItem);
25. protected
26. procedure DoWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
27. public
28. constructor Create(const AIP, AUserName: string; APort: Integer; AContext: TIdContext); reintroduce;
29. destructor Destroy; override;
30. procedure Lock;
31. procedure Unlock;
32. property IP: string read FIP;
33. property Port: Integer read FPort;
34. property UserName: string read FUserName;
35. property Selected: Boolean read FSelected write FSelected;
36. property Context: TIdContext read FContext write SetContext;
37. property CommandQueues: TThreadList read FCommandQueues;
38. property ListItem: TListItem read FListItem write SetListItem;
39. end;
40.
41.const
42. WM_REFRESH_USERS = WM_USER + 330;
43.
44.type
45. TRefreshParam = (rpRefreshAll, rpAppendItem, rpDeleteItem);
46.
47. PCmdRec = ^TCmdRec;
48. TCmdRec = record49. Cmd: string;
50. end;
51.
52. TMainForm = class(TForm)
53. IdTCPServer: TIdTCPServer;
54. lvUsers: TListView;
55. Memo1: TMemo;
56. btnSendFileToClient: TButton;
57. XPManifest1: TXPManifest;
58. dlgOpenSendingFile: TOpenDialog;
59. edtMsg: TEdit;
60. pmRefresh: TPopupMenu;
61. mmiRefresh: TMenuItem;
62. pmClearMemo: TPopupMenu;
63. miClearLog: TMenuItem;
64. IdSchedulerOfThreadPool1: TIdSchedulerOfThreadPool;
65. IdIPWatch: TIdIPWatch;
66. procedure btnSendFileToClientClick(Sender: TObject);
67. procedure edtMsgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
68. procedure FormClose(Sender: TObject; var Action: TCloseAction);
69. procedure FormCreate(Sender: TObject);
70. procedure IdTCPServerConnect(AContext: TIdContext);
71. procedure IdTCPServerDisconnect(AContext: TIdContext);
72. procedure IdTCPServerExecute(AContext: TIdContext);
73. procedure lvUsersChange(Sender: TObject; Item: TListItem; Change: TItemChange);
74. procedure miClearLogClick(Sender: TObject);
75. procedure mmiRefreshClick(Sender: TObject);
76. private
77. { Private declarations }
78. FUsers: TThreadList;
79. FLockUI: TCriticalSection;
80. procedure ClearUsers;
81. procedure RefreshUsersInListView;
82. procedure DeleteUserInListView(AClient: TUser);
83. procedure AddUserInListView(AClient: TUser);
84. procedure SendFileToUser(AUser: TUser; const FileName: string);
85. procedure SendTextToUser(AUser: TUSer; const Text: string);
86. procedure LockUI;
87. procedure UnlockUI;
88. procedure WMRefreshUsers(var Msg: TMessage); message WM_REFRESH_USERS;
89. public
90. { Public declarations }
91. end;
92.
93.var
94. MainForm: TMainForm;
95.
96.implementation
97.
98.{$R *.dfm}
99.
100.{ TUser }
101.
102.constructor TUser.Create(const AIP, AUserName: string; APort: Integer; AContext: TIdContext);
103.begin
104. FLock := TCriticalSection.Create;
105. FIP := AIP;
106. FPort := APort;
107. FUserName := AUserName;
108. Context := AContext;
109. FCommandQueues := TThreadList.Create;
110.end;
111.
112.destructor TUser.Destroy;
113.begin
114. FCommandQueues.Free;
115. FLock.Free;
116. inherited;
117.end;
118.
119.procedure TUser.SetContext(const Value: TIdContext);
120.begin
121. if FContext <> nil then FContext.Data := nil;
122. if Value <> nil then Value.Data := Self;
123. FContext := Value;
124.end;
125.
126.procedure TUser.Lock;
127.begin
128. FLock.Enter;
129.end;
130.
131.procedure TUser.Unlock;
132.begin
133. FLock.Leave;
134.end;
135.
136.procedure TUser.SetListItem(const Value: TListItem);
137.begin
138. if FListItem <> Value then
139. FListItem := Value;
140. if Value <> nil then Value.Data := Self;
141.end;
142.
143.function GetPercentFrom(Int, Total: Int64): Double;
144.begin
145. if (Int = 0) or (Total = 0) then
146. Result := 0
147. else if Int = Total then
148. Result := 100
149. else begin
150. Result := Int / (Total / 100);
151. end;
152.end;
153.
154.procedure TUser.DoWork(ASender: TObject; AWorkMode: TWorkMode;
155. AWorkCount: Int64);
156.var
157. NewPercent: string;
158.begin
159. if ListItem <> nil then
160. begin
161. NewPercent := IntToStr(Trunc(GetPercentFrom(AWorkCount,
162. FWorkSize))) + '%';
163. if ListItem.SubItems[1] <> NewPercent then ListItem.SubItems[1] := NewPercent;
164. end;
165.end;
166.
167.{ TForm1 }
168.
169.var
170. FormHanlde: HWND = 0;
171.
172.procedure TMainForm.btnSendFileToClientClick(Sender: TObject);
173.var
174. I: Integer;
175. Client: TUser;
176. cmds: TList;
177. CmdRec: PCmdRec;
178. SendUserCount: Integer;
179.begin
180. if dlgOpenSendingFile.Execute then
181. begin
182. lvUsers.Enabled := False;
183. try
184. SendUserCount := 0;
185. for I := 0 to lvUsers.Items.Count - 1 do
186. if lvUsers.Items[I].Checked then
187. begin
188. Client := TUser(lvUsers.Items[I].Data);
189. cmds := Client.CommandQueues.LockList;
190. try
191. New(CmdRec);
192. CmdRec^.Cmd := Format('SENDF %s', [dlgOpenSendingFile.FileName]);
193. cmds.Add(CmdRec);
194. Inc(SendUserCount);
195. finally
196. Client.CommandQueues.UnlockList;
197. end;
198. end;
199. finally
200. lvUsers.Enabled := True;
201. end;
202. if SendUserCount <= 0 then
203. MessageDlg('沒有可以發送文件的用戶存在！', mtError, [mbOK], 0);
204. end;
205.end;
206.
207.procedure TMainForm.FormCreate(Sender: TObject);
208.begin
209. FormHanlde := Self.Handle;
210. FUsers := TThreadList.Create;
211. FLockUI := TCriticalSection.Create;
212. with IdTCPServer.Bindings.Add do
213. begin
214. IP := IdIPWatch.LocalIP;
215. Port := 3030;
216. end;
217. IdTCPServer.Active := True;
218.end;
219.
220.procedure TMainForm.FormClose(Sender: TObject; var Action: TCloseAction);
221.begin
222. FormHanlde := 0;
223. if IdTCPServer.Active then IdTCPServer.Active := False;
224. ClearUsers;
225. FUsers.Free;
226. FLockUI.Free;
227.end;
228.
229.procedure TMainForm.ClearUsers;
230.var
231. lst: TList;
232. I: Integer;
233. User: TUser;
234.begin
235. lst := FUsers.LockList;
236. try
237. for I := 0 to lst.Count - 1 do
238. begin
239. User := lst[I];
240. if User <> nil then User.Context := nil;
241. User.Free;
242. end;
243. FUsers.Clear;
244. finally
245. FUsers.UnlockList;
246. end;
247.end;
248.
249.procedure TMainForm.IdTCPServerConnect(AContext: TIdContext);
250.var
251. Client: TUser;
252. AUserName: string;
253. lst: TList;
254. I: Integer;
255.begin
256. AUserName := AContext.Connection.IOHandler.ReadLn;
257. if AUserName = '' then
258. begin
259. AContext.Connection.IOHandler.WriteLn('NO_USER_NAME');
260. AContext.Connection.Disconnect;
261. Exit;
262. end;
263. lst := FUsers.LockList;
264. try
265. for I := 0 to lst.Count - 1 do
266. if SameText(TUser(lst[I]).UserName, AUserName) then
267. begin
268. AContext.Connection.IOHandler.WriteLn('USER_ALREADY_LOGINED');
269. AContext.Connection.Disconnect;
270. Exit;
271. end;
272.
273. Client := TUser.Create(AContext.Binding.PeerIP, AUserName,
274. AContext.Binding.PeerPort, AContext);
275. lst.Add(Client);
276. Client.Lock;
277. try
278. Client.Context.Connection.IOHandler.WriteLn('LOGINED');
279. finally
280. Client.Unlock;
281. end;
282. finally
283. FUsers.UnlockList;
284. end;
285. SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpAppendItem), Integer(Client));
286.end;
287.
288.procedure TMainForm.IdTCPServerDisconnect(AContext: TIdContext);
289.var
290. Client: TUser;
291.begin
292. Client := TUser(AContext.Data);
293. if Client <> nil then
294. begin
295. Client.Lock;
296. try
297. Client.Context := nil;
298. finally
299. Client.Unlock;
300. end;
301.
302. FUsers.Remove(Client);
303. SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpDeleteItem), Integer(Client));
304. Client.Free;
305. end;
306.end;
307.
308.procedure TMainForm.IdTCPServerExecute(AContext: TIdContext);
309.var
310. Client: TUser;
311. Msg, Cmd: string;
312. cmds: TList;
313. CmdRec: PCmdRec;
314.begin
315. Client := TUser(AContext.Data);
316. if Client <> nil then
317. begin
318. Client.Lock;
319. try
320. AContext.Connection.IOHandler.CheckForDataOnSource(250);
321. if not AContext.Connection.IOHandler.InputBufferIsEmpty then
322. begin
323. Msg := AContext.Connection.IOHandler.ReadLn(enUTF8);
324. if FormHanlde <> 0 then
325. begin
326. LockUI;
327. try
328. Memo1.Lines.Add(Format('IP: %s 的 %s 用戶說："%s"', [Client.IP, Client.UserName, Msg]));
329. finally
330. UnlockUI;
331. end;
332. end;
333. end;
334.
335. cmds := Client.CommandQueues.LockList;
336. try
337. if cmds.Count > 0 then
338. begin
339. CmdRec := cmds[0];
340. Cmd := CmdRec.Cmd;
341. cmds.Delete(0);
342. Dispose(CmdRec);
343. end
344. else Cmd := '';
345. finally
346. Client.CommandQueues.UnlockList;
347. end;
348.
349. if Cmd = '' then Exit;
350. if Pos('SENDF', Cmd) = 1 then
351. begin
352. if FormHanlde <> 0 then
353. begin
354. LockUI;
355. try
356. Memo1.Lines.Add(Format('發送文件到 %s（IP: %s）', [Client.UserName, CLient.IP]));
357. finally
358. UnlockUI;
359. end;
360. end;
361. SendFileToUser(Client, Trim(Copy(Cmd, 6, Length(Cmd))));
362. end
363. else if Pos('SENDT', Cmd) = 1 then
364. begin
365. if FormHanlde <> 0 then
366. begin
367. LockUI;
368. try
369. Memo1.Lines.Add(Format('發送文本信息到 %s（IP: %s），文本內容: "%s"', [Client.UserName, Client.IP, Trim(Copy(Cmd, 6, Length(Cmd)))]));
370. finally
371. UnlockUI;
372. end;
373. end;
374. SendTextToUser(Client, Trim(Copy(Cmd, 6, Length(Cmd))));
375. end;
376. finally
377. Client.Unlock;
378. end;
379. end;
380.end;
381.
382.procedure TMainForm.SendFileToUser(AUser: TUser; const FileName: string);
383.var
384. FStream: TFileStream;
385. Str: string;
386.begin
387. if AUser.Context <> nil then
388. with AUser.Context do
389. begin
390. Connection.IOHandler.WriteLn(Format('FILE %s', [ExtractFileName(FileName)]));
391. Str := Connection.IOHandler.ReadLn;
392. if SameText(Str, 'SIZE') then
393. begin
394. FStream := TFileStream.Create(FileName, fmOpenRead or
395. fmShareDenyWrite);
396. try
397. Connection.IOHandler.Write(ToBytes(FStream.Size));
398. Str := Connection.IOHandler.ReadLn;
399. if SameText(Str, 'READY') then
400. begin
401. Connection.IOHandler.LargeStream := True;
402. Connection.OnWork := AUser.DoWork;
403. AUser.FWorkSize := FStream.Size;
404. Connection.IOHandler.Write(FStream, FStream.Size);
405. Connection.OnWork := nil;
406. Connection.IOHandler.LargeStream := False;
407. Str := Connection.IOHandler.ReadLn;
408. if FormHanlde <> 0 then
409. begin
410. LockUI;
411. try
412. if SameText(Str, 'OK') then
413. Memo1.Lines.Add(Format('用戶: %s （IP: %s）已成功接收文件。', [AUser.UserName, AUser.IP]))
414. else
415. Memo1.Lines.Add(Format('傳輸終止！用戶： %s ，IP: %s', [AUser.UserName, AUser.IP]));
416. finally
417. UnlockUI;
418. end;
419. end;
420. Connection.IOHandler.WriteLn('DONE');
421. end;
422. finally
423. FStream.Free;
424. end;
425. end;
426. end;
427.end;
428.
429.procedure TMainForm.WMRefreshUsers(var Msg: TMessage);
430.begin
431. if Msg.Msg = WM_REFRESH_USERS then
432. begin
433. case TRefreshParam(Msg.WParam) of
434. rpRefreshAll: begin
435. RefreshUsersInListView;
436. end;
437. rpAppendItem: begin
438. AddUserInListView(TUser(Msg.LParam));
439. end;
440. rpDeleteItem: begin
441. DeleteUserInListView(TUser(Msg.LParam));
442. end;
443. end;
444. end;
445.end;
446.
447.procedure TMainForm.DeleteUserInListView(AClient: TUser);
448.begin
449. if AClient.ListItem <> nil then
450. AClient.ListItem.Delete;
451.end;
452.
453.procedure TMainForm.edtMsgKeyDown(Sender: TObject; var Key: Word; Shift:
454. TShiftState);
455.var
456. I: Integer;
457. Client: TUser;
458. cmds: TList;
459. CmdRec: PCmdRec;
460.begin
461. if Key = VK_RETURN then
462. begin
463. lvUsers.Enabled := False;
464. try
465. for I := 0 to lvUsers.Items.Count - 1 do
466. begin
467. if I = 0 then Memo1.Lines.Add('');
468. if lvUsers.Items[I].Checked then
469. begin
470. Client := TUser(lvUsers.Items[I].Data);
471. if Client <> nil then
472. begin
473. cmds := Client.CommandQueues.LockList;
474. try
475. New(CmdRec);
476. CmdRec^.Cmd := Format('SENDT %s', [edtMsg.Text]);
477. cmds.Add(CmdRec);
478. finally
479. Client.CommandQueues.UnlockList;
480. end;
481. end;
482. end;
483. end;
484. edtMsg.Clear;
485. finally
486. lvUsers.Enabled := True;
487. end;
488. Key := 0;
489. end;
490.end;
491.
492.procedure TMainForm.RefreshUsersInListView;
493.var
494. lst: TList;
495. I: Integer;
496.begin
497. lvUsers.Items.BeginUpdate;
498. try
499. lvUsers.Clear;
500. lst := FUsers.LockList;
501. try
502. for I := 0 to lst.Count - 1 do
503. SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpAppendItem),
504. Integer(lst[I]));
505. finally
506. FUsers.UnlockList;
507. end;
508. finally
509. lvUsers.Items.EndUpdate;
510. end;
511.end;
512.
513.procedure TMainForm.LockUI;
514.begin
515. FLockUI.Enter;
516.end;
517.
518.procedure TMainForm.UnlockUI;
519.begin
520. FLockUI.Leave;
521.end;
522.
523.procedure TMainForm.SendTextToUser(AUser: TUSer; const Text: string);
524.begin
525. if AUser.Context <> nil then
526. with AUser.Context do
527. begin
528. Connection.IOHandler.WriteLn(Text, enUTF8);
529. end;
530.end;
531.
532.procedure TMainForm.AddUserInListView(AClient: TUser);
533.var
534. Item: TListItem;
535.begin
536. Item := lvUsers.Items.Add;
537. Item.Caption := AClient.UserName;
538. AClient.ListItem := Item;
539. Item.SubItems.Add(Format('%s[%d]', [AClient.IP, AClient.Port]));
540. Item.SubItems.Add('N/A');
541. Item.Checked := AClient.Selected;
542.end;
543.
544.procedure TMainForm.lvUsersChange(Sender: TObject; Item: TListItem; Change:
545. TItemChange);
546.begin
547. if (Change = ctState) and (Item.Data <> nil) then
548. TUser(Item.Data).Selected := Item.Checked;
549.end;
550.
551.procedure TMainForm.miClearLogClick(Sender: TObject);
552.begin
553. LockUI;
554. try
555. Memo1.Lines.Clear;
556. finally
557. UnlockUI;
558. end;
559.end;
560.
561.procedure TMainForm.mmiRefreshClick(Sender: TObject);
562.begin
563. SendMessage(FormHanlde, WM_REFRESH_USERS, Ord(rpRefreshAll), 0);
564.end;
565.
566.end.
然後是客戶端：
代碼如下：
1.unit Unit1;
2.
3.interface
4.
5.uses
6. Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
7. Dialogs, IdBaseComponent, IdComponent, IdGlobal, IdTCPConnection, IdTCPClient,
8. ExtCtrls, StdCtrls, ComCtrls, XPMan;
9.
10.type
11. TForm1 = class(TForm)
12. IdTCPClient: TIdTCPClient;
13. btnConnect: TButton;
14. tmrCheckServerMsg: TTimer;
15. btnDisconect: TButton;
16. edtMsg: TEdit;
17. pbProgress: TProgressBar;
18. mmoInfo: TMemo;
19. XPManifest1: TXPManifest;
20. procedure btnConnectClick(Sender: TObject);
21. procedure btnDisconectClick(Sender: TObject);
22. procedure edtMsgKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
23. procedure FormClose(Sender: TObject; var Action: TCloseAction);
24. procedure FormCreate(Sender: TObject);
25. procedure FormShow(Sender: TObject);
26. procedure IdTCPClientWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
27. procedure tmrCheckServerMsgTimer(Sender: TObject);
28. private
29. { Private declarations }
30. public
31. { Public declarations }
32. end;
33.
34.var
35. Form1: TForm1;
36.
37.implementation
38.
39.uses TypInfo;
40.
41.{$R *.dfm}
42.
43.procedure TForm1.btnConnectClick(Sender: TObject);
44.var
45. Response: string;
46. UserName: string;
47. HostName: array[0..MAX_COMPUTERNAME_LENGTH] of char;
48. Length: DWORD;
49.begin
50. IdTCPClient.ConnectTimeout := 5000;
51. IdTCPClient.Connect;
52. //UserName := Format('U%.5d', [Random(99999)]);
53. Length := SizeOf(HostName);
54. GetComputerName(HostName, Length);
55. UserName := HostName;
56.
57. IdTCPClient.IOHandler.WriteLn(UserName);
58. Response := IdTCPClient.IOHandler.ReadLn;
59. if SameText(Response, 'LOGINED') then
60. begin
61. btnDisconect.Enabled := True;
62. btnConnect.Enabled := False;
63. tmrCheckServerMsg.Enabled := True;
64. Caption := 'Client - ' + UserName;
65. end
66. else raise Exception.CreateFmt('登錄失敗: "%s"', [Response]);
67.end;
68.
69.procedure TForm1.btnDisconectClick(Sender: TObject);
70.begin
71. btnConnect.Enabled := True;
72. btnDisconect.Enabled := False;
73. tmrCheckServerMsg.Enabled := False;
74. Caption := 'Client';
75. IdTCPClient.Disconnect;
76.end;
77.
78.procedure TForm1.edtMsgKeyDown(Sender: TObject; var Key: Word; Shift:
79. TShiftState);
80.begin
81. if Key = VK_RETURN then
82. begin
83. if not IdTCPClient.Connected then Exit;
84. if edtMsg.Text <> '' then
85. begin
86. IdTCPClient.IOHandler.WriteLn(edtMsg.Text, enUTF8);
87. mmoInfo.Lines.Add(Format('發送消息: "%s"', [edtMsg.Text]));
88. edtMsg.Clear;
89. end;
90. Key := 0;
91. end;
92.end;
93.
94.procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
95.begin
96. try
97. if IdTCPClient.Connected then
98. btnDisconect.Click;
99. except
100. end;
101.end;
102.
103.procedure TForm1.FormCreate(Sender: TObject);
104.begin
105. Randomize;
106. IdTCPClient.Host := '192.168.2.148';
107. IdTCPClient.Port := 3030;
108.end;
109.
110.procedure TForm1.FormShow(Sender: TObject);
111.begin
112. btnConnect.Click;
113.end;
114.
115.procedure TForm1.IdTCPClientWork(ASender: TObject; AWorkMode: TWorkMode;
116. AWorkCount: Int64);
117.begin
118. pbProgress.Position := AWorkCount;
119. Application.ProcessMessages;
120.end;
121.
122.type
123. TSizeType = (stB, stK, stM, stG, stT);
124.
125.function FormatFileSize(Size: Extended; MaxSizeType: TSizeType; var ReturnSizeType: TSizeType;
126. const IncludeComma: Boolean = True): string; overload;
127.const
128. FormatStr: array[Boolean] of string = ('0.##', '#,##0.##'); {do not localize}
129.var
130. DivCount: Integer;
131.begin
132. ReturnSizeType := stB;
133. DivCount := 0;
134. while (Size >= 1024) and (ReturnSizeType <> MaxSizeType) do
135. begin
136. Size := Size / 1024;
137. Inc(DivCount);
138. case DivCount of
139. 1: ReturnSizeType := stK;
140. 2: ReturnSizeType := stM;
141. 3: ReturnSizeType := stG;
142. 4: ReturnSizeType := stT;
143. end;
144. end;
145. Result := FormatFloat(FormatStr[IncludeComma], Size);
146.end;
147.
148.function FormatFileSize(Size: Extended; MaxSizeType: TSizeType;
149. const IncludeComma: Boolean = True): string; overload;
150.resourcestring
151. RSC_BYTE = '字節';
152.var
153. ReturnSt: TSizeType;
154.begin
155. Result := FormatFileSize(Size, stT, ReturnSt, True) + ' ' +
156. Copy(GetEnumName(TypeInfo(TSizeType), Ord(ReturnSt)), 3, 1);
157. if ReturnSt = stB then
158. begin
159. Delete(Result, Length(Result), 1);
160. Result := Result + RSC_BYTE;
161. end
162. else
163. Result := Result + 'B'; {do not localize}
164.end;
165.
166.procedure TForm1.tmrCheckServerMsgTimer(Sender: TObject);
167.var
168. CmdStr: string;
169. FSize: Int64;
170. FStream: TFileStream;
171. SaveFileName: string;
172.begin
173. CmdStr := '';
174. if IdTCPClient.Connected then
175. begin
176. IdTCPClient.IOHandler.CheckForDataOnSource(250);
177. if not IdTCPClient.IOHandler.InputBufferIsEmpty then
178. begin
179. tmrCheckServerMsg.Enabled := False;
180. try
181. CmdStr := IdTCPClient.IOHandler.ReadLn(enUTF8);
182. CmdStr := System.UTF8Encode(CmdStr);
183. if SameText(Copy(CmdStr, 1, 4), 'FILE') then
184. begin
185. SaveFileName := Trim(Copy(CmdStr, 5, Length(CmdStr)));
186. mmoInfo.Lines.Add('准備接收文件....');
187. IdTCPClient.IOHandler.WriteLn('SIZE');
188. FSize :=IdTCPClient.IOHandler.ReadInt64(False);
189. if FSize > 0 then
190. begin
191. pbProgress.Max := FSize;
192. pbProgress.Position := 0;
193. mmoInfo.Lines.Add('文件大小 =' + FormatFileSize(FSize, stK) + '; 正在接收中...');
194. IdTCPClient.IOHandler.WriteLn('READY');
195. while True do196. begin
197. if FileExists(ExtractFilePath(ParamStr(0)) + SaveFileName) then
198. SaveFileName := '~' + SaveFileName
199. else Break;
200. end;
201. FStream := TFileStream.Create(ExtractFilePath(ParamStr(0))
202. + SaveFileName,
203. fmCreate);
204. try
205. IdTCPClient.IOHandler.LargeStream := True;
206. IdTCPClient.IOHandler.ReadStream(FStream, FSize);
207. IdTCPClient.IOHandler.LargeStream := False;
208. IdTCPClient.IOHandler.WriteLn('OK');
209. if IdTCPClient.IOHandler.ReadLn = 'DONE' then
210. mmoInfo.Lines.Add('接收成功！')
211. finally
212. FStream.Free;
213. end;
214. end
215. else begin
216. mmoInfo.Lines.Add('接收失敗！');
217. IdTCPClient.IOHandler.WriteLn('CANCEL');
218. end;
219. end
220. else
221. mmoInfo.Lines.Add('接收文本信息: ' + CmdStr)
222. finally
223. tmrCheckServerMsg.Enabled := True;
224. end;
225. end;
226. end;
227.end;
228.
229.end.
