我是一个初学者（菜鸟），有一个FTP程序运行不了？ ( 积分: 50 )

  • 主题发起人 主题发起人 lkjx
  • 开始时间 开始时间
L

lkjx

Unregistered / Unconfirmed
GUEST, unregistred user!
有一个FTP程序运行后，点击连接按钮后提示List index out of bounds (1) 请各位大虾赐教，万分感谢！请各位大虾帮我看看这段程序啊？拜托解答的详细一些谢了。（求助）
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdFTP, ComCtrls, StdCtrls,
ExtCtrls, IdIntercept, IdLogBase, IdLogEvent,IdFTPCommon,inifiles,
IDFTPList,IDGlobal, FileCtrl, ToolWin,ShellApi, Buttons;


type
TForm1 = class(TForm)
HostTxt: TEdit;
PortTxt: TEdit;
UserTxt: TEdit;
PassTxt: TEdit;
Edit1: TEdit;
Edit2: TEdit;
Edit6: TEdit;
Edit7: TEdit;
CurrentDirEdit: TComboBox;
ListBox1: TListBox;
AllBox: TListBox;
ListView1: TListView;
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
HeaderControl1: THeaderControl;
Splitter1: TSplitter;
Panel1: TPanel;
Panel2: TPanel;
LogBox: TListBox;
Panel3: TPanel;
Panel4: TPanel;
ToolBar1: TToolBar;
ConnectButton: TButton;
BackButton: TButton;
DeleteButton: TButton;
UploadButton: TButton;
DownloadButton: TButton;
CreateDirButton: TButton;
AbortButton: TButton;
ChdirButton: TButton;
ProgressBar1: TProgressBar;
CheckBox1: TCheckBox;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Button1: TButton;
Button2: TButton;
Button4: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button14: TButton;
MkDirBtn: TButton;
RmDirBtn: TButton;
Button19: TButton;
Button20: TButton;
Button21: TButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Bevel1: TBevel;
Bevel2: TBevel;
IdFTP1: TIdFTP;
StatusBar1: TStatusBar;
IdLogEvent1: TIdLogEvent;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
UsePassive: TMenuItem;
TraceCheckBox: TMenuItem;
commandPanel: TPanel;
procedure FormCreate(Sender: TObject);
procedure ConnectButtonClick(Sender: TObject);
procedure BackButtonClick(Sender: TObject);
procedure DeleteButtonClick(Sender: TObject);
procedure UploadButtonClick(Sender: TObject);
procedure DownloadButtonClick(Sender: TObject);
procedure CreateDirButtonClick(Sender: TObject);
procedure AbortButtonClick(Sender: TObject);
procedure ChdirButtonClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure MkDirBtnClick(Sender: TObject);
procedure RmDirBtnClick(Sender: TObject);
procedure Button14Click(Sender: TObject);
procedure Button19Click(Sender: TObject);
procedure Button20Click(Sender: TObject);
procedure Button21Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure CurrentDirEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure CurrentDirEditSelect(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure HeaderControl1SectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure AllBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure LogBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure AllBoxClick(Sender: TObject);
procedure AllBoxDblClick(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure UsePassiveClick(Sender: TObject);
procedure TraceCheckBoxClick(Sender: TObject);
procedure IdFTP1Disconnected(Sender: TObject);
procedure IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure IdLogEvent1Received(ASender: TComponent; const AText,
AData: String);
procedure IdLogEvent1Sent(ASender: TComponent; const AText,
AData: String);
private
AbortFlag: Boolean;
Working: Boolean;
WorkBytes: LongWord;
WorkTime: TDateTime;
Procedure ChageDir(DirName: String);
Procedure SetFlags(AValue: Boolean);
Procedure SaveInfo(Datatext, header: String);
function GetInfo(header: String): String;
Procedure Log_Out(Operation, S1: String);
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
var
AverageSpeed: Double = 0;
procedure TForm1.SetFlags(AValue: Boolean);
var
i: Integer;
begin
with CommandPanel do
for i := 0 to ControlCount - 1 do
if Controls.Name <> 'AboutButton' then Controls.Enabled := AValue;
ChdirButton.Enabled := AValue;
CreateDirButton.Enabled := AValue;
end;
procedure TForm1.ChageDir(DirName: String);
Var
LS: TStringList;
i:integer;
tmpstr:string;
ListItem: TListItem;
begin
listView1.Clear ;
listbox1.Clear ;
LS := TStringList.Create;
try
SetFlags(false);
IdFTP1.ChangeDir(DirName);
IdFTP1.TransferType := ftASCII;
CurrentDirEdit.Text := IdFTP1.RetrieveCurrentDir;
AllBox.Items.Clear;
IdFTP1.List(LS);
AllBox.Items.Assign(LS);
if AllBox.Items.Count > 0 then
if AnsiPos('total', AllBox.Items[0]) > 0 then AllBox.Items.Delete(0);
for i:=0 to IdFTP1.DirectoryListing.Count-1 do begin
if IdFTP1.DirectoryListing.Items.ItemType=ditDirectory then
listbox1.Items.add(IdFTP1.DirectoryListing.Items.FileName)
else begin
ListItem :=ListView1.Items.Add;
ListItem.Caption :=IdFTP1.DirectoryListing.Items.FileName;
ListItem.SubItems.Add(IntToStr(IdFTP1.DirectoryListing.Items.size));
ListItem.SubItems.Add(DateToStr(IdFTP1.DirectoryListing.Items.ModifiedDate));
ListItem.SubItems.Add(IdFTP1.DirectoryListing.Items.UserPermissions);
end;
end;
If (ListBox1.Items.IndexOf('..')=-1) and (ListBox1.Items.IndexOf('.')=-1) then
ListBox1.Items.Insert(0,'..');
finally
SetFlags(true);
if CurrentDirEdit.Items.IndexOf(CurrentDirEdit.Text)=-1 then
CurrentDirEdit.Items.Add(CurrentDirEdit.Text);
LS.Free;
end;
end;
procedure TForm1.SaveInfo(Datatext, header: String);
var
ServerIni: TIniFile;
begin
ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0))+
'FTP.ini');
ServerIni.WriteString('Server', header, Datatext);
ServerIni.UpdateFile;
ServerIni.Free;
end;
function TForm1.GetInfo(header: String): String;
var
ServerName: String;
ServerIni: TIniFile;
begin
ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0))
+ 'FTP.ini');
ServerName := ServerIni.ReadString('Server', header, header);
ServerIni.Free;
result := ServerName;
end;
procedure TForm1.Log_Out(Operation, S1: String);
var
S: String;
begin
while Length(S1) > 0 do
begin
if Pos(#13, S1) > 0 then
begin
S := Copy(S1, 1, Pos(#13, S1) - 1);
Delete(S1, 1, Pos(#13, S1));
if S1[1] = #10 then Delete(S1, 1, 1);
end
else
S := S1;
LogBox.ItemIndex := LogBox.Items.Add(Operation + S);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetFlags(false);
IdFTP1.Intercept := IdLogEvent1;
hosttxt.Text := GetInfo('FTPHOST');
ProgressBar1.Parent := StatusBar1;
ProgressBar1.Top := 2;
ProgressBar1.Left := 1;
ProgressBar1.Align := alClient;
end;

procedure TForm1.ConnectButtonClick(Sender: TObject);
begin
ConnectButton.Enabled := false;
if IdFTP1.Connected then
try
if Working then IdFTP1.Abort;
IdFTP1.Quit;
finally
CurrentDirEdit.Text := '/';
AllBox.Items.Clear;
SetFlags(false);
ConnectButton.Caption := '连接';
ConnectButton.Enabled := true;
ConnectButton.Default := true;
end
else
with IdFTP1 do
try
Username := UserTxt.Text;
Password := PassTxt.Text;
Host := hosttxt.Text;
port:=StrToInt(Porttxt.text);
if checkbox1.Checked=true then
begin
ProxySettings.Port:=StrToInt(Edit7.text);
ProxySettings.Host:=Edit6.Text;
ProxySettings.UserName:=Edit1.Text;
ProxySettings.PassWord:=Edit2.Text;
end;
Connect;
Self.ChageDir(CurrentDirEdit.Text);
SetFlags(true);
SaveInfo(hosttxt.Text, 'FTPHOST');
finally
ConnectButton.Enabled := true;
if Connected then
begin
ConnectButton.Caption := '断开';
ConnectButton.Default := false;
end;
end;
end;

procedure TForm1.BackButtonClick(Sender: TObject);
begin
if not IdFTP1.Connected then exit;
try
chageDir('..');
finally
end;
end;

procedure TForm1.DeleteButtonClick(Sender: TObject);
var
Name: String;
begin
if not IdFTP1.Connected then exit;
Name := IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].FileName;
if
IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].ItemType=ditdirectory
then try
SetFlags(false);
IdFTP1.RemoveDir(Name);
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
end
else
try
SetFlags(false);
Idftp1.Delete(Name);
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
end;
end;

procedure TForm1.UploadButtonClick(Sender: TObject);
begin
if IdFTP1.Connected then
begin
if OpenDialog1.Execute then
try
SetFlags(false);
IdFTP1.TransferType := ftBinary;
IdFTP1.Put(OpenDialog1.FileName,
ExtractFileName(OpenDialog1.FileName));
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.DownloadButtonClick(Sender: TObject);
var
Name: String;
begin
if (not IdFTP1.Connected) or (AllBox.ItemIndex=-1)then exit;
Name := IdFTP1.DirectoryListing.Items[AllBox.itemindex].FileName;
if
IdFTP1.DirectoryListing.Items[AllBox.itemindex].ItemType=ditDirectory then
begin
SetFlags(false);
ChageDir(Name);
SetFlags(true);
end
else
begin
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then
begin
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(Name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtConfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
mrCancel: begin
exit;
end;
end;
end
else
begin
IdFTP1.Get(Name, SaveDialog1.FileName, false);
end;
end;
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.CreateDirButtonClick(Sender: TObject);
var
S: String;
begin
S := InputBox('Make new directory', 'Name', '');
if S <> '' then
try
SetFlags(false);
IdFTP1.MakeDir(S);
ChageDir(CurrentDirEdit.Text);
finally
SetFlags(true);
end;
end;

procedure TForm1.AbortButtonClick(Sender: TObject);
begin
AbortFlag := true;
end;

procedure TForm1.ChdirButtonClick(Sender: TObject);
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
dirstr: string;
begin
if DirectoryListBox1.ItemIndex=-1 then exit;
dirstr := InputBox('建立目录','输入新建目录名：','');
if dirstr <>'' then
begin
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+TimeToStr(time)+'==>>'+
'执行指令本地新建目录'+DirectoryListBox1.Directory+'/'+dirstr);
mkDir(DirectoryListBox1.Directory+'/'+dirstr);
DirectoryListBox1.Directory:=DirectoryListBox1.Directory+'/'+dirstr;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
q: String;
d: char;
begin
if DirectoryListBox1.ItemIndex=-1 then exit;
q:='确信要删除目录 '+DirectoryListBox1.Directory+' ?'+#0;
if MessageDlg(q,mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
d:=DirectoryListBox1.Drive;
q:=DirectoryListBox1.Directory;
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+TimeToStr(time)+'==>>'+
'执行指令删除本地目录'+q);
DirectoryListBox1.Directory:=ExtractFilePath(q);
RmDir(q);
DirectoryListBox1.Clear;
DirectoryListBox1.Drive:=d;
DirectoryListBOx1.Directory:=ExtractFilePath(q);
end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
command: String;
begin
if FileListBox1.ItemIndex=-1 then Exit;
command:='notepad '+FileListBox1.FileName+#0;
StatusBar1.Panels[1].Text:=(DateToStr(Date)+
''+TimeToStr(time)+'==>>'+
'执行指令运行本地文件：'+FileListBox1.FileName);
WinExec(PChar(@command[1]),SW_SHOW);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
command: String;
begin
if FileListBox1.ItemIndex=-1 then Exit;
command:=FileListBox1.FileName+#0;
ShellExecute(Application.Handle,nil,PChar(@command[1]),nil,nil,SW_SHOW);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+
TimeToStr(time)+'==>>'+
'执行指令本地运行文件：'+FileListBox1.FileName);
end;

procedure TForm1.Button8Click(Sender: TObject);
var
tmpstr: string;
f: file;
begin
if FileListBox1.ItemIndex=-1 then Exit;
tmpstr:=InputBox('文件更名','输入新名称:','');
if tmpstr<>'' then
begin
AssignFile(f,FileListBox1.FileName);
Rename(f,ExtractFilePath(FileListBox1.FileName)+ExtractFileName(tmpstr));
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+TimeToStr(time)+'==>>'+
'执行指令文件更名并刷新');
end;
end;

procedure TForm1.Button9Click(Sender: TObject);
var
f: file;
q: string;
begin
if FileListBox1.ItemIndex=-1 then Exit;
q:='确认要删除 '+ExtractFileName(FileListBox1.FileName)+' ?'+#0;
if MessageDlg(q,mtconfirmation,[mbYes,mbNo],0)=mrYes then
begin
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令删除本地文件'+FileListBox1.FileName);
AssignFile(f,FileListBox1.FileName);
Erase(f);
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+
TimeToStr(time)+'==>>'+
'执行指令本地刷新');
end;

