文件夹压缩问题(10分)

coolingxyz · 2004-05-27

一些解压缩软件都支持文件夹解压缩，有的还支持从压缩包中单独提取一个文件，或则把一个文件加入压缩包中。 我想同一路径下的文件压缩合并成一个文件，难度不是很大，只要把文件一个一个压缩，然后合并到一起就可以了，但它们在被单独提取时，怎样的结构更方便和有效，是比较麻烦的。还有如果是一个文件夹，而且文件夹下还有子文件夹及文件的话，我觉得很麻烦了。 我找了一些类似的控件，但没有源代码，所以学不到什么东西。 有没有这样的源代码，可以支持文件夹压缩的和单独文件提取、加入的？ 如果哪位朋友有的话，能不能发一份给我，或则给个网址。 这两天问了好几个问题，但都没有很好的解决，只有这么点分了。谢谢

radtek · 2004-05-27

就10分，你也真好意思。VCLZIP2.23有源代码，自己找找看

coolingxyz · 2004-05-27

我比较菜，所以手头没有分了呀。 如果仅仅解决了部分问题的也可以，同样可以给分，分数还可以再加（现在我就去赚分）。 主要就是文件夹解压缩的问题。

xuhao1 · 2004-05-27

我以前开发过的部分源码 可以压缩文件、文件夹   TCompFileInfo = record        //压缩文件记录     Name    : string;      //文件名     Attr    : string;      //属性     Content : string;       //内容   end; procedure AddDirToPackage(SouDir,DestFile:string); var FileList:TStrings;   i:integer;   FileInfo:TCompFileInfo; begin   if DirectoryExists(SouDir)=False then exit;   FileList:=TStringList.Create;   try     FindFile(IncludeTrailingPathDelimiter(SouDir)+'*.*',True,True,faAnyFile,FileList);     for i:=0 to FileList.Count-1 do       AddFileToPackage(FileList.Strings,DestFile,ExtractFilePath(SouDir));   finally     FileList.Free;   end; end; procedure CompressFile(FileName:string;var Str:string); var   SourceStream: TCompressionStream;   FileStream,DestStream: TMemoryStream;   Count:LongWord; Begin   if FileExists(FileName)=False then exit;   DestStream := TMemoryStream.Create;   FileStream := TMemoryStream.Create;   FileStream.LoadFromFile(FileName);   Count := FileStream.Size;   SourceStream:=TCompressionStream.Create(clFastest,DestStream);   Try     FileStream.SaveToStream(SourceStream);     SourceStream.Free;     FileStream.Clear;     FileStream.WriteBuffer(Count,SizeOf(Count));     FileStream.CopyFrom(DestStream, 0);     Count := FileStream.Size;     FileStream.Position:=0;     SetLength(Str,Count);     FileStream.ReadBuffer(Str[1],Count);   finally     DestStream.Free;     FileStream.Free;   end; end; function File_AddString(iFileHandle:integer;Str:String):Boolean; var   FilePos,RecLen:LongWord; begin   FilePos:=FileSeek(iFileHandle,0,1);  //保存文件当前指针位置   RecLen:=Length(Str);   Result:=(FileWrite(iFileHandle, RecLen, SizeOf(RecLen))>-1) and           (FileWrite(iFileHandle, Str[1], RecLen)>-1);   if Result=False then     FileSeek(iFileHandle,FilePos,0); end; function AddFileToPackage(SouFile,DestFile:string;RootPath:string=''):boolean; var iFileHandle:integer;   FileInfo:TCompFileInfo; begin   if FileDirExists(SouFile)=False then exit;   if FileExists(DestFile) then     iFileHandle:=FileOpen(DestFile,fmOpenWrite)   else     iFileHandle:=FileCreate(DestFile);   try     FileSeek(iFileHandle,0,2);     if RootPath='' then       FileInfo.Name:=ExtractFileName(SouFile)     else       FileInfo.Name:=RightStr(SouFile, Length(SouFile)-Length(RootPath));     FileInfo.Attr:=IntToStr(FileGetAttr(SouFile));     if DirectoryExists(SouFile) then begin       FileInfo.Name:=IncludeTrailingPathDelimiter(Fileinfo.Name);       FileInfo.Content:='';       end     else       CompressFile(SouFile,FileInfo.Content);     File_AddString(iFileHandle,FileInfo.Name);     File_AddString(iFileHandle,FileInfo.Attr);     File_AddString(iFileHandle,FileInfo.Content);   finally     FileClose(iFileHandle);   end; end; 调用   AddFileToPackage('e:/我的程序/djy/ksxt/CurPaper','e:/我的程序/djy/cs/install/client.z');   AddDirToPackage('e:/我的程序/djy/ksxt/TEST','e:/我的程序/djy/cs/install/client.z');

xuhao1 · 2004-05-27

