在Delphi 7开发下有强大的Indy控件，版本为9，要实现一个FTP服务器，参考自带的例子，发现还要写很多函数，而且不支持中文显示文件列表等等。于是，自己改进封装了下，形成一个TFTPServer类，源码如下：

  1. {*******************************************************}
  2. {                                                       }
  3. {       系统名称 FTP服务器类                            }
  4. {       版权所有 (C) http://blog.csdn.net/akof1314      }
  5. {       单元名称 FTPServer.pas                          }
  6. {       单元功能 在Delphi 7下TIdFTPServer实现FTP服务器  }
  7. {                                                       }
  8. {*******************************************************}
  9. unit FTPServer;
  10. interface
  11. uses
  12. Classes,  Windows,  Sysutils,  IdFTPList,  IdFTPServer,  Idtcpserver,  IdSocketHandle,  Idglobal,  IdHashCRC, IdStack;
  13. {-------------------------------------------------------------------------------
  14. 功能:  自定义消息，方便与窗体进行消息传递
  15. -------------------------------------------------------------------------------}
  16. type
  17. TFtpNotifyEvent = procedure (ADatetime: TDateTime;AUserIP, AEventMessage: string) of object;
  18. {-------------------------------------------------------------------------------
  19. 功能:  FTP服务器类
  20. -------------------------------------------------------------------------------}
  21. type
  22. TFTPServer = class
  23. private
  24. FUserName,FUserPassword,FBorrowDirectory: string;
  25. FBorrowPort: Integer;
  26. IdFTPServer: TIdFTPServer;
  27. FOnFtpNotifyEvent: TFtpNotifyEvent;
  28. procedure IdFTPServer1UserLogin( ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
  29. procedure IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
  30. procedure IdFTPServer1RenameFile( ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string ) ;
  31. procedure IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream ) ;
  32. procedure IdFTPServer1StoreFile( ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
  33. procedure IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
  34. procedure IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
  35. procedure IdFTPServer1GetFileSize( ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64 ) ;
  36. procedure IdFTPServer1DeleteFile( ASender: TIdFTPServerThread; const APathname: string ) ;
  37. procedure IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread; var VDirectory: string ) ;
  38. procedure IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
  39. procedure IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
  40. protected
  41. function TransLatePath( const APathname, homeDir: string ) : string;
  42. public
  43. constructor Create; reintroduce;
  44. destructor Destroy; override;
  45. procedure Run;
  46. procedure Stop;
  47. function GetBindingIP():string;
  48. property UserName: string read FUserName write FUserName;
  49. property UserPassword: string read FUserPassword write FUserPassword;
  50. property BorrowDirectory: string read FBorrowDirectory write FBorrowDirectory;
  51. property BorrowPort: Integer read FBorrowPort write FBorrowPort;
  52. property OnFtpNotifyEvent: TFtpNotifyEvent read FOnFtpNotifyEvent write FOnFtpNotifyEvent;
  53. end;
  54. implementation
  55. {-------------------------------------------------------------------------------
  56. 过程名:    TFTPServer.Create
  57. 功能:      创建函数
  58. 参数:      无
  59. 返回值:    无
  60. -------------------------------------------------------------------------------}
  61. constructor TFTPServer.Create;
  62. begin
  63. IdFTPServer := tIdFTPServer.create( nil ) ;
  64. IdFTPServer.DefaultPort := 21;               //默认端口号
  65. IdFTPServer.AllowAnonymousLogin := False;   //是否允许匿名登录
  66. IdFTPServer.EmulateSystem := ftpsUNIX;
  67. IdFTPServer.HelpReply.text := '帮助还未实现！';
  68. IdFTPServer.OnChangeDirectory := IdFTPServer1ChangeDirectory;
  69. IdFTPServer.OnGetFileSize := IdFTPServer1GetFileSize;
  70. IdFTPServer.OnListDirectory := IdFTPServer1ListDirectory;
  71. IdFTPServer.OnUserLogin := IdFTPServer1UserLogin;
  72. IdFTPServer.OnRenameFile := IdFTPServer1RenameFile;
  73. IdFTPServer.OnDeleteFile := IdFTPServer1DeleteFile;
  74. IdFTPServer.OnRetrieveFile := IdFTPServer1RetrieveFile;
  75. IdFTPServer.OnStoreFile := IdFTPServer1StoreFile;
  76. IdFTPServer.OnMakeDirectory := IdFTPServer1MakeDirectory;
  77. IdFTPServer.OnRemoveDirectory := IdFTPServer1RemoveDirectory;
  78. IdFTPServer.Greeting.Text.Text := '欢迎进入FTP服务器';
  79. IdFTPServer.Greeting.NumericCode := 220;
  80. IdFTPServer.OnDisconnect := IdFTPServer1DisConnect;
  81. with IdFTPServer.CommandHandlers.add do
  82. begin
  83. Command := 'XCRC';   //可以迅速验证所下载的文档是否和源文档一样
  84. OnCommand := IdFTPServer1CommandXCRC;
  85. end;
  86. end;
  87. {-------------------------------------------------------------------------------
  88. 过程名:    CalculateCRC
  89. 功能:      计算CRC
  90. 参数:      const path: string
  91. 返回值:    string
  92. -------------------------------------------------------------------------------}
  93. function CalculateCRC( const path: string ) : string;
  94. var
  95. f: tfilestream;
  96. value: dword;
  97. IdHashCRC32: TIdHashCRC32;
  98. begin
  99. IdHashCRC32 := nil;
  100. f := nil;
  101. try
  102. IdHashCRC32 := TIdHashCRC32.create;
  103. f := TFileStream.create( path, fmOpenRead or fmShareDenyWrite ) ;
  104. value := IdHashCRC32.HashValue( f ) ;
  105. result := inttohex( value, 8 ) ;
  106. finally
  107. f.free;
  108. IdHashCRC32.free;
  109. end;
  110. end;
  111. {-------------------------------------------------------------------------------
  112. 过程名:    TFTPServer.IdFTPServer1CommandXCRC
  113. 功能:      XCRC命令
  114. 参数:      ASender: TIdCommand
  115. 返回值:    无
  116. -------------------------------------------------------------------------------}
  117. procedure TFTPServer.IdFTPServer1CommandXCRC( ASender: TIdCommand ) ;
  118. // note, this is made up, and not defined in any rfc.
  119. var
  120. s: string;
  121. begin
  122. with TIdFTPServerThread( ASender.Thread ) do
  123. begin
  124. if Authenticated then
  125. begin
  126. try
  127. s := ProcessPath( CurrentDir, ASender.UnparsedParams ) ;
  128. s := TransLatePath( s, TIdFTPServerThread( ASender.Thread ) .HomeDir ) ;
  129. ASender.Reply.SetReply( 213, CalculateCRC( s ) ) ;
  130. except
  131. ASender.Reply.SetReply( 500, 'file error' ) ;
  132. end;
  133. end;
  134. end;
  135. end;
  136. {-------------------------------------------------------------------------------
  137. 过程名:    TFTPServer.Destroy
  138. 功能:      析构函数
  139. 参数:      无
  140. 返回值:    无
  141. -------------------------------------------------------------------------------}
  142. destructor TFTPServer.Destroy;
  143. begin
  144. IdFTPServer.free;
  145. inherited destroy;
  146. end;
  147. function StartsWith( const str, substr: string ) : boolean;
  148. begin
  149. result := copy( str, 1, length( substr ) ) = substr;
  150. end;
  151. {-------------------------------------------------------------------------------
  152. 过程名:    TFTPServer.Run
  153. 功能:      开启服务
  154. 参数:      无
  155. 返回值:    无
  156. -------------------------------------------------------------------------------}
  157. procedure TFTPServer.Run;
  158. begin
  159. IdFTPServer.DefaultPort := BorrowPort;
  160. IdFTPServer.Active := True;
  161. end;
  162. {-------------------------------------------------------------------------------
  163. 过程名:    TFTPServer.Stop
  164. 功能:      关闭服务
  165. 参数:      无
  166. 返回值:    无
  167. -------------------------------------------------------------------------------}
  168. procedure TFTPServer.Stop;
  169. begin
  170. IdFTPServer.Active := False;
  171. end;
  172. {-------------------------------------------------------------------------------
  173. 过程名:    TFTPServer.GetBindingIP
  174. 功能:      获取绑定的IP地址
  175. 参数:
  176. 返回值:    string
  177. -------------------------------------------------------------------------------}
  178. function TFTPServer.GetBindingIP():string ;
  179. begin
  180. Result := GStack.LocalAddress;
  181. end;
  182. {-------------------------------------------------------------------------------
  183. 过程名:    BackSlashToSlash
  184. 功能:      反斜杠到斜杠
  185. 参数:      const str: string
  186. 返回值:    string
  187. -------------------------------------------------------------------------------}
  188. function BackSlashToSlash( const str: string ) : string;
  189. var
  190. a: dword;
  191. begin
  192. result := str;
  193. for a := 1 to length( result ) do
  194. if result[a] = '/' then
  195. result[a] := '/';
  196. end;
  197. {-------------------------------------------------------------------------------
  198. 过程名:    SlashToBackSlash
  199. 功能:      斜杠到反斜杠
  200. 参数:      const str: string
  201. 返回值:    string
  202. -------------------------------------------------------------------------------}
  203. function SlashToBackSlash( const str: string ) : string;
  204. var
  205. a: dword;
  206. begin
  207. result := str;
  208. for a := 1 to length( result ) do
  209. if result[a] = '/' then
  210. result[a] := '/';
  211. end;
  212. {-------------------------------------------------------------------------------
  213. 过程名:    TFTPServer.TransLatePath
  214. 功能:      路径名称翻译
  215. 参数:      const APathname, homeDir: string
  216. 返回值:    string
  217. -------------------------------------------------------------------------------}
  218. function TFTPServer.TransLatePath( const APathname, homeDir: string ) : string;
  219. var
  220. tmppath: string;
  221. begin
  222. result := SlashToBackSlash(Utf8ToAnsi(homeDir) ) ;
  223. tmppath := SlashToBackSlash( Utf8ToAnsi(APathname) ) ;
  224. if homedir = '/' then
  225. begin
  226. result := tmppath;
  227. exit;
  228. end;
  229. if length( APathname ) = 0 then
  230. exit;
  231. if result[length( result ) ] = '/' then
  232. result := copy( result, 1, length( result ) - 1 ) ;
  233. if tmppath[1] <> '/' then
  234. result := result + '/';
  235. result := result + tmppath;
  236. end;
  237. {-------------------------------------------------------------------------------
  238. 过程名:    GetNewDirectory
  239. 功能:      得到新目录
  240. 参数:      old, action: string
  241. 返回值:    string
  242. -------------------------------------------------------------------------------}
  243. function GetNewDirectory( old, action: string ) : string;
  244. var
  245. a: integer;
  246. begin
  247. if action = '../' then
  248. begin
  249. if old = '/' then
  250. begin
  251. result := old;
  252. exit;
  253. end;
  254. a := length( old ) - 1;
  255. while ( old[a] <> '/' ) and ( old[a] <> '/' ) do
  256. dec( a ) ;
  257. result := copy( old, 1, a ) ;
  258. exit;
  259. end;
  260. if ( action[1] = '/' ) or ( action[1] = '/' ) then
  261. result := action
  262. else
  263. result := old + action;
  264. end;
  265. {-------------------------------------------------------------------------------
  266. 过程名:    TFTPServer.IdFTPServer1UserLogin
  267. 功能:      允许服务器执行一个客户端连接的用户帐户身份验证
  268. 参数:      ASender: TIdFTPServerThread; const AUsername, APassword: string; var AAuthenticated: Boolean
  269. 返回值:    无
  270. -------------------------------------------------------------------------------}
  271. procedure TFTPServer.IdFTPServer1UserLogin( ASender: TIdFTPServerThread;
  272. const AUsername, APassword: string; var AAuthenticated: Boolean ) ;
  273. begin
  274. AAuthenticated := ( AUsername = UserName ) and ( APassword = UserPassword ) ;
  275. if not AAuthenticated then
  276. exit;
  277. ASender.HomeDir := AnsiToUtf8(BorrowDirectory);
  278. asender.currentdir := '/';
  279. if Assigned(FOnFtpNotifyEvent) then
  280. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'用户登录服务器');
  281. end;
  282. {-------------------------------------------------------------------------------
  283. 过程名:    TFTPServer.IdFTPServer1ListDirectory
  284. 功能:      允许服务器生成格式化的目录列表
  285. 参数:      ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems
  286. 返回值:    无
  287. -------------------------------------------------------------------------------}
  288. procedure TFTPServer.IdFTPServer1ListDirectory( ASender: TIdFTPServerThread; const APath: string; ADirectoryListing: TIdFTPListItems ) ;
  289. procedure AddlistItem( aDirectoryListing: TIdFTPListItems; Filename: string; ItemType: TIdDirItemType; size: int64; date: tdatetime ) ;
  290. var
  291. listitem: TIdFTPListItem;
  292. begin
  293. listitem := aDirectoryListing.Add;
  294. listitem.ItemType := ItemType; //表示一个文件系统的属性集
  295. listitem.FileName := AnsiToUtf8(Filename);  //名称分配给目录中的列表项,这里防止了中文乱码
  296. listitem.OwnerName := 'anonymous';//代表了用户拥有的文件或目录项的名称
  297. listitem.GroupName := 'all';    //指定组名拥有的文件名称或目录条目
  298. listitem.OwnerPermissions := 'rwx'; //拥有者权限，R读W写X执行
  299. listitem.GroupPermissions := 'rwx'; //组拥有者权限
  300. listitem.UserPermissions := 'rwx';  //用户权限，基于用户和组权限
  301. listitem.Size := size;
  302. listitem.ModifiedDate := date;
  303. end;
  304. var
  305. f: tsearchrec;
  306. a: integer;
  307. begin
  308. ADirectoryListing.DirectoryName := apath;
  309. a := FindFirst( TransLatePath( apath, ASender.HomeDir ) + '*.*', faAnyFile, f ) ;
  310. while ( a = 0 ) do
  311. begin
  312. if ( f.Attr and faDirectory > 0 ) then
  313. AddlistItem( ADirectoryListing, f.Name, ditDirectory, f.size, FileDateToDateTime( f.Time ) )
  314. else
  315. AddlistItem( ADirectoryListing, f.Name, ditFile, f.size, FileDateToDateTime( f.Time ) ) ;
  316. a := FindNext( f ) ;
  317. end;
  318. FindClose( f ) ;
  319. end;
  320. {-------------------------------------------------------------------------------
  321. 过程名:    TFTPServer.IdFTPServer1RenameFile
  322. 功能:      允许服务器重命名服务器文件系统中的文件
  323. 参数:      ASender: TIdFTPServerThread; const ARenameFromFile, ARenameToFile: string
  324. 返回值:    无
  325. -------------------------------------------------------------------------------}
  326. procedure TFTPServer.IdFTPServer1RenameFile( ASender: TIdFTPServerThread;
  327. const ARenameFromFile, ARenameToFile: string ) ;
  328. begin
  329. try
  330. if not MoveFile( pchar( TransLatePath( ARenameFromFile, ASender.HomeDir ) ) , pchar( TransLatePath( ARenameToFile, ASender.HomeDir ) ) ) then
  331. RaiseLastOSError;
  332. except
  333. on e:Exception do
  334. begin
  335. if Assigned(FOnFtpNotifyEvent) then
  336. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'重命名文件[' + Utf8ToAnsi(ARenameFromFile) + ']失败，原因是' + e.Message);
  337. Exit;
  338. end;
  339. end;
  340. if Assigned(FOnFtpNotifyEvent) then
  341. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'重命名文件[' + Utf8ToAnsi(ARenameFromFile) + ']为[' + Utf8ToAnsi(ARenameToFile) + ']');
  342. end;
  343. {-------------------------------------------------------------------------------
  344. 过程名:    TFTPServer.IdFTPServer1RetrieveFile
  345. 功能:      允许从服务器下载文件系统中的文件
  346. 参数:      ASender: TIdFTPServerThread; const AFilename: string; var VStream: TStream
  347. 返回值:    无
  348. -------------------------------------------------------------------------------}
  349. procedure TFTPServer.IdFTPServer1RetrieveFile( ASender: TIdFTPServerThread;
  350. const AFilename: string; var VStream: TStream ) ;
  351. begin
  352. VStream := TFileStream.Create( translatepath( AFilename, ASender.HomeDir ) , fmopenread or fmShareDenyWrite ) ;
  353. if Assigned(FOnFtpNotifyEvent) then
  354. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'下载文件[' + Utf8ToAnsi(AFilename) + ']');
  355. end;
  356. {-------------------------------------------------------------------------------
  357. 过程名:    TFTPServer.IdFTPServer1StoreFile
  358. 功能:      允许在服务器上传文件系统中的文件
  359. 参数:      ASender: TIdFTPServerThread; const AFilename: string; AAppend: Boolean; var VStream: TStream
  360. 返回值:    无
  361. -------------------------------------------------------------------------------}
  362. procedure TFTPServer.IdFTPServer1StoreFile( ASender: TIdFTPServerThread;
  363. const AFilename: string; AAppend: Boolean; var VStream: TStream ) ;
  364. begin
  365. if FileExists( translatepath( AFilename, ASender.HomeDir ) ) and AAppend then
  366. begin
  367. VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmOpenWrite or fmShareExclusive ) ;
  368. VStream.Seek( 0, soFromEnd ) ;
  369. end
  370. else
  371. VStream := TFileStream.create( translatepath( AFilename, ASender.HomeDir ) , fmCreate or fmShareExclusive ) ;
  372. if Assigned(FOnFtpNotifyEvent) then
  373. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'上传文件[' + Utf8ToAnsi(AFilename) + ']');
  374. end;
  375. {-------------------------------------------------------------------------------
  376. 过程名:    TFTPServer.IdFTPServer1RemoveDirectory
  377. 功能:      允许服务器在服务器删除文件系统的目录
  378. 参数:      ASender: TIdFTPServerThread; var VDirectory: string
  379. 返回值:    无
  380. -------------------------------------------------------------------------------}
  381. procedure TFTPServer.IdFTPServer1RemoveDirectory( ASender: TIdFTPServerThread;
  382. var VDirectory: string ) ;
  383. begin
  384. try
  385. RmDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
  386. except
  387. on e:Exception do
  388. begin
  389. if Assigned(FOnFtpNotifyEvent) then
  390. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除目录[' + Utf8ToAnsi(VDirectory) + ']失败，原因是' + e.Message);
  391. Exit;
  392. end;
  393. end;
  394. if Assigned(FOnFtpNotifyEvent) then
  395. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除目录[' + Utf8ToAnsi(VDirectory) + ']');
  396. end;
  397. {-------------------------------------------------------------------------------
  398. 过程名:    TFTPServer.IdFTPServer1MakeDirectory
  399. 功能:      允许服务器从服务器中创建一个新的子目录
  400. 参数:      ASender: TIdFTPServerThread; var VDirectory: string
  401. 返回值:    无
  402. -------------------------------------------------------------------------------}
  403. procedure TFTPServer.IdFTPServer1MakeDirectory( ASender: TIdFTPServerThread;
  404. var VDirectory: string ) ;
  405. begin
  406. try
  407. MkDir( TransLatePath( VDirectory, ASender.HomeDir ) ) ;
  408. except
  409. on e:Exception do
  410. begin
  411. if Assigned(FOnFtpNotifyEvent) then
  412. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'创建目录[' + Utf8ToAnsi(VDirectory) + ']失败，原因是' + e.Message);
  413. Exit;
  414. end;
  415. end;
  416. if Assigned(FOnFtpNotifyEvent) then
  417. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'创建目录[' + Utf8ToAnsi(VDirectory) + ']');
  418. end;
  419. {-------------------------------------------------------------------------------
  420. 过程名:    TFTPServer.IdFTPServer1GetFileSize
  421. 功能:      允许服务器检索在服务器文件系统的文件的大小
  422. 参数:      ASender: TIdFTPServerThread; const AFilename: string; var VFileSize: Int64
  423. 返回值:    无
  424. -------------------------------------------------------------------------------}
  425. procedure TFTPServer.IdFTPServer1GetFileSize( ASender: TIdFTPServerThread;
  426. const AFilename: string; var VFileSize: Int64 ) ;
  427. begin
  428. VFileSize := FileSizeByName( TransLatePath( AFilename, ASender.HomeDir ) ) ;
  429. if Assigned(FOnFtpNotifyEvent) then
  430. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'获取文件大小');
  431. end;
  432. {-------------------------------------------------------------------------------
  433. 过程名:    TFTPServer.IdFTPServer1DeleteFile
  434. 功能:      允许从服务器中删除的文件系统中的文件
  435. 参数:      ASender: TIdFTPServerThread; const APathname: string
  436. 返回值:    无
  437. -------------------------------------------------------------------------------}
  438. procedure TFTPServer.IdFTPServer1DeleteFile( ASender: TIdFTPServerThread;
  439. const APathname: string ) ;
  440. begin
  441. try
  442. DeleteFile( pchar( TransLatePath( ASender.CurrentDir + '/' + APathname, ASender.HomeDir ) ) ) ;
  443. except
  444. on e:Exception do
  445. begin
  446. if Assigned(FOnFtpNotifyEvent) then
  447. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除文件[' + Utf8ToAnsi(APathname) + ']失败，原因是' + e.Message);
  448. Exit;
  449. end;
  450. end;
  451. if Assigned(FOnFtpNotifyEvent) then
  452. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'删除文件[' + Utf8ToAnsi(APathname) + ']');
  453. end;
  454. {-------------------------------------------------------------------------------
  455. 过程名:    TFTPServer.IdFTPServer1ChangeDirectory
  456. 功能:      允许服务器选择一个文件系统路径
  457. 参数:      ASender: TIdFTPServerThread; var VDirectory: string
  458. 返回值:    无
  459. -------------------------------------------------------------------------------}
  460. procedure TFTPServer.IdFTPServer1ChangeDirectory( ASender: TIdFTPServerThread;
  461. var VDirectory: string ) ;
  462. begin
  463. VDirectory := GetNewDirectory( ASender.CurrentDir, VDirectory ) ;
  464. if Assigned(FOnFtpNotifyEvent) then
  465. OnFtpNotifyEvent(Now, ASender.Connection.Socket.Binding.PeerIP,'进入目录[' + Utf8ToAnsi(VDirectory) + ']');
  466. end;
  467. {-------------------------------------------------------------------------------
  468. 过程名:    TFTPServer.IdFTPServer1DisConnect
  469. 功能:      失去网络连接
  470. 参数:      AThread: TIdPeerThread
  471. 返回值:    无
  472. -------------------------------------------------------------------------------}
  473. procedure TFTPServer.IdFTPServer1DisConnect( AThread: TIdPeerThread ) ;
  474. begin
  475. //  nothing much here
  476. end;
  477. end.