procedure TForm1.MkDirBtnClick(Sender: TObject);
var
dirn: string;
begin
if IdFTP1.Connected=true then
begin
dirn:=InputBox('建立目录','输入目录名','newdir');
if dirn<>'' then
begin
try
IdFTP1.MakeDir(dirn);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
finally
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令建立远程目录');
end;
end;
end;
end;

procedure TForm1.RmDirBtnClick(Sender: TObject);
var
dirn,dirtmp:string;
begin
if (IdFTP1.Connected=true) and
(Listbox1.ItemIndex<>-1) then
begin
if ListBox1.Items[ListBox1.ItemIndex]<>'' then
dirtmp:=ListBox1.Items[ListBox1.ItemIndex]
else
dirtmp:='';
dirn:=InputBox('删除目录','输入目录名',dirtmp);
if dirn<>'' then
begin
try
IdFTP1.RemoveDir(dirn);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
finally
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令删除远程目录');
end;
end;
end;
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
if (ListBox1.ItemIndex<>-1) and (IdFTP1.Connected=true) then
begin
IdFTP1.ChangeDir(ListBox1.Items[ListBox1.itemindex]);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令更换远程目录'+ListBox1.Items[ListBox1.ItemIndex]);
CurrentDirEdit.Text:=ListBox1.Items[ListBox1.itemindex];
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;
end;

