龙
龙卷风241
Unregistered / Unconfirmed
GUEST, unregistred user!
一下是一个监控ftp文件的程序：
本地运行环境 win2000 server
FTP服务器运行环境 win2000+Server－U
网络环境：两台都是网通独立主机，但FTP连接很不好，经常超时。
程序出现的问题：
下载几个文件后时间控件都停止了运行，有时就自动关闭了。
要求实现的目的：
让本地的目录与FTP服务器上的目录的文件同步。
使用其他的方法也可以。
以下是源码,请各位高手指点：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, IdFTP,IdAntiFreeze, IniFiles,
StrUtils, IdAntiFreezeBase, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TForm1 = class(TForm)
IdFTP1: TIdFTP;
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
IdAntiFreeze1: TIdAntiFreeze;
StatusBar1: TStatusBar;
Timer1: TTimer;
TempList: TListBox;
ProgressBar1: TProgressBar;
Label1: TLabel;
Timer2: TTimer;
Label2: TLabel;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
function GetNameFromDirLine(Line: String; Var IsDirectory: Boolean): String;
procedure IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
function InitConfig():Boolean;
function GetFileName(Line:String):String;
function DownLoadFile(LocalDir:String):Boolean;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
function Formatstrtotime(str:String):String;
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
downcount,completecount,scancount,filecount,dirsign,arraylength:Integer;
LocalDir,RemoteDir:String;
myini:TIniFile;
ftptimeout:Integer;
Localdirarray:array of String;
Remotedirarray:array of String;
filenamelist:array of String;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var s:TStrings;
begin
if IdFTP1.Connected then Exit;
try
IdFTP1.Connect(true);
IdFTP1.ChangeDir(RemoteDir);
IdFTP1.List(ListBox1.Items);
Timer1.Enabled := true;
Timer2.Enabled := true;
Label1.Caption := '开始运行时间：'+DateTimetoStr(Now);
except
StatusBar1.Panels[0].Text := '连接出现异常，需重试！';
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := false;
Timer2.Enabled := false;
IdFTP1.Disconnect;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
Line:String;
IsDirectory: Boolean;
begin
if not IdFTP1.Connected then Exit;
Line := ListBox1.Items[ListBox1.ItemIndex];
GetNameFromDirLine(Line,IsDirectory);
end;
function TForm1.GetNameFromDirLine(Line: String; Var IsDirectory: Boolean): String;
Var
i: Integer;
DosListing: Boolean;
begin
IsDirectory := Line[1] = 'd';
DosListing := false;
for i := 0 to 7 do begin
if (i = 2) and not IsDirectory then begin
IsDirectory := Copy(Line, 1, Pos(' ', Line) - 1) = '<DIR>';
if not IsDirectory then
DosListing := Line[1] in ['0'..'9']
else DosListing := true;
end;
Delete(Line, 1, Pos(' ', Line));
While Line[1] = ' ' do Delete(Line, 1, 1);
if DosListing and (i = 2) then break;
end;
Result := Line;
end;
procedure TForm1.IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
begin
StatusBar1.Panels[0].Text := asStatusText;
end;
function TForm1.InitConfig: Boolean;
var i:Integer;
begin
SetLength(filenamelist,100);
downcount := 0;
completecount := 0;
scancount := 0;
filecount := 0;
dirsign := 0;
myini := TIniFile.Create('vox.ini');
LocalDir := myini.ReadString('SystemInit','LocalDir','e:/');
Timer1.Enabled := false;
Timer1.Interval := myini.ReadInteger('SystemInit','Interval',60000);
ftptimeout := myini.ReadInteger('SystemInit','FtpTimeOut',500);
IdFTP1.Host := myini.ReadString('SystemInit','Host','192.168.0.1');
IdFTP1.Port := myini.ReadInteger('SystemInit','Port',21);
RemoteDir := myini.ReadString('SystemInit','Remotedir','h');
IdFTP1.User := myini.ReadString('SystemInit','Userid','');
IdFTP1.Password := myini.ReadString('SystemInit','Password','');
arraylength := myini.ReadInteger('SystemInit','UserNumber',0);
SetLength(Localdirarray,arraylength);
SetLength(Remotedirarray,arraylength);
ProgressBar1.Max := arraylength;
ListBox1.Items.Add('初始化服务器列表');
for i:=0 to arraylength-1 do
begin
Localdirarray := myini.ReadString('SystemInit','Localdir'+IntToStr(i),'');;
Remotedirarray := myini.ReadString('SystemInit','Remotedir'+IntToStr(i),'');;
ListBox1.Items.Add(Localdirarray);
ListBox1.Items.Add(Remotedirarray);
end;
end;
function TForm1.GetFileName(Line: String): String;
Var
i: Integer;
DosListing,IsDirectory: Boolean;
begin
IsDirectory := Line[1] = 'd';
DosListing := false;
for i := 0 to 7 do begin
if (i = 2) and not IsDirectory then begin
IsDirectory := Copy(Line, 1, Pos(' ', Line) - 1) = '<DIR>';
if not IsDirectory then
DosListing := Line[1] in ['0'..'9']
else DosListing := true;
end;
Delete(Line, 1, Pos(' ', Line));
While Line[1] = ' ' do Delete(Line, 1, 1);
if DosListing and (i = 2) then break;
end;
if IsDirectory then Line :='';
Result := Line;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
Label2.Caption := '现在时间是：'+DateTimeToStr(Now);
IdFTP1.ChangeDir('../'+Remotedirarray[dirsign]);
StatusBar1.Panels[3].Text := '正在扫描'+Remotedirarray[dirsign]+'文件夹';
ListBox1.Items.Clear;
IdFTP1.List(TempList.Items);
DownLoadFile(Localdirarray[dirsign]);
Inc(dirsign);
ProgressBar1.StepBy(1);
if(dirsign=arraylength) then
begin
Inc(scancount);
dirsign :=0;
ProgressBar1.Position :=0;
StatusBar1.Panels[1].Text := '扫描了'+IntToStr(scancount)+'次';
end;
except
IdFTP1.Disconnect;
IdFTP1.Connect(true);
IdFTP1.ChangeDir(RemoteDir);
IdFTP1.List(ListBox1.Items);
Timer1.Enabled := true;
Label1.Caption := '出现异常后重新开始运行时间：'+DateTimetoStr(Now);
end;
end;
function TForm1.DownLoadFile(LocalDir: String): Boolean;
var i:Integer;
filename:String;
begin
try
Timer1.Enabled := false;
for i:=0 to TempList.Count-1 do
begin
filename := GetFileName(TempList.Items.Strings);
if Length(filename)>5 then
begin
try
IdFTP1.Get(filename,LocalDir+'/'+filename,true);
IdFTP1.Delete(filename);
Inc(downcount);
StatusBar1.Panels[2].Text :='下载了'+IntToStr(downcount)+'个语音文件';
except
end;
end;
end;
TempList.Items.Clear;
Timer1.Enabled := true;
except
TempList.Items.Clear;
Timer1.Enabled := true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InitConfig;
end;
function TForm1.Formatstrtotime(str: String): String;
var yearstr,monthstr,daystr,hourstr,minitestr,secondstr:String;
begin
yearstr := LeftStr(str,4);
monthstr := MidStr(str,5,2);
daystr := MidStr(str,7,2);
hourstr := MidStr(str,9,2);
minitestr := MidStr(str,11,2);
secondstr := MidStr(str,13,2);
Result := yearstr+'-'+monthstr+'-'+daystr+' '+hourstr+':'+minitestr+':'+secondstr;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdFTP1.Disconnect;
Application.Terminate;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if not IdFTP1.Connected then
begin
IdFTP1.Connect(true);
IdFTP1.ChangeDir(RemoteDir);
IdFTP1.List(ListBox1.Items);
Timer1.Enabled := true;
Label1.Caption := '重新开始运行时间：'+DateTimetoStr(Now);
end;
end;
end.
本地运行环境 win2000 server
FTP服务器运行环境 win2000+Server－U
网络环境：两台都是网通独立主机，但FTP连接很不好，经常超时。
程序出现的问题：
下载几个文件后时间控件都停止了运行，有时就自动关闭了。
要求实现的目的：
让本地的目录与FTP服务器上的目录的文件同步。
使用其他的方法也可以。
以下是源码,请各位高手指点：
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ComCtrls, IdFTP,IdAntiFreeze, IniFiles,
StrUtils, IdAntiFreezeBase, IdBaseComponent, IdComponent,
IdTCPConnection, IdTCPClient;
type
TForm1 = class(TForm)
IdFTP1: TIdFTP;
Button1: TButton;
Button2: TButton;
ListBox1: TListBox;
IdAntiFreeze1: TIdAntiFreeze;
StatusBar1: TStatusBar;
Timer1: TTimer;
TempList: TListBox;
ProgressBar1: TProgressBar;
Label1: TLabel;
Timer2: TTimer;
Label2: TLabel;
Button3: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure ListBox1Click(Sender: TObject);
function GetNameFromDirLine(Line: String; Var IsDirectory: Boolean): String;
procedure IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
function InitConfig():Boolean;
function GetFileName(Line:String):String;
function DownLoadFile(LocalDir:String):Boolean;
procedure Timer1Timer(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormClose(Sender: TObject; var Action: TCloseAction);
function Formatstrtotime(str:String):String;
procedure Timer2Timer(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
downcount,completecount,scancount,filecount,dirsign,arraylength:Integer;
LocalDir,RemoteDir:String;
myini:TIniFile;
ftptimeout:Integer;
Localdirarray:array of String;
Remotedirarray:array of String;
filenamelist:array of String;
implementation
{$R *.dfm}
procedure TForm1.Button1Click(Sender: TObject);
var s:TStrings;
begin
if IdFTP1.Connected then Exit;
try
IdFTP1.Connect(true);
IdFTP1.ChangeDir(RemoteDir);
IdFTP1.List(ListBox1.Items);
Timer1.Enabled := true;
Timer2.Enabled := true;
Label1.Caption := '开始运行时间：'+DateTimetoStr(Now);
except
StatusBar1.Panels[0].Text := '连接出现异常，需重试！';
end;
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Timer1.Enabled := false;
Timer2.Enabled := false;
IdFTP1.Disconnect;
end;
procedure TForm1.ListBox1Click(Sender: TObject);
var
Line:String;
IsDirectory: Boolean;
begin
if not IdFTP1.Connected then Exit;
Line := ListBox1.Items[ListBox1.ItemIndex];
GetNameFromDirLine(Line,IsDirectory);
end;
function TForm1.GetNameFromDirLine(Line: String; Var IsDirectory: Boolean): String;
Var
i: Integer;
DosListing: Boolean;
begin
IsDirectory := Line[1] = 'd';
DosListing := false;
for i := 0 to 7 do begin
if (i = 2) and not IsDirectory then begin
IsDirectory := Copy(Line, 1, Pos(' ', Line) - 1) = '<DIR>';
if not IsDirectory then
DosListing := Line[1] in ['0'..'9']
else DosListing := true;
end;
Delete(Line, 1, Pos(' ', Line));
While Line[1] = ' ' do Delete(Line, 1, 1);
if DosListing and (i = 2) then break;
end;
Result := Line;
end;
procedure TForm1.IdFTP1Status(axSender: TObject; const axStatus: TIdStatus;
const asStatusText: String);
begin
StatusBar1.Panels[0].Text := asStatusText;
end;
function TForm1.InitConfig: Boolean;
var i:Integer;
begin
SetLength(filenamelist,100);
downcount := 0;
completecount := 0;
scancount := 0;
filecount := 0;
dirsign := 0;
myini := TIniFile.Create('vox.ini');
LocalDir := myini.ReadString('SystemInit','LocalDir','e:/');
Timer1.Enabled := false;
Timer1.Interval := myini.ReadInteger('SystemInit','Interval',60000);
ftptimeout := myini.ReadInteger('SystemInit','FtpTimeOut',500);
IdFTP1.Host := myini.ReadString('SystemInit','Host','192.168.0.1');
IdFTP1.Port := myini.ReadInteger('SystemInit','Port',21);
RemoteDir := myini.ReadString('SystemInit','Remotedir','h');
IdFTP1.User := myini.ReadString('SystemInit','Userid','');
IdFTP1.Password := myini.ReadString('SystemInit','Password','');
arraylength := myini.ReadInteger('SystemInit','UserNumber',0);
SetLength(Localdirarray,arraylength);
SetLength(Remotedirarray,arraylength);
ProgressBar1.Max := arraylength;
ListBox1.Items.Add('初始化服务器列表');
for i:=0 to arraylength-1 do
begin
Localdirarray := myini.ReadString('SystemInit','Localdir'+IntToStr(i),'');;
Remotedirarray := myini.ReadString('SystemInit','Remotedir'+IntToStr(i),'');;
ListBox1.Items.Add(Localdirarray);
ListBox1.Items.Add(Remotedirarray);
end;
end;
function TForm1.GetFileName(Line: String): String;
Var
i: Integer;
DosListing,IsDirectory: Boolean;
begin
IsDirectory := Line[1] = 'd';
DosListing := false;
for i := 0 to 7 do begin
if (i = 2) and not IsDirectory then begin
IsDirectory := Copy(Line, 1, Pos(' ', Line) - 1) = '<DIR>';
if not IsDirectory then
DosListing := Line[1] in ['0'..'9']
else DosListing := true;
end;
Delete(Line, 1, Pos(' ', Line));
While Line[1] = ' ' do Delete(Line, 1, 1);
if DosListing and (i = 2) then break;
end;
if IsDirectory then Line :='';
Result := Line;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
try
Label2.Caption := '现在时间是：'+DateTimeToStr(Now);
IdFTP1.ChangeDir('../'+Remotedirarray[dirsign]);
StatusBar1.Panels[3].Text := '正在扫描'+Remotedirarray[dirsign]+'文件夹';
ListBox1.Items.Clear;
IdFTP1.List(TempList.Items);
DownLoadFile(Localdirarray[dirsign]);
Inc(dirsign);
ProgressBar1.StepBy(1);
if(dirsign=arraylength) then
begin
Inc(scancount);
dirsign :=0;
ProgressBar1.Position :=0;
StatusBar1.Panels[1].Text := '扫描了'+IntToStr(scancount)+'次';
end;
except
IdFTP1.Disconnect;
IdFTP1.Connect(true);
IdFTP1.ChangeDir(RemoteDir);
IdFTP1.List(ListBox1.Items);
Timer1.Enabled := true;
Label1.Caption := '出现异常后重新开始运行时间：'+DateTimetoStr(Now);
end;
end;
function TForm1.DownLoadFile(LocalDir: String): Boolean;
var i:Integer;
filename:String;
begin
try
Timer1.Enabled := false;
for i:=0 to TempList.Count-1 do
begin
filename := GetFileName(TempList.Items.Strings);
if Length(filename)>5 then
begin
try
IdFTP1.Get(filename,LocalDir+'/'+filename,true);
IdFTP1.Delete(filename);
Inc(downcount);
StatusBar1.Panels[2].Text :='下载了'+IntToStr(downcount)+'个语音文件';
except
end;
end;
end;
TempList.Items.Clear;
Timer1.Enabled := true;
except
TempList.Items.Clear;
Timer1.Enabled := true;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
InitConfig;
end;
function TForm1.Formatstrtotime(str: String): String;
var yearstr,monthstr,daystr,hourstr,minitestr,secondstr:String;
begin
yearstr := LeftStr(str,4);
monthstr := MidStr(str,5,2);
daystr := MidStr(str,7,2);
hourstr := MidStr(str,9,2);
minitestr := MidStr(str,11,2);
secondstr := MidStr(str,13,2);
Result := yearstr+'-'+monthstr+'-'+daystr+' '+hourstr+':'+minitestr+':'+secondstr;
end;
procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
IdFTP1.Disconnect;
Application.Terminate;
end;
procedure TForm1.Timer2Timer(Sender: TObject);
begin
if not IdFTP1.Connected then
begin
IdFTP1.Connect(true);
IdFTP1.ChangeDir(RemoteDir);
IdFTP1.List(ListBox1.Items);
Timer1.Enabled := true;
Label1.Caption := '重新开始运行时间：'+DateTimetoStr(Now);
end;
end;
end.