接上 解压函数 procedure DeCompress1(CompressFile,DestPath:string); var   iFileHandle,FileSize:integer;   FileInfo:TCompFileInfo; begin   if FileExists(CompressFile)=False then exit;   if DirectoryExists(DestPath)=False then ForceDirectories(DestPath);   FileSize:=GetFileSize(CompressFile);   iFileHandle:=CreateFile(pchar(CompressFile),GENERIC_READ,0,nil,OPEN_EXISTING ,FILE_ATTRIBUTE_NORMAL,0); //ofOpenExisting);   try     while FileSeek(iFileHandle,0,spCurrent)<FileSize do begin       File_LoadString(iFileHandle,FileSize,FileInfo.Name);       Form1.Label3.Caption:='正在安装 '+FileInfo.Name;       Form1.ProgressBar1.Progress:=Form1.ProgressBar1.Progress+1;       Form1.ProgressBar1.Update;       Form1.Label3.Update;       if Pos(':',FileInfo.Name)=0 then         FileInfo.Name:=IncludeTrailingPathDelimiter(DestPath)+FileInfo.Name;       File_LoadString(iFileHandle,FileSize,FileInfo.Attr);       File_LoadString(iFileHandle,FileSize,FileInfo.Content);       if Copy(FileInfo.Name, Length(FileInfo.Name),1)='/' then         ForceDirectories(ExcludeTrailingPathDelimiter(FileInfo.Name))       else         DeCompressStr(FileInfo.Content,FileInfo.Name);     end;   finally     FileClose(iFileHandle);   end; end; 调用 DeCompress1('c:/abc.z', 'c:/abc');

coolingxyz · 2004-05-27

To xuhao1,非常感谢你的回复，但还有一些疑问！ procedure AddDirToPackage(SouDir,DestFile:string); var FileList:TStrings;   i:integer;   FileInfo:TCompFileInfo; begin   if DirectoryExists(SouDir)=False then exit;   FileList:=TStringList.Create;   try     FindFile(IncludeTrailingPathDelimiter(SouDir)+'*.*',True,True,faAnyFile,FileList);//这个不理解，也没有找到帮助     for i:=0 to FileList.Count-1 do       AddFileToPackage(FileList.Strings,DestFile,ExtractFilePath(SouDir));   finally     FileList.Free;   end; end; 还有 File_LoadString 函数，能不能也帮我帖一下。

coolingxyz · 2004-05-27

对了，还有 procedure DeCompress1(CompressFile,DestPath:string); 中的 spCurrent 变量是什么时候定义的呢？

xuhao1 · 2004-05-27

procedure FindDir(DirName:string;var DirList:TStrings); var DS:TSearchRec;   i,jd:integer;   s:string; begin   i:=0;   DirList.Clear;   DirList.Add(DirName);   while i<DirList.Count do   begin     s:=DirList.Strings;     if RightStr(s,1)<>'/' then s:=s+'/';     if FindFirst(s+'*.*',faAnyFile,Ds) = 0 then       repeat         if ((Ds.Attr and faDirectory)<>0) and (Ds.Name[1]<>'.')  then           DirList.Add(s+Ds.Name);       until FindNext(Ds) <> 0;     Inc(i);   end;   FindClose(Ds); end; procedure FindFile(FileName:String;SubDir,AbsPath:Boolean;FileAttrs:integer; var FileNames:TStrings); //搜索指定目录 var Sr : TSearchRec;     Err,i,PathLen: integer;     kzh,s:string;     DirList:TStrings;     Path,FileType:string; Begin   DirList:=Tstringlist.Create;   FileNames.Clear;   path:=ExtractFilePath(FileName);   PathLen:=Length(Path);   FileType:=ExtractFileName(FileName);   try     if SubDir then       FindDir(Path,DirList)     else       DirList.Add(Path);     for i:=0 to DirList.Count-1 do     begin       s:=DirList.Strings;       if RightStr(s,1)<>'/' then s:=s+'/';       Err:=FindFirst(s+FileType,FileAttrs,Sr);       While (Err = 0) do       begin         if ((sr.Attr and FileAttrs) = sr.Attr) and (Sr.Name[1]<>'.') then           if AbsPath then             FileNames.Add(s+Sr.Name)           else             FileNames.Add(copy(s+Sr.Name,PathLen+1,1000));         Err:=FindNext(Sr) ;       end ;     end;   finally     FindClose(Sr);     DirList.Free;   end; end; function File_LoadString(iFileHandle,iFileSize:integer;var Str:String):Boolean; var   FilePos,RecLen:LongWord; begin   FilePos:=FileSeek(iFileHandle,0,1);  //保存文件当前指针位置   Result:=(FilePos < iFileSize) and (FileRead(iFileHandle, RecLen, SizeOf(RecLen))>-1);   if Result then begin     SetLength(Str, RecLen);     Result:=(FilePos < iFileSize) and (FileRead(iFileHandle, Str[1], RecLen)>-1);   end;   if Result=False then     FileSeek(iFileHandle,FilePos,0); end;  spCurrent 变量改为 1 即可

coolingxyz · 2004-05-28

谢谢

文件夹压缩问题(10分)

coolingxyz

Unregistered / Unconfirmed

radtek

Unregistered / Unconfirmed

coolingxyz

Unregistered / Unconfirmed

xuhao1

Unregistered / Unconfirmed

xuhao1

Unregistered / Unconfirmed

coolingxyz

Unregistered / Unconfirmed

coolingxyz

Unregistered / Unconfirmed

xuhao1

Unregistered / Unconfirmed

coolingxyz

Unregistered / Unconfirmed

Similar threads