procedure TForm1.Button19Click(Sender: TObject);
var
tmpstr: string;
begin
if Listview1.ItemIndex<>-1 then
begin
if not IdFTP1.Connected or (Listview1.ItemIndex=-1) then exit;
tmpstr:=InputBox('文件更名', '输入新名称', '');
if tmpstr<>'' then
begin
IdFTP1.Rename(Listview1.Items[ListBox1.itemindex].Caption, tmpstr);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令远程文件更名');
end;
end;
end;

procedure TForm1.Button20Click(Sender: TObject);
var
q: String;
begin
if not IdFTP1.Connected or (Listview1.ItemIndex=-1) then Exit;
q:='确认要删除 '+
Listview1.Items[Listview1.itemindex].Caption+' ?'+#0;
if MessageDlg(q,mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
IdFTP1.Delete(Listview1.Items[Listview1.ItemIndex].Caption);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令远程文件删除');
end;
end;

procedure TForm1.Button21Click(Sender: TObject);
begin
if IdFTP1.Connected=true then
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令刷新远程文件');
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if FileListBox1.ItemIndex<>-1 then
begin
try
Setflags(false);
IdFTP1.TransferType := ftBinary;
IdFTP1.Put(FileListBox1.FileName,ExtractFileName(FileListBox1.FileName));
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令上传本地文件'+FileListBox1.FileName);
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
name: string;
begin
if Listview1.ItemIndex<>-1 then
begin
try
name:=Listview1.Items[Listview1.itemindex].Caption;
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtconfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, Name, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, Name, true);
end;
mrCancel: begin
exit;
end;
end;
end
else
begin
IdFTP1.Get(Name, Name, false);
end;
finally
SetFlags(true);
end;
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令下载远程文件'+Listview1.Items[Listview1.itemindex].Caption);
end;
end;

procedure TForm1.CurrentDirEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=VK_RETURN) and (IdFTP1.Connected) then
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
CurrentDirEdit.Items.Add(CurrentDirEdit.Text);
end;
end;

procedure TForm1.CurrentDirEditSelect(Sender: TObject);
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
Name: String;
begin
if not IdFTP1.Connected then exit;
if Listview1.ItemIndex>-1 then
begin
Name:=Listview1.Items[Listview1.itemindex].Caption;
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then
begin
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(Name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtConfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
mrCancel: begin
exit;
end;
end;
end
else
begin
IdFTP1.Get(Name, SaveDialog1.FileName, false);
end;
end;
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
pathName: String;
begin
if not IdFTP1.Connected then exit;
if Listbox1.ItemIndex<>-1 then
begin
PathName:= ListBox1.Items[ListBox1.itemindex];
SetFlags(false);
ChageDir(PathName);
SetFlags(true);
end;
end;

procedure TForm1.HeaderControl1SectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
begin
AllBox.Repaint;
end;

procedure TForm1.AllBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
R: TRect;
begin
if odSelected in State then
begin
if odSelected in State then
begin
AllBox.Canvas.Brush.Color := $00895F0A;
AllBox.Canvas.Font.Color := clWhite;
end
else
AllBox.Canvas.Brush.Color := clWindow;
if Assigned(IdFTP1.DirectoryListing) and
(IdFTP1.DirectoryListing.Count > Index) then
begin
AllBox.Canvas.FillRect(Rect);
with IdFTP1.DirectoryListing.Items[index] do
begin
AllBox.Canvas.Font.Size:=8;
AllBox.Canvas.TextOut(Rect.Left, Rect.Top, FileName);
R := Rect;
R.Left := Rect.Left + HeaderControl1.Sections.Items[0].Width;
R.Right := Rect.Left + HeaderControl1.Sections.Items[1].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, R.Top, IntToStr(Size));
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[2].Width;
AllBox.Canvas.FillRect(R);
if itemtype=ditDirectory then
begin
AllBox.Canvas.TextOut(R.Left, Rect.Top, 'Directory');
end
else
AllBox.Canvas.TextOut(R.Left, R.Top, 'File');
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[3].Width;
AllBox.Canvas.FillRect(R);
AllBOx.Canvas.TextOut(R.Left, Rect.Top,
FormatDateTime('mm/dd/yyyy hh:mm', Modifieddate));
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[4].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, Rect.Top, GroupName);
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[5].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, Rect.Top, OwnerName);
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[6].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, Rect.Top, OwnerPermissions +
GroupPermissions + UserPermissions);
end;
end;
end;
end;

