xe2上內建的zip

發文回覆瀏覽次數：1038

推到 Plurk!

推到 Facebook!

cat200188
中階會員

發表：37
回覆：78
積分：68
註冊：2005-01-18

發送簡訊給我

#1 引用回覆回覆

發表時間：2012-11-18 22:05:31

IP:59.126.xxx.xxx 訂閱

[code delphi]
uses system.zip

procedure MakeFileList(Path:string;ADirStrings,AFileStrings:TStrings);

var

sch:TSearchrec;

s:string;

begin

if RightStr(Trim(Path), 1) <> '\' then

Path := Trim(Path) '\'

else

Path := Trim(Path);

ADirStrings.Clear;

AFileStrings.Clear;

if not DirectoryExists(Path) then exit;

if FindFirst(Path '*', faAnyfile, sch) = 0 then

begin

repeat

Application.ProcessMessages;

if ((sch.Name = '.') or (sch.Name = '..')) then Continue;

s:=ExtractFileExt(Path sch.Name);

if FileGetAttr(Path sch.Name)=faDirectory then

ADirStrings.Add(Path sch.Name)

else

AFileStrings.Add(Path sch.Name);

Application.ProcessMessages;

until FindNext(sch)<>0;

FindClose(sch);

end;

function zipuplist(zf:TZipFile;path:String):boolean ;

var

i:Integer;

ADirStrings,AFileStrings:TStrings;

begin

try

ADirStrings:=TStringList.Create;

AFileStrings:=TStringList.Create;

MakeFileList(path,ADirStrings,AFileStrings);

for i:=0 to AFileStrings.Count-1 do

begin

zf.Add(AFileStrings[i],AFileStrings[i]);

end;

for i:=0 to ADirStrings.Count-1 do

begin

zipuplist(zf,ADirStrings[i]);

end;

ADirStrings.Free ;

AFileStrings.Free ;

result := true ;

except

on E: Exception do

begin

result := false ;

end;

function zipup(filename,zippath:String):boolean ;

var

zf:TZipFile;

i:Integer;

ADirStrings,AFileStrings:TStrings;

begin

try

ADirStrings:=TStringList.Create;

AFileStrings:=TStringList.Create;

MakeFileList(zippath,ADirStrings,AFileStrings);

zf:=TZipFile.Create;

zf.Open(filename,zmWrite);

for i:=0 to AFileStrings.Count-1 do

begin

zf.Add(AFileStrings[i],AFileStrings[i]);

end;

for i:=0 to ADirStrings.Count-1 do

begin

zipuplist(zf,ADirStrings[i]);

end;

zf.Close;

zf.Free ;

ADirStrings.Free ;

AFileStrings.Free ;

result := true ;

except

on E: Exception do

begin

result := false ;

end;

function zipdown(filename:String):boolean ;

var

zf:TZipFile;

i:Integer;

begin

try

zf:=TZipFile.Create;

zf.Open(filename,zmRead);

for i:=0 to zf.FileCount-1 do

begin

//ShowMessage(zf.FileName[i]);

zf.Extract(zf.FileName[i],ExtractFilePath(zf.FileName[i]),true);

end;

//zf.ExtractAll(zippath);

zf.Close;

zf.Free;

result := true ;

except

on E: Exception do

begin

result := false ;

end;

[/code]

------
.......

系統時間：2024-11-21 23:50:39

聯絡我們 | Delphi K.Top討論版

本站聲明

1. 本論壇為無營利行為之開放平台，所有文章都是由網友自行張貼，如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權，而損及您的利益，請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨，是藍是綠本站無權干涉，但這裡不是政治性論壇！