1,183
社区成员
发帖
与我相关
我的任务
分享
{-------------------------------------------------------------------------------
Description: 上傳目錄按鈕
-------------------------------------------------------------------------------}
procedure TMainForm.btn_UploadDirectoryClick(Sender: TObject);
function DoUploadDir(idftp:TIdFTP;sDirName:String;sToDirName:String;sDirBackup:String):Boolean;
var
hFindFile:Cardinal;
tfile:String;
sCurDir:String[255];
FindFileData:WIN32_FIND_DATA;
begin
//先保存目前的目錄
sCurDir:=GetCurrentDir;
ChDir(sDirName);
//idFTP.ChangeDir(AnsiToUtf8(sToDirName));
idFTP.ChangeDir(sToDirName);
hFindFile:=FindFirstFile( '*.* ',FindFileData);
Application.ProcessMessages;
if hFindFile<>INVALID_HANDLE_VALUE then
begin
repeat
tfile:=FindFileData.cFileName;
if (tfile= '.') or (tfile= '..') or (uppercase(tfile)='BACKUP') then
Continue;
if FindFileData.dwFileAttributes=FILE_ATTRIBUTE_DIRECTORY then
begin
try
ForceDirectories(sDirBackup+'\'+tfile);
//IdFTP.MakeDir(AnsiToUtf8(tfile));
IdFTP.MakeDir(tfile);
mmo_Log.Lines.Add(DateTimeToStr(Now) + ' ' + '新建資料夾:' + tfile);
except
end;
DoUploadDir(idftp,sDirName+ '\'+tfile,tfile,sDirBackup+'\'+tfile);
idftp.ChangeDir('..');
Application.ProcessMessages;
end
else
begin
//IdFTP.Put(tfile, AnsiToUtf8(tfile));
IdFTP.Put(tfile, tfile);
mmo_Log.Lines.Add(DateTimeToStr(Now) + ' ' + '上傳文件:' + tfile);
CopyFile(PChar(sDirName+ '\'+tfile), PChar(sDirBackup+'\'+tfile),False);
Application.ProcessMessages;
end;
until FindNextFile(hFindFile,FindFileData)=false;
end
else
begin
ChDir(sCurDir);
result:=false;
exit;
end;
//回到原來的目錄下
ChDir(sCurDir);
result:=true;
end;
var
strPath,strToPath,temp: string;
begin
if idftp_Client.Connected=false then
begin
//未連接
with idftp_Client do
try
Passive := True; //被動模式
Username := Trim(edt_UserName.Text);
Password := Trim(edt_UserPassword.Text);
Host := Trim(edt_ServerAddress.Text);
Connect();
Self.ChageDir(edt_CurrentDirectory.Text);
finally
btn_Connect.Enabled := True;
if Connected then
btn_Connect.Caption := '斷開連接';
mmo_Log.Lines.Add(DateTimeToStr(Now) + ' ' + '連接伺服器');
end;
end;
if idftp_Client.Connected then
begin
if chk_AutoUpload.Checked then
begin
if Trim(edt_SourceDirectory.Text)='' then
begin
MessageDlg('源文件目錄不能為空。',mterror,[mbYes],0);
exit;
end else
strPath := Trim(edt_SourceDirectory.Text);
Self.ChageDir('/');
end else
if SelectDirectory('選擇上傳目錄','',strPath)=False then exit;
//temp := Utf8ToAnsi(idftp_Client.RetrieveCurrentDir);
temp := idftp_Client.RetrieveCurrentDir;
strToPath := temp;
if Length(strToPath) = 1 then
strToPath := strToPath + ExtractFileName(strPath)
else
strToPath := strToPath + '/' + ExtractFileName(strPath);
try
//idftp_Client.MakeDir(AnsiToUtf8(ExtractFileName(strPath)));
idftp_Client.MakeDir(ExtractFileName(strPath));
except
end;
ForceDirectories(strPath+'\BACKUP'); //創建備份目錄
DoUploadDir(idftp_Client,strPath,strToPath,strPath+'\BACKUP');
Self.ChageDir(temp);
DeleteDir(edt_sourceDirectory.Text);
end;
end;
procedure TMainForm.DeleteDir(sDirectory:String);
var
sr:TSearchRec;
sPath,sFile:String;
begin
//檢查目錄名后面是否有'\'
if Copy(sDirectory,Length(sDirectory),1)<>'\'then
sPath:=sDirectory+'\'
else
sPath:=sDirectory;
//------------------------------------------------------------------
if FindFirst(sPath+'*.*',faAnyFile,sr)=0 then
begin
repeat
sFile:=Trim(sr.Name);
if (sFile= '.') or (sFile= '..') or (uppercase(sFile)='BACKUP') then
Continue;
sFile:=sPath+sr.Name;
if(sr.Attr and faDirectory)<>0 then
DeleteDir(sFile)
else if(sr.Attr and faAnyFile)=sr.Attr then
DeleteFile(sFile);//刪除文件
until FindNext(sr)<>0;
FindClose(sr);
end;
RemoveDir(sPath);
end;
TDirectory.Delete(sDirectory, True);
如果用的D7之类的,当我没说