procedure TForm1.LogBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
if Pos('>>', LogBox.Items[Index]) > 1 then
LogBox.Canvas.Font.Color := clRed
else
LogBox.Canvas.Font.Color := clBlue;
if odSelected in State then
begin
LogBox.Canvas.Brush.Color := $00895F0A;
LogBox.Canvas.Font.Color := clWhite;
end
else
LogBox.Canvas.Brush.Color := clWindow;
LogBox.Canvas.FillRect(Rect);
LogBox.Canvas.TextOut(Rect.Left, Rect.Top, LogBox.Items[Index]);
end;

procedure TForm1.AllBoxClick(Sender: TObject);
begin
if not IdFTP1.Connected then exit;
if AllBox.ItemIndex > -1 then
begin
if IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].ItemType=ditDirectory
then
DownloadButton.Caption := '进入'
else
DownloadButton.Caption := '下载';
end;
end;

procedure TForm1.AllBoxDblClick(Sender: TObject);
var
Name: String;
begin
if not IdFTP1.Connected then exit;
Name := IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].FileName;
if IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].ItemType=ditDirectory then
begin
SetFlags(false);
ChageDir(Name);
SetFlags(true);
end
else
begin
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then
begin
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(Name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtConfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
mrCancel: begin
exit;
end;
end;
end
else begin
IdFTP1.Get(Name, SaveDialog1.FileName, false);
end;
end;
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
LogBox.Items.LoadFromFile('ftptool.log');
end;

procedure TForm1.N4Click(Sender: TObject);
begin
LogBox.Items.SaveToFile('ftptool.log');
ShowMessage('日志文件存储为 "ftptool.log" 。');
end;

procedure TForm1.N5Click(Sender: TObject);
begin
LogBox.Clear;
end;

procedure TForm1.UsePassiveClick(Sender: TObject);
begin
UsePassive.Checked := not UsePassive.Checked;
IdFTP1.Passive := Usepassive.Checked;
end;

procedure TForm1.TraceCheckBoxClick(Sender: TObject);
begin
TraceCheckBox.Checked := not TraceCheckBox.Checked;
if TracecheckBox.Checked then
IdFTP1.Intercept := IdLogEvent1
else
IdFTP1.Intercept := nil;
LogBox.Visible := TraceCheckBox.Checked;
if LogBox.Visible then
Splitter1.Top := LogBox.Top + 5;
end;

procedure TForm1.IdFTP1Disconnected(Sender: TObject);
begin
StatusBar1.Panels[1].Text := 'Disconnected.';
end;

procedure TForm1.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
begin
LogBox.ItemIndex := LogBox.Items.Add(aStatusText);
StatusBar1.Panels[1].Text := aStatusText;
end;

procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
var
S: String;
TotalTime: TDateTime;
H, M, Sec, MS: Word;
DLTime: Double;
begin
TotalTime := Now - WorkTime;
DecodeTime(TotalTime, H, M, Sec, MS);
Sec := Sec + M * 60 + H * 3600;
DLTime := Sec + MS / 1000;
if DLTime > 0 then
AverageSpeed := (AWorkCount / 1024) / DLTime;
if AverageSpeed > 0 then
begin
Sec := Trunc(((ProgressBar1.Max - AWorkCount) / 1024) /
AverageSpeed);
S := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
S := '剩余时间 ' + S;
end
else
S := '';
S := FormatFloat('0.00 KB/s', AverageSpeed) + '; ' + S;
case AWorkMode of
wmRead: StatusBar1.Panels[1].Text := '下载速度 ' + S;
wmWrite: StatusBar1.Panels[1].Text := '上传速度 ' + S;
end;
if AbortFlag then IdFTP1.Abort;
ProgressBar1.Position := AWorkCount;
AbortFlag := false;
end;

procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
Working := true;
AbortButton.Visible := true;
AbortFlag := false;
WorkTime := Now;
if AWorkCountMax > 0 then
ProgressBar1.Max := AWorkCountMax
else
ProgressBar1.Max := WorkBytes;
AverageSpeed := 0;
end;

procedure TForm1.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
AbortButton.Visible := false;
StatusBar1.Panels[1].Text := '传送完毕。';
WorkBytes := 0;
Working := false;
ProgressBar1.Position := 0;
AverageSpeed := 0;
end;

procedure TForm1.IdLogEvent1Received(ASender: TComponent; const AText,
AData: String);
begin
Log_Out('<<-', AData);
end;

procedure TForm1.IdLogEvent1Sent(ASender: TComponent; const AText,
AData: String);
begin
Log_Out('->>', AData);
end;

end.
 
有一个FTP程序运行后，点击连接按钮后提示List index out of bounds (1) 请各位大虾赐教，万分感谢！请各位大虾帮我看看这段程序啊？拜托解答的详细一些谢了。（求助）
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, Menus, IdAntiFreezeBase, IdAntiFreeze, IdBaseComponent,
IdComponent, IdTCPConnection, IdTCPClient, IdFTP, ComCtrls, StdCtrls,
ExtCtrls, IdIntercept, IdLogBase, IdLogEvent,IdFTPCommon,inifiles,
IDFTPList,IDGlobal, FileCtrl, ToolWin,ShellApi, Buttons;


type
TForm1 = class(TForm)
HostTxt: TEdit;
PortTxt: TEdit;
UserTxt: TEdit;
PassTxt: TEdit;
Edit1: TEdit;
Edit2: TEdit;
Edit6: TEdit;
Edit7: TEdit;
CurrentDirEdit: TComboBox;
ListBox1: TListBox;
AllBox: TListBox;
ListView1: TListView;
DriveComboBox1: TDriveComboBox;
DirectoryListBox1: TDirectoryListBox;
FileListBox1: TFileListBox;
HeaderControl1: THeaderControl;
Splitter1: TSplitter;
Panel1: TPanel;
Panel2: TPanel;
LogBox: TListBox;
Panel3: TPanel;
Panel4: TPanel;
ToolBar1: TToolBar;
ConnectButton: TButton;
BackButton: TButton;
DeleteButton: TButton;
UploadButton: TButton;
DownloadButton: TButton;
CreateDirButton: TButton;
AbortButton: TButton;
ChdirButton: TButton;
ProgressBar1: TProgressBar;
CheckBox1: TCheckBox;
GroupBox1: TGroupBox;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
Label4: TLabel;
Label5: TLabel;
Label6: TLabel;
Label7: TLabel;
Label8: TLabel;
Label9: TLabel;
Button1: TButton;
Button2: TButton;
Button4: TButton;
Button6: TButton;
Button7: TButton;
Button8: TButton;
Button9: TButton;
Button14: TButton;
MkDirBtn: TButton;
RmDirBtn: TButton;
Button19: TButton;
Button20: TButton;
Button21: TButton;
SpeedButton1: TSpeedButton;
SpeedButton2: TSpeedButton;
Bevel1: TBevel;
Bevel2: TBevel;
IdFTP1: TIdFTP;
StatusBar1: TStatusBar;
IdLogEvent1: TIdLogEvent;
OpenDialog1: TOpenDialog;
SaveDialog1: TSaveDialog;
MainMenu1: TMainMenu;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
UsePassive: TMenuItem;
TraceCheckBox: TMenuItem;
commandPanel: TPanel;
procedure FormCreate(Sender: TObject);
procedure ConnectButtonClick(Sender: TObject);
procedure BackButtonClick(Sender: TObject);
procedure DeleteButtonClick(Sender: TObject);
procedure UploadButtonClick(Sender: TObject);
procedure DownloadButtonClick(Sender: TObject);
procedure CreateDirButtonClick(Sender: TObject);
procedure AbortButtonClick(Sender: TObject);
procedure ChdirButtonClick(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
procedure Button7Click(Sender: TObject);
procedure Button8Click(Sender: TObject);
procedure Button9Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure MkDirBtnClick(Sender: TObject);
procedure RmDirBtnClick(Sender: TObject);
procedure Button14Click(Sender: TObject);
procedure Button19Click(Sender: TObject);
procedure Button20Click(Sender: TObject);
procedure Button21Click(Sender: TObject);
procedure SpeedButton1Click(Sender: TObject);
procedure SpeedButton2Click(Sender: TObject);
procedure CurrentDirEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
procedure CurrentDirEditSelect(Sender: TObject);
procedure ListView1DblClick(Sender: TObject);
procedure ListBox1DblClick(Sender: TObject);
procedure HeaderControl1SectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
procedure AllBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure LogBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
procedure AllBoxClick(Sender: TObject);
procedure AllBoxDblClick(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N4Click(Sender: TObject);
procedure N5Click(Sender: TObject);
procedure UsePassiveClick(Sender: TObject);
procedure TraceCheckBoxClick(Sender: TObject);
procedure IdFTP1Disconnected(Sender: TObject);
procedure IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
procedure IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
procedure IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
procedure IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
procedure IdLogEvent1Received(ASender: TComponent; const AText,
AData: String);
procedure IdLogEvent1Sent(ASender: TComponent; const AText,
AData: String);
private
AbortFlag: Boolean;
Working: Boolean;
WorkBytes: LongWord;
WorkTime: TDateTime;
Procedure ChageDir(DirName: String);
Procedure SetFlags(AValue: Boolean);
Procedure SaveInfo(Datatext, header: String);
function GetInfo(header: String): String;
Procedure Log_Out(Operation, S1: String);
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
var
AverageSpeed: Double = 0;
procedure TForm1.SetFlags(AValue: Boolean);
var
i: Integer;
begin
with CommandPanel do
for i := 0 to ControlCount - 1 do
if Controls.Name <> 'AboutButton' then Controls.Enabled := AValue;
ChdirButton.Enabled := AValue;
CreateDirButton.Enabled := AValue;
end;
procedure TForm1.ChageDir(DirName: String);
Var
LS: TStringList;
i:integer;
tmpstr:string;
ListItem: TListItem;
begin
listView1.Clear ;
listbox1.Clear ;
LS := TStringList.Create;
try
SetFlags(false);
IdFTP1.ChangeDir(DirName);
IdFTP1.TransferType := ftASCII;
CurrentDirEdit.Text := IdFTP1.RetrieveCurrentDir;
AllBox.Items.Clear;
IdFTP1.List(LS);
AllBox.Items.Assign(LS);
if AllBox.Items.Count > 0 then
if AnsiPos('total', AllBox.Items[0]) > 0 then AllBox.Items.Delete(0);
for i:=0 to IdFTP1.DirectoryListing.Count-1 do begin
if IdFTP1.DirectoryListing.Items.ItemType=ditDirectory then
listbox1.Items.add(IdFTP1.DirectoryListing.Items.FileName)
else begin
ListItem :=ListView1.Items.Add;
ListItem.Caption :=IdFTP1.DirectoryListing.Items.FileName;
ListItem.SubItems.Add(IntToStr(IdFTP1.DirectoryListing.Items.size));
ListItem.SubItems.Add(DateToStr(IdFTP1.DirectoryListing.Items.ModifiedDate));
ListItem.SubItems.Add(IdFTP1.DirectoryListing.Items.UserPermissions);
end;
end;
If (ListBox1.Items.IndexOf('..')=-1) and (ListBox1.Items.IndexOf('.')=-1) then
ListBox1.Items.Insert(0,'..');
finally
SetFlags(true);
if CurrentDirEdit.Items.IndexOf(CurrentDirEdit.Text)=-1 then
CurrentDirEdit.Items.Add(CurrentDirEdit.Text);
LS.Free;
end;
end;
procedure TForm1.SaveInfo(Datatext, header: String);
var
ServerIni: TIniFile;
begin
ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0))+
'FTP.ini');
ServerIni.WriteString('Server', header, Datatext);
ServerIni.UpdateFile;
ServerIni.Free;
end;
function TForm1.GetInfo(header: String): String;
var
ServerName: String;
ServerIni: TIniFile;
begin
ServerIni := TIniFile.Create(ExtractFilePath(ParamStr(0))
+ 'FTP.ini');
ServerName := ServerIni.ReadString('Server', header, header);
ServerIni.Free;
result := ServerName;
end;
procedure TForm1.Log_Out(Operation, S1: String);
var
S: String;
begin
while Length(S1) > 0 do
begin
if Pos(#13, S1) > 0 then
begin
S := Copy(S1, 1, Pos(#13, S1) - 1);
Delete(S1, 1, Pos(#13, S1));
if S1[1] = #10 then Delete(S1, 1, 1);
end
else
S := S1;
LogBox.ItemIndex := LogBox.Items.Add(Operation + S);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
SetFlags(false);
IdFTP1.Intercept := IdLogEvent1;
hosttxt.Text := GetInfo('FTPHOST');
ProgressBar1.Parent := StatusBar1;
ProgressBar1.Top := 2;
ProgressBar1.Left := 1;
ProgressBar1.Align := alClient;
end;

procedure TForm1.ConnectButtonClick(Sender: TObject);
begin
ConnectButton.Enabled := false;
if IdFTP1.Connected then
try
if Working then IdFTP1.Abort;
IdFTP1.Quit;
finally
CurrentDirEdit.Text := '/';
AllBox.Items.Clear;
SetFlags(false);
ConnectButton.Caption := '连接';
ConnectButton.Enabled := true;
ConnectButton.Default := true;
end
else
with IdFTP1 do
try
Username := UserTxt.Text;
Password := PassTxt.Text;
Host := hosttxt.Text;
port:=StrToInt(Porttxt.text);
if checkbox1.Checked=true then
begin
ProxySettings.Port:=StrToInt(Edit7.text);
ProxySettings.Host:=Edit6.Text;
ProxySettings.UserName:=Edit1.Text;
ProxySettings.PassWord:=Edit2.Text;
end;
Connect;
Self.ChageDir(CurrentDirEdit.Text);
SetFlags(true);
SaveInfo(hosttxt.Text, 'FTPHOST');
finally
ConnectButton.Enabled := true;
if Connected then
begin
ConnectButton.Caption := '断开';
ConnectButton.Default := false;
end;
end;
end;

procedure TForm1.BackButtonClick(Sender: TObject);
begin
if not IdFTP1.Connected then exit;
try
chageDir('..');
finally
end;
end;

procedure TForm1.DeleteButtonClick(Sender: TObject);
var
Name: String;
begin
if not IdFTP1.Connected then exit;
Name := IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].FileName;
if
IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].ItemType=ditdirectory
then try
SetFlags(false);
IdFTP1.RemoveDir(Name);
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
end
else
try
SetFlags(false);
Idftp1.Delete(Name);
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
end;
end;

procedure TForm1.UploadButtonClick(Sender: TObject);
begin
if IdFTP1.Connected then
begin
if OpenDialog1.Execute then
try
SetFlags(false);
IdFTP1.TransferType := ftBinary;
IdFTP1.Put(OpenDialog1.FileName,
ExtractFileName(OpenDialog1.FileName));
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.DownloadButtonClick(Sender: TObject);
var
Name: String;
begin
if (not IdFTP1.Connected) or (AllBox.ItemIndex=-1)then exit;
Name := IdFTP1.DirectoryListing.Items[AllBox.itemindex].FileName;
if
IdFTP1.DirectoryListing.Items[AllBox.itemindex].ItemType=ditDirectory then
begin
SetFlags(false);
ChageDir(Name);
SetFlags(true);
end
else
begin
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then
begin
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(Name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtConfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
mrCancel: begin
exit;
end;
end;
end
else
begin
IdFTP1.Get(Name, SaveDialog1.FileName, false);
end;
end;
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.CreateDirButtonClick(Sender: TObject);
var
S: String;
begin
S := InputBox('Make new directory', 'Name', '');
if S <> '' then
try
SetFlags(false);
IdFTP1.MakeDir(S);
ChageDir(CurrentDirEdit.Text);
finally
SetFlags(true);
end;
end;

procedure TForm1.AbortButtonClick(Sender: TObject);
begin
AbortFlag := true;
end;

procedure TForm1.ChdirButtonClick(Sender: TObject);
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
dirstr: string;
begin
if DirectoryListBox1.ItemIndex=-1 then exit;
dirstr := InputBox('建立目录','输入新建目录名：','');
if dirstr <>'' then
begin
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+TimeToStr(time)+'==>>'+
'执行指令本地新建目录'+DirectoryListBox1.Directory+'/'+dirstr);
mkDir(DirectoryListBox1.Directory+'/'+dirstr);
DirectoryListBox1.Directory:=DirectoryListBox1.Directory+'/'+dirstr;
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
q: String;
d: char;
begin
if DirectoryListBox1.ItemIndex=-1 then exit;
q:='确信要删除目录 '+DirectoryListBox1.Directory+' ?'+#0;
if MessageDlg(q,mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
d:=DirectoryListBox1.Drive;
q:=DirectoryListBox1.Directory;
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+TimeToStr(time)+'==>>'+
'执行指令删除本地目录'+q);
DirectoryListBox1.Directory:=ExtractFilePath(q);
RmDir(q);
DirectoryListBox1.Clear;
DirectoryListBox1.Drive:=d;
DirectoryListBOx1.Directory:=ExtractFilePath(q);
end;
end;

procedure TForm1.Button6Click(Sender: TObject);
var
command: String;
begin
if FileListBox1.ItemIndex=-1 then Exit;
command:='notepad '+FileListBox1.FileName+#0;
StatusBar1.Panels[1].Text:=(DateToStr(Date)+
''+TimeToStr(time)+'==>>'+
'执行指令运行本地文件：'+FileListBox1.FileName);
WinExec(PChar(@command[1]),SW_SHOW);
end;

procedure TForm1.Button7Click(Sender: TObject);
var
command: String;
begin
if FileListBox1.ItemIndex=-1 then Exit;
command:=FileListBox1.FileName+#0;
ShellExecute(Application.Handle,nil,PChar(@command[1]),nil,nil,SW_SHOW);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+
TimeToStr(time)+'==>>'+
'执行指令本地运行文件：'+FileListBox1.FileName);
end;

procedure TForm1.Button8Click(Sender: TObject);
var
tmpstr: string;
f: file;
begin
if FileListBox1.ItemIndex=-1 then Exit;
tmpstr:=InputBox('文件更名','输入新名称:','');
if tmpstr<>'' then
begin
AssignFile(f,FileListBox1.FileName);
Rename(f,ExtractFilePath(FileListBox1.FileName)+ExtractFileName(tmpstr));
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+TimeToStr(time)+'==>>'+
'执行指令文件更名并刷新');
end;
end;

procedure TForm1.Button9Click(Sender: TObject);
var
f: file;
q: string;
begin
if FileListBox1.ItemIndex=-1 then Exit;
q:='确认要删除 '+ExtractFileName(FileListBox1.FileName)+' ?'+#0;
if MessageDlg(q,mtconfirmation,[mbYes,mbNo],0)=mrYes then
begin
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令删除本地文件'+FileListBox1.FileName);
AssignFile(f,FileListBox1.FileName);
Erase(f);
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
end;
end;

procedure TForm1.Button4Click(Sender: TObject);
begin
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''+
TimeToStr(time)+'==>>'+
'执行指令本地刷新');
end;

