*-*-*-*.????文件不能复制？問題出在哪？ |
|
尚未結案
|
|
WWW999
一般會員   發表：18 回覆：19 積分：7 註冊：2005-09-26 發送簡訊給我 |
這是malanlk老大給我寫的，當時我沒有試一次，現在要用了，才發現文件不能复制 我試了很多次，就是不能复制文件，我也不知道哪出錯了。
文件：12345－2345－2345－4567.1102 我只是做了一下改動 { Private declarations }
public
{ Public declarations }
end; var
Form1: TForm1; implementation {$R *.dfm}
var
StrDirectory: String; // 包含 k1-k12 的目錄
StrDirectory_From: String; // 來源目錄
StrDirectory_To: String; // 目的目錄 function CheckFileFormat(sFile: String): Boolean;
begin
//在這裡檢查檔案格式是不是符合需求
Result := True;
end; function CheckAndCreateDirectory(DestDir: String): Boolean;
begin
Result := False;
if not DirectoryExists(DestDir) then
Result := ForceDirectories(DestDir)
else
Result := True;
end; procedure TForm1.FormShow(Sender: TObject); begin
StrDirectory := ExtractFileDir(ParamStr(0));
StrDirectory := IncludeTrailingBackslash(StrDirectory);
StrDirectory_From := IncludeTrailingBackslash(StrDirectory 'TestSrc');
StrDirectory_To := IncludeTrailingBackslash(StrDirectory 'TestDest');
begin
PageControl1.ActivePage:=TabSheet2;//*激活第二页 end;
end; procedure TForm1.BitBtn6Click(Sender: TObject);
var
SearchRec: TSearchRec;
ExtName: String;
mm,dd: String;
toPath: String;
fFrom,fTo: String;
begin
StrDirectory_From := ExtractFileDir(edit4.text);
StrDirectory_To := ExtractFileDir(edit5.text);
if DirectoryExists( StrDirectory_From) then
if FindFirst( StrDirectory_From '*.*', faAnyFile, SearchRec) = 0 then
begin
repeat
if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
begin
//如果是檔案才做
if (SearchRec.Attr and faArchive) = faArchive then
begin
// 檔案名稱符合規格才做
if CheckFileFormat(SearchRec.Name) then
begin
ExtName := ExtractFileExt(SearchRec.Name);
mm := Copy(ExtName,2,2); // 取出月份
dd := Copy(ExtName,4,2); // 取出日期
if (''<>mm) and (''<>dd) then
begin toPath := IncludeTrailingBackslash(StrDirectory_To 'm' mm) 'd' dd;
if CheckAndCreateDirectory(toPath) then fFrom := StrDirectory_From SearchRec.Name;
fTo := IncludeTrailingBackslash(toPath SearchRec.Name;
try
CopyFile(PChar((fFrom) SearchRec.Name), PChar((fTo) SearchRec.Name), false);
except
end;
end;
end;
end;
end; until FindNext(SearchRec) <> 0;
end;
FindClose(SearchRec);
end;
end.
|
發表時間：2005-11-02 17:03:39
IP:222.161.xxx.xxx 未訂閱
系統時間：2024-11-25 18:40:40
聯絡我們 | Delphi K.Top討論版
| 本站聲明 |
|
1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。 2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。 3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！ |