使用工程示例：

unit Unit1; 
 
interface 
 
uses 
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, StdCtrls, FTPServer; 
 
type 
  TForm1 = class(TForm) 
    btn1: TButton; 
    btn2: TButton; 
    edt_BorrowDirectory: TEdit; 
    lbl1: TLabel; 
    mmo1: TMemo; 
    lbl2: TLabel; 
    edt_BorrowPort: TEdit; 
    lbl3: TLabel; 
    edt_UserName: TEdit; 
    lbl4: TLabel; 
    edt_UserPassword: TEdit; 
    procedure btn1Click(Sender: TObject); 
    procedure btn2Click(Sender: TObject); 
    procedure TFTPServer1FtpNotifyEvent(ADatetime: TDateTime;AUserIP, AEventMessage: string); 
  private 
    FFtpServer: TFTPServer; 
  public 
    { Public declarations } 
  end; 
 
var 
  Form1: TForm1; 
 
implementation 
 
 
 
{$R *.dfm} 
 
procedure TForm1.btn1Click(Sender: TObject); 
begin 
  if not Assigned(FFtpServer) then 
  begin 
    FFtpServer := TFTPServer.Create; 
    FFtpServer.UserName := Trim(edt_UserName.Text); 
    FFtpServer.UserPassword := Trim(edt_UserPassword.Text); 
    FFtpServer.BorrowDirectory := Trim(edt_BorrowDirectory.Text); 
    FFtpServer.BorrowPort := StrToInt(Trim(edt_BorrowPort.Text)); 
    FFtpServer.OnFtpNotifyEvent := TFTPServer1FtpNotifyEvent; 
    FFtpServer.Run; 
    mmo1.Lines.Add(DateTimeToStr(Now) + #32 +'FTP服务器已开启，本机IP地址：' + FFtpServer.GetBindingIP); 
  end; 
end; 
 
procedure TForm1.btn2Click(Sender: TObject); 
begin 
  if Assigned(FFtpServer) then 
  begin 
    FFtpServer.Stop; 
    FreeAndNil(FFtpServer); 
    mmo1.Lines.Add(DateTimeToStr(Now) + #32 +'FTP服务器已关闭'); 
  end; 
end; 
 
procedure TForm1.TFTPServer1FtpNotifyEvent(ADatetime: TDateTime;AUserIP, AEventMessage: string); 
begin 
  mmo1.Lines.Add(DateTimeToStr(ADatetime) + #32 + AUserIP + #32 + AEventMessage); 
  SendMessage(mmo1.Handle,WM_VSCROLL,SB_PAGEDOWN,0); 
end; 
end. 

结果如下图所示：

示例工程源码下载：http://download.csdn.net/source/3236325

http://blog.csdn.net/akof1314/article/details/6371984#comments

Indy9的TIdFTPServer封装类的更多相关文章

  1. Delphi - Indy TIdFTPServer封装类

    在Delphi 7开发下有强大的Indy控件,版本为9,要实现一个FTP服务器,参考自带的例子,发现还要写很多函数,而且不支持中文显示文件列表等等. 于是,自己改进封装了下,形成一个TFTPServe ...

  2. c#生成静态html文件，封装类

    由于这段时间比较轻松,于是想到很多的企业网站,新闻网站需要将页面静态化,于是写了个封装类来实现静态文件的生成,思路比较简单,但未完善,网友可根据自己的思路将此类扩展,运用了简单工厂模式(本来刚开始看设 ...

  3. 自动创建WIN32下多级子目录的C++封装类

            这是 WIN32 自动创建多级子目录的 C++ 封装类,用法简单.         封装没有采用类的静态函数方式,而是在构造函数里面直接完成工作.没什么具体的原因,只是当时做成这样了, ...

  4. StackExchange.Redis 访问封装类

    最近需要在C#中使用Redis,在Redis的官网找到了ServiceStack.Redis,最后在测试的时候发现这是个坑,4.0已上已经收费,后面只好找到3系列的最终版本,最后测试发现还是有BUG或 ...

  5. StackExchange.Redis通用封装类分享(转)

    阅读目录 ConnectionMultiplexer 封装 RedisHelper 通用操作类封 String类型的封装 List类型的封装 Hash类型的封装 SortedSet 类型的封装 key ...

  6. 【MongoDB】 基于C#官方驱动2.2版的封装类

    一.前言 最近项目中要用到MongoDB,因此实现做了不少的调研.发现网上很多现有关于MongoDB C#官方驱动的调用方法都是基于1.8版本的,已经不是用了最新的2.2版本.因此我在基于C#官方驱动 ...

  7. 小心Java中封装类的值比较

    一般我们使用数值时,都是使用基本类型,如int.long等,但如果你喜欢使用Integer.Long的包装类,那有一点可就得注意了.先来看下这段代码: /** * * @author trytocat ...

  8. StackExchange.Redis通用封装类分享

    前两天朋友问我,有没有使用过StackExchange.Redis,问我要个封装类,由于之前都是使用ServiceStack.Redis,由于ServiceStack.Redis v4版本后是收费版的 ...

  9. Java的String.valueOf 转换 与、空串+类型变量转换与封装类（Integer）的toString方式转换比较。

    1.空串+类型变量方式转换 int i=20; String s=""+i; 这种方式实际上经过了两个步骤,首先进行了i.ToString()把 i 转换为 字符串,然后再进行加法 ...

随机推荐

  1. 【p094】道路游戏

    Time Limit: 1 second Memory Limit: 128 MB [问题描述] 小新正在玩一个简单的电脑游戏. 游戏中有一条环形马路,马路上有n个机器人工厂,两个相邻机器人工厂之间由 ...

  2. Qt 元对象系统(Meta-Object System)（不管是否使用信号槽，都推荐使用）

    Qt 元对象系统(Meta-Object System) Qt的元对象系统基于如下三件事情: 类:QObject,为所有需要利用原对象系统的对象提供了一个基类. 宏:Q_OBJECT,通常可以声明在类 ...

  3. 超级简单的9patch

    转载请声明出处:http://blog.csdn.net/dawanganban 我们在有些应用中会用到将图片内部指定区域撑大的效果,如微信中的消息内容背景,这时候就要用到9patch图片,效果如下: ...

  4. 通过javacv对视频每隔1秒钟截取1张图片

    Exception in thread "main" java.lang.NoClassDefFoundError: Could not initialize class org. ...

  5. 在CSDN博客中添加量子恒道统计功能的做法

    作者:朱金灿 来源:http://blog.csdn.net/clever101 什么是量子恒道统计?量子恒道统计是一套免费的网站流量统计分析系统.致力于为所有个人站长.个人博主.所有网站管理者.第三 ...

  6. MySQL中 MySQL X.X Command Line Client 一闪而过

    问题介绍:我安装完MySQL(我安装的是5.5)后,使用MySQL 5.5 Command Line Client,每次点击,总是一闪而过. 从网上我查了下,都是暂时的解决的方法,不能够解决使点击 M ...

  7. 恩布拉科业务IM 1.8 版本号，内部沟通软件

    恩布拉科业务IM,开源企业IM,免费企业即时通讯,内部沟通平台,Entboost通告v1.8版本号,主要版本更新: 管理中心添加系统监控.集群管理二大功能模块:添加云盘空间.离线消息.文件大小等參数配 ...

  8. WPF文字描边的解决方法

    原文:WPF文字描边的解决方法  由于项目原因,今天研究了一下午WPF的文字描边,网上这方面的资料奇少,搞了半天才发现强大的WPF原来不直接支持文字描边啊.最后求助于MSDN,找到了方案,和大家分 ...

  9. C# WinForm 文件上传下载

    /// <summary> /// WebClient上传文件至服务器 /// </summary> /// <param name="fileNamePath ...

  10. Android 位置服务——BaiduLocation的使用

    原文:Android 位置服务--BaiduLocation的使用 版权声明:本文为博主原创文章,欢迎转载,转载请在文章显眼处说明文章出处并给出连接. https://blog.csdn.net/To ...