procedure TForm1.MkDirBtnClick(Sender: TObject);
var
dirn: string;
begin
if IdFTP1.Connected=true then
begin
dirn:=InputBox('建立目录','输入目录名','newdir');
if dirn<>'' then
begin
try
IdFTP1.MakeDir(dirn);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
finally
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令建立远程目录');
end;
end;
end;
end;

procedure TForm1.RmDirBtnClick(Sender: TObject);
var
dirn,dirtmp:string;
begin
if (IdFTP1.Connected=true) and
(Listbox1.ItemIndex<>-1) then
begin
if ListBox1.Items[ListBox1.ItemIndex]<>'' then
dirtmp:=ListBox1.Items[ListBox1.ItemIndex]
else
dirtmp:='';
dirn:=InputBox('删除目录','输入目录名',dirtmp);
if dirn<>'' then
begin
try
IdFTP1.RemoveDir(dirn);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
finally
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令删除远程目录');
end;
end;
end;
end;

procedure TForm1.Button14Click(Sender: TObject);
begin
if (ListBox1.ItemIndex<>-1) and (IdFTP1.Connected=true) then
begin
IdFTP1.ChangeDir(ListBox1.Items[ListBox1.itemindex]);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令更换远程目录'+ListBox1.Items[ListBox1.ItemIndex]);
CurrentDirEdit.Text:=ListBox1.Items[ListBox1.itemindex];
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;
end;

