...unit1.pas...
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StrUtils, IdThreadMgr, IdThreadMgrDefault, IdUserAccounts,
IdBaseComponent, IdComponent, IdTCPServer, IdFTPServer, IdFTPList, StdCtrls,
OleCtrls, SHDocVw, FileCtrl;
type
TForm1 = class(TForm)
IdFTPServer1: TIdFTPServer;
IdUserManager1: TIdUserManager;
FileListBox1: TFileListBox;
IdThreadMgrDefault1: TIdThreadMgrDefault;
WebBrowser1: TWebBrowser;
FileListBox2: TFileListBox;
Memo1: TMemo;
Edit1: TEdit;
Memo2: TMemo;
procedure IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
const APath: String; ADirectoryListing: TIdFTPListItems);
procedure FormCreate(Sender: TObject);
procedure IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
procedure FileListBox1Change(Sender: TObject);
procedure IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
const AFilename: String; var VFileSize: Int64);
procedure IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
private
{ Déclarations privées }
public
{ Déclarations publiques }
end;
var
Form1: TForm1;
implementation
{$R *.dfm}
procedure TForm1.IdFTPServer1ListDirectory(ASender: TIdFTPServerThread;
const APath: String; ADirectoryListing: TIdFTPListItems);
var
buf, FSize : Integer;
FName, FDate : String;
F : file of byte;
begin
Memo1.Clear;
FileListBox1.Directory := APath;
ASender.CurrentDir := '';
ADirectoryListing.ListFormat := flfDos;
for buf := 0 to FileListBox1.Items.Count -1 do
begin
FName := APath + FileListBox1.Items.Strings[Buf];
AssignFile(F, FName);
Reset(F);
FSize := FileSize(F);
CloseFile(F);
FDate := FormatDateTime('mm/dd/yy hh:nn',FileDateToDateTime(FileAge(FName)));
Memo1.Lines.Add(FDate + ' ' + IntToStr(FSize) + ' ' + FileListBox1.Items.Strings[buf]);
end;
Memo2.Clear;
for buf := 0 to FileListBox2.Items.Count -1 do
begin
Edit1.Clear;
Edit1.Text := FileListBox2.Items.Strings[Buf];
Edit1.SelStart := 0;
Edit1.SelLength := 1;
Edit1.ClearSelection;
Edit1.SelStart := Length(Edit1.Text) - 1;
Edit1.SelLength := 1;
Edit1.ClearSelection;
if (Edit1.Text <> '.') and (Edit1.Text <> '..') then
Memo2.Lines.Add(Edit1.Text);
end;
for buf := 0 to Memo2.Lines.Count - 1 do
begin
FDate := '01-01-01 00:00';
Memo1.Lines.Add(FDate + ' <DIR> ' + Memo2.Lines.Strings[buf]);
end;
ADirectoryListing.LoadList(Memo1.Lines);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
WebBrowser1.Navigate('ftp://127.0.0.1');
end;
procedure TForm1.IdFTPServer1ChangeDirectory(ASender: TIdFTPServerThread;
var VDirectory: String);
begin
ASender.CurrentDir := VDirectory;
end;
procedure TForm1.FileListBox1Change(Sender: TObject);
begin
FileListBox2.Directory := FileListBox1.Directory;
end;
procedure TForm1.IdFTPServer1GetFileSize(ASender: TIdFTPServerThread;
const AFilename: String; var VFileSize: Int64);
var
F : File of Byte;
begin
AssignFile(F, AFileName);
Reset(F);
VFileSize := FileSize(F);
CloseFile(F);
end;
procedure TForm1.IdFTPServer1RetrieveFile(ASender: TIdFTPServerThread;
const AFileName: String; var VStream: TStream);
begin
VStream := TFileStream.Create(AFileName,fmOpenRead);
end;
procedure TForm1.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
idFTPServer1.Threads.Clear;
end;
end.
...Unit1.dfm...
object Form1: TForm1
Left = 211
Top = 107
Width = 640
Height = 433
Caption = 'Form1'
Color = clBtnFace
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'MS Sans Serif'
Font.Style = []
OldCreateOrder = False
OnCloseQuery = FormCloseQuery
OnCreate = FormCreate
PixelsPerInch = 96
TextHeight = 13
object FileListBox1: TFileListBox
Left = 0
Top = 8
Width = 169
Height = 153
ItemHeight = 13
TabOrder = 0
OnChange = FileListBox1Change
end
object WebBrowser1: TWebBrowser
Left = 184
Top = 8
Width = 441
Height = 393
TabOrder = 1
ControlData = {
4C000000942D00009E2800000000000000000000000000000000000000000000
000000004C000000000000000000000001000000E0D057007335CF11AE690800
2B2E126208000000000000004C0000000114020000000000C000000000000046
8000000000000000000000000000000000000000000000000000000000000000
00000000000000000100000000000000000000000000000000000000}
end
object FileListBox2: TFileListBox
Left = 0
Top = 176
Width = 169
Height = 65
FileType = [ftDirectory]
ItemHeight = 13
TabOrder = 2
end
object Memo1: TMemo
Left = 0
Top = 248
Width = 169
Height = 129
Lines.Strings = (
'07/02/01 10:01 <DIR> Test'
'05/06/03 1:23 612 test.txt')
ScrollBars = ssBoth
TabOrder = 3
end
object Edit1: TEdit
Left = 0
Top = 384
Width = 121
Height = 21
TabOrder = 4
Text = 'Edit1'
end
object Memo2: TMemo
Left = 0
Top = 292
Width = 185
Height = 69
Lines.Strings = (
'Memo2')
ScrollBars = ssBoth
TabOrder = 5
end
object IdFTPServer1: TIdFTPServer
Active = True
Bindings = <>
CommandHandlers = <>
DefaultPort = 21
Greeting.NumericCode = 220
Greeting.Text.Strings = (
'Serveur FTP Indy prêt.')
Greeting.TextCode = '220'
MaxConnectionReply.NumericCode = 0
ReplyExceptionCode = 0
ReplyTexts = <>
ReplyUnknownCommand.NumericCode = 500
ReplyUnknownCommand.Text.Strings = (
'Erreur de syntaxe, commande non reconnue.')
ReplyUnknownCommand.TextCode = '500'
ThreadMgr = IdThreadMgrDefault1
AnonymousAccounts.Strings = (
'anonymous'
'ftp'
'guest')
HelpReply.Strings = (
'FTP Server by LunaticSkunk')
UserAccounts = IdUserManager1
SystemType = 'WIN32'
OnChangeDirectory = IdFTPServer1ChangeDirectory
OnGetFileSize = IdFTPServer1GetFileSize
OnListDirectory = IdFTPServer1ListDirectory
OnRetrieveFile = IdFTPServer1RetrieveFile
Left = 258
Top = 242
end
object IdUserManager1: TIdUserManager
Accounts = <
item
UserName = 'User'
Password = '1234'
end>
CaseSensitiveUsernames = False
CaseSensitivePasswords = False
Left = 194
Top = 238
end
object IdThreadMgrDefault1: TIdThreadMgrDefault
Left = 222
Top = 240
end
end