procedure TForm1.Button19Click(Sender: TObject);
var
tmpstr: string;
begin
if Listview1.ItemIndex<>-1 then
begin
if not IdFTP1.Connected or (Listview1.ItemIndex=-1) then exit;
tmpstr:=InputBox('文件更名', '输入新名称', '');
if tmpstr<>'' then
begin
IdFTP1.Rename(Listview1.Items[ListBox1.itemindex].Caption, tmpstr);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令远程文件更名');
end;
end;
end;

procedure TForm1.Button20Click(Sender: TObject);
var
q: String;
begin
if not IdFTP1.Connected or (Listview1.ItemIndex=-1) then Exit;
q:='确认要删除 '+
Listview1.Items[Listview1.itemindex].Caption+' ?'+#0;
if MessageDlg(q,mtConfirmation,[mbYes,mbNo],0)=mrYes then
begin
IdFTP1.Delete(Listview1.Items[Listview1.ItemIndex].Caption);
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令远程文件删除');
end;
end;

procedure TForm1.Button21Click(Sender: TObject);
begin
if IdFTP1.Connected=true then
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令刷新远程文件');
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
if FileListBox1.ItemIndex<>-1 then
begin
try
Setflags(false);
IdFTP1.TransferType := ftBinary;
IdFTP1.Put(FileListBox1.FileName,ExtractFileName(FileListBox1.FileName));
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令上传本地文件'+FileListBox1.FileName);
ChageDir(IdFTP1.RetrieveCurrentDir);
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
var
name: string;
begin
if Listview1.ItemIndex<>-1 then
begin
try
name:=Listview1.Items[Listview1.itemindex].Caption;
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtconfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, Name, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, Name, true);
end;
mrCancel: begin
exit;
end;
end;
end
else
begin
IdFTP1.Get(Name, Name, false);
end;
finally
SetFlags(true);
end;
FileListBox1.Mask:='';
FileListBox1.Mask:='*.*';
StatusBar1.Panels[1].Text:=(DateToStr(Date)+''
+TimeToStr(time)+'==>>'+
'执行指令下载远程文件'+Listview1.Items[Listview1.itemindex].Caption);
end;
end;

procedure TForm1.CurrentDirEditKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if (Key=VK_RETURN) and (IdFTP1.Connected) then
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
CurrentDirEdit.Items.Add(CurrentDirEdit.Text);
end;
end;

procedure TForm1.CurrentDirEditSelect(Sender: TObject);
begin
SetFlags(false);
ChageDir(CurrentDirEdit.Text);
SetFlags(true);
end;

procedure TForm1.ListView1DblClick(Sender: TObject);
var
Name: String;
begin
if not IdFTP1.Connected then exit;
if Listview1.ItemIndex>-1 then
begin
Name:=Listview1.Items[Listview1.itemindex].Caption;
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then
begin
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(Name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtConfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
mrCancel: begin
exit;
end;
end;
end
else
begin
IdFTP1.Get(Name, SaveDialog1.FileName, false);
end;
end;
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.ListBox1DblClick(Sender: TObject);
var
pathName: String;
begin
if not IdFTP1.Connected then exit;
if Listbox1.ItemIndex<>-1 then
begin
PathName:= ListBox1.Items[ListBox1.itemindex];
SetFlags(false);
ChageDir(PathName);
SetFlags(true);
end;
end;

procedure TForm1.HeaderControl1SectionResize(HeaderControl: THeaderControl;
Section: THeaderSection);
begin
AllBox.Repaint;
end;

procedure TForm1.AllBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
var
R: TRect;
begin
if odSelected in State then
begin
if odSelected in State then
begin
AllBox.Canvas.Brush.Color := $00895F0A;
AllBox.Canvas.Font.Color := clWhite;
end
else
AllBox.Canvas.Brush.Color := clWindow;
if Assigned(IdFTP1.DirectoryListing) and
(IdFTP1.DirectoryListing.Count > Index) then
begin
AllBox.Canvas.FillRect(Rect);
with IdFTP1.DirectoryListing.Items[index] do
begin
AllBox.Canvas.Font.Size:=8;
AllBox.Canvas.TextOut(Rect.Left, Rect.Top, FileName);
R := Rect;
R.Left := Rect.Left + HeaderControl1.Sections.Items[0].Width;
R.Right := Rect.Left + HeaderControl1.Sections.Items[1].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, R.Top, IntToStr(Size));
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[2].Width;
AllBox.Canvas.FillRect(R);
if itemtype=ditDirectory then
begin
AllBox.Canvas.TextOut(R.Left, Rect.Top, 'Directory');
end
else
AllBox.Canvas.TextOut(R.Left, R.Top, 'File');
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[3].Width;
AllBox.Canvas.FillRect(R);
AllBOx.Canvas.TextOut(R.Left, Rect.Top,
FormatDateTime('mm/dd/yyyy hh:mm', Modifieddate));
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[4].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, Rect.Top, GroupName);
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[5].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, Rect.Top, OwnerName);
R.Left := R.Right;
R.Right := R.Left + HeaderControl1.Sections.Items[6].Width;
AllBox.Canvas.FillRect(R);
AllBox.Canvas.TextOut(R.Left, Rect.Top, OwnerPermissions +
GroupPermissions + UserPermissions);
end;
end;
end;
end;

procedure TForm1.LogBoxDrawItem(Control: TWinControl; Index: Integer;
Rect: TRect; State: TOwnerDrawState);
begin
if Pos('>>', LogBox.Items[Index]) > 1 then
LogBox.Canvas.Font.Color := clRed
else
LogBox.Canvas.Font.Color := clBlue;
if odSelected in State then
begin
LogBox.Canvas.Brush.Color := $00895F0A;
LogBox.Canvas.Font.Color := clWhite;
end
else
LogBox.Canvas.Brush.Color := clWindow;
LogBox.Canvas.FillRect(Rect);
LogBox.Canvas.TextOut(Rect.Left, Rect.Top, LogBox.Items[Index]);
end;

procedure TForm1.AllBoxClick(Sender: TObject);
begin
if not IdFTP1.Connected then exit;
if AllBox.ItemIndex > -1 then
begin
if IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].ItemType=ditDirectory
then
DownloadButton.Caption := '进入'
else
DownloadButton.Caption := '下载';
end;
end;

procedure TForm1.AllBoxDblClick(Sender: TObject);
var
Name: String;
begin
if not IdFTP1.Connected then exit;
Name := IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].FileName;
if IdFTP1.DirectoryListing.Items[AllBox.ItemIndex].ItemType=ditDirectory then
begin
SetFlags(false);
ChageDir(Name);
SetFlags(true);
end
else
begin
try
SaveDialog1.FileName := Name;
if SaveDialog1.Execute then
begin
SetFlags(false);
IdFTP1.TransferType := ftBinary;
WorkBytes := IdFTP1.Size(Name);
if FileExists(Name) then
begin
case MessageDlg('文件已存在，重新下载吗？',
mtConfirmation, mbYesNoCancel, 0) of
mrYes: begin
WorkBytes := WorkBytes - FileSizeByName(Name);
IdFTP1.Get(Name, SaveDialog1.FileName, false, true);
end;
mrNo: begin
IdFTP1.Get(Name, SaveDialog1.FileName, true);
end;
mrCancel: begin
exit;
end;
end;
end
else begin
IdFTP1.Get(Name, SaveDialog1.FileName, false);
end;
end;
finally
SetFlags(true);
end;
end;
end;

procedure TForm1.N3Click(Sender: TObject);
begin
LogBox.Items.LoadFromFile('ftptool.log');
end;

procedure TForm1.N4Click(Sender: TObject);
begin
LogBox.Items.SaveToFile('ftptool.log');
ShowMessage('日志文件存储为 "ftptool.log" 。');
end;

procedure TForm1.N5Click(Sender: TObject);
begin
LogBox.Clear;
end;

procedure TForm1.UsePassiveClick(Sender: TObject);
begin
UsePassive.Checked := not UsePassive.Checked;
IdFTP1.Passive := Usepassive.Checked;
end;

procedure TForm1.TraceCheckBoxClick(Sender: TObject);
begin
TraceCheckBox.Checked := not TraceCheckBox.Checked;
if TracecheckBox.Checked then
IdFTP1.Intercept := IdLogEvent1
else
IdFTP1.Intercept := nil;
LogBox.Visible := TraceCheckBox.Checked;
if LogBox.Visible then
Splitter1.Top := LogBox.Top + 5;
end;

procedure TForm1.IdFTP1Disconnected(Sender: TObject);
begin
StatusBar1.Panels[1].Text := 'Disconnected.';
end;

procedure TForm1.IdFTP1Status(ASender: TObject; const AStatus: TIdStatus;
const AStatusText: String);
begin
LogBox.ItemIndex := LogBox.Items.Add(aStatusText);
StatusBar1.Panels[1].Text := aStatusText;
end;

procedure TForm1.IdFTP1Work(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCount: Integer);
var
S: String;
TotalTime: TDateTime;
H, M, Sec, MS: Word;
DLTime: Double;
begin
TotalTime := Now - WorkTime;
DecodeTime(TotalTime, H, M, Sec, MS);
Sec := Sec + M * 60 + H * 3600;
DLTime := Sec + MS / 1000;
if DLTime > 0 then
AverageSpeed := (AWorkCount / 1024) / DLTime;
if AverageSpeed > 0 then
begin
Sec := Trunc(((ProgressBar1.Max - AWorkCount) / 1024) /
AverageSpeed);
S := Format('%2d:%2d:%2d', [Sec div 3600, (Sec div 60) mod 60, Sec mod 60]);
S := '剩余时间 ' + S;
end
else
S := '';
S := FormatFloat('0.00 KB/s', AverageSpeed) + '; ' + S;
case AWorkMode of
wmRead: StatusBar1.Panels[1].Text := '下载速度 ' + S;
wmWrite: StatusBar1.Panels[1].Text := '上传速度 ' + S;
end;
if AbortFlag then IdFTP1.Abort;
ProgressBar1.Position := AWorkCount;
AbortFlag := false;
end;

procedure TForm1.IdFTP1WorkBegin(Sender: TObject; AWorkMode: TWorkMode;
const AWorkCountMax: Integer);
begin
Working := true;
AbortButton.Visible := true;
AbortFlag := false;
WorkTime := Now;
if AWorkCountMax > 0 then
ProgressBar1.Max := AWorkCountMax
else
ProgressBar1.Max := WorkBytes;
AverageSpeed := 0;
end;

procedure TForm1.IdFTP1WorkEnd(Sender: TObject; AWorkMode: TWorkMode);
begin
AbortButton.Visible := false;
StatusBar1.Panels[1].Text := '传送完毕。';
WorkBytes := 0;
Working := false;
ProgressBar1.Position := 0;
AverageSpeed := 0;
end;

procedure TForm1.IdLogEvent1Received(ASender: TComponent; const AText,
AData: String);
begin
Log_Out('<<-', AData);
end;

procedure TForm1.IdLogEvent1Sent(ASender: TComponent; const AText,
AData: String);
begin
Log_Out('->>', AData);
end;

end.
 
您必须登录或注册才可回复。

Similar threads

I
一个群发邮件的DELPHI代码
回复
0
查看
769
import
I
I
怎样发现是否有 SOFTICE在运行？
回复
0
查看
599
import
I
I
判断一个服务是否已经运行
回复
0
查看
488
import
I
I
杀死一个进程
回复
0
查看
597
import
I
I
图形的拖动
回复
0
查看
566
import
I
后退
顶部