我要将一个文件夹压缩成一个文件,需要的时候再解压缩,请问在程序中如何实现?

解决方案 »

  1.   

    //参考如下代码~~
    unit Unit1;interfaceuses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls, ComCtrls, Buttons;type
      TForm1 = class(TForm)
        ButtonCompression: TButton;
        ButtonDecompression: TButton;
        EditFileName: TEdit;
        EditDirectory: TEdit;
        SpeedButtonFileName: TSpeedButton;
        SpeedButtonDirectory: TSpeedButton;
        OpenDialog1: TOpenDialog;
        procedure ButtonCompressionClick(Sender: TObject);
        procedure ButtonDecompressionClick(Sender: TObject);
        procedure SpeedButtonFileNameClick(Sender: TObject);
        procedure SpeedButtonDirectoryClick(Sender: TObject);
      private
        { Private declarations }
      public
        { Public declarations }
      end;var
      Form1: TForm1;implementation{$R *.dfm}(*//
    标题:压缩和解压目录
    说明:利用ZLib单元;不处理空目录
    设计:Zswang
    日期:2003-09-06
    支持:[email protected]
    //*)///////Begin Source
    uses ZLib, FileCtrl;const cBufferSize = $4096;function FileCompression(mFileName: TFileName; mStream: TStream): Integer;
    var
      vFileStream: TFileStream;
      vBuffer: array[0..cBufferSize]of Char;
      vPosition: Integer;
      I: Integer;
    begin
      Result := -1;
      if not FileExists(mFileName) then Exit;
      if not Assigned(mStream) then Exit;
      vPosition := mStream.Position;
      vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
      with TCompressionStream.Create(clMax, mStream) do try
        for I := 1 to vFileStream.Size div cBufferSize do begin
          vFileStream.Read(vBuffer, cBufferSize);
          Write(vBuffer, cBufferSize);
        end;
        I := vFileStream.Size mod cBufferSize;
        if I > 0 then begin
          vFileStream.Read(vBuffer, I);
          Write(vBuffer, I);
        end;
      finally
        Free;
        vFileStream.Free;
      end;
      Result := mStream.Size - vPosition; //增量
    end; { FileCompression }function FileDecompression(mFileName: TFileName; mStream: TStream): Integer;
    var
      vFileStream: TFileStream;
      vBuffer: array[0..cBufferSize]of Char;
      I: Integer;
    begin
      Result := -1;
      if not Assigned(mStream) then Exit;
      ForceDirectories(ExtractFilePath(mFileName)); //创建目录
      
      vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);  with TDecompressionStream.Create(mStream) do try
        repeat
          I := Read(vBuffer, cBufferSize);
          vFileStream.Write(vBuffer, I);
        until I = 0;
        Result := vFileStream.Size;
      finally
        Free;
        vFileStream.Free;
      end;
    end; { FileDecompression }function StrLeft(const mStr: string; mDelimiter: string): string;
    begin
      Result := Copy(mStr, 1, Pos(mDelimiter, mStr) - 1);
    end; { StrLeft }function StrRight(const mStr: string; mDelimiter: string): string;
    begin
      if Pos(mDelimiter, mStr) > 0 then
        Result := Copy(mStr, Pos(mDelimiter, mStr) + Length(mDelimiter), MaxInt)
      else Result := '';
    end; { StrRight }type
      TFileHead = packed record
        rIdent: string[3]; //标识
        rVersion: Byte; //版本
      end;const
      cIdent: string[3] = 'zsf';
      cVersion = $01;
      cErrorIdent = -1;
      cErrorVersion = -2;function DirectoryCompression(mDirectory, mFileName: TFileName): Integer;
    var
      vFileInfo: TStrings;
      vFileInfoSize: Integer;
      vFileInfoBuffer: PChar;
      vFileHead: TFileHead;  vMemoryStream: TMemoryStream;
      vFileStream: TFileStream;  procedure pAppendFile(mSubFile: TFileName);
      begin
        vFileInfo.Append(Format('%s|%d',
          [StringReplace(mSubFile, mDirectory + '\', '', [rfReplaceAll, rfIgnoreCase]),
            FileCompression(mSubFile, vMemoryStream)]));
        Inc(Result);
      end; { pAppendFile }  procedure pSearchFile(mPath: TFileName);
      var
        vSearchRec: TSearchRec;
        K: Integer;
      begin
        K := FindFirst(mPath + '\*.*', faAnyFile, vSearchRec);
        while K = 0 do begin
          if (vSearchRec.Attr and faDirectory > 0) and
            (Pos(vSearchRec.Name, '..') = 0) then
            pSearchFile(mPath + '\' + vSearchRec.Name)
          else if Pos(vSearchRec.Name, '..') = 0 then
            pAppendFile(mPath + '\' + vSearchRec.Name);
          K := FindNext(vSearchRec);
        end;
        FindClose(vSearchRec);
      end; { pSearchFile }
    begin
      Result := 0;
      if not DirectoryExists(mDirectory) then Exit;
      vFileInfo := TStringList.Create;
      vMemoryStream := TMemoryStream.Create;
      mDirectory := ExcludeTrailingPathDelimiter(mDirectory);  vFileStream := TFileStream.Create(mFileName, fmCreate or fmShareDenyWrite);
      try
        pSearchFile(mDirectory);
        vFileInfoBuffer := vFileInfo.GetText;
        vFileInfoSize := StrLen(vFileInfoBuffer);    { DONE -oZswang -c添加 : 写入头文件信息 }
        vFileHead.rIdent := cIdent;
        vFileHead.rVersion := cVersion;
        vFileStream.Write(vFileHead, SizeOf(vFileHead));    vFileStream.Write(vFileInfoSize, SizeOf(vFileInfoSize));
        vFileStream.Write(vFileInfoBuffer^, vFileInfoSize);
        vMemoryStream.Position := 0;
        vFileStream.CopyFrom(vMemoryStream, vMemoryStream.Size);
      finally
        vFileInfo.Free;
        vMemoryStream.Free;
        vFileStream.Free;
      end;
    end; { DirectoryCompression }function DirectoryDecompression(mDirectory, mFileName: TFileName): Integer;
    var
      vFileInfo: TStrings;
      vFileInfoSize: Integer;
      vFileHead: TFileHead;  vMemoryStream: TMemoryStream;
      vFileStream: TFileStream;
      I: Integer;
    begin
      Result := 0;
      if not FileExists(mFileName) then Exit;
      vFileInfo := TStringList.Create;
      vMemoryStream := TMemoryStream.Create;
      mDirectory := ExcludeTrailingPathDelimiter(mDirectory);
      vFileStream := TFileStream.Create(mFileName, fmOpenRead or fmShareDenyNone);
      try
        if vFileStream.Size < SizeOf(vFileHead) then Exit;
        { DONE -oZswang -c添加 : 读取头文件信息 }
        vFileStream.Read(vFileHead, SizeOf(vFileHead));
        if vFileHead.rIdent <> cIdent then Result := cErrorIdent;
        if vFileHead.rVersion <> cVersion then Result := cErrorVersion;
        if Result <> 0 then Exit;    vFileStream.Read(vFileInfoSize, SizeOf(vFileInfoSize));
        vMemoryStream.CopyFrom(vFileStream, vFileInfoSize);
        vMemoryStream.Position := 0;
        vFileInfo.LoadFromStream(vMemoryStream);    for I := 0 to vFileInfo.Count - 1 do begin
          vMemoryStream.Clear;
          vMemoryStream.CopyFrom(vFileStream,
            StrToIntDef(StrRight(vFileInfo[I], '|'), 0));
          vMemoryStream.Position := 0;
          FileDecompression(mDirectory + '\' + StrLeft(vFileInfo[I], '|'),
            vMemoryStream);
        end;
        Result := vFileInfo.Count;
      finally
        vFileInfo.Free;
        vMemoryStream.Free;
        vFileStream.Free;
      end;
    end; { DirectoryDeompression }
    ///////End Source///////Begin Demo
    procedure TForm1.ButtonCompressionClick(Sender: TObject);
    begin
      Caption := 'DirectoryCompression:' +
        IntToStr(DirectoryCompression(EditDirectory.Text, EditFileName.Text));
    end;procedure TForm1.ButtonDecompressionClick(Sender: TObject);
    begin
      Caption := 'DirectoryDecompression:' + 
        IntToStr(DirectoryDecompression(EditDirectory.Text, EditFileName.Text));
    end;procedure TForm1.SpeedButtonFileNameClick(Sender: TObject);
    begin
      if not OpenDialog1.Execute then Exit;
      EditFileName.Text := OpenDialog1.FileName;
    end;procedure TForm1.SpeedButtonDirectoryClick(Sender: TObject);
    var
      vDirectory: string;
    begin
      vDirectory := EditDirectory.Text;
      if not SelectDirectory('Select', '', vDirectory) then Exit;
      EditDirectory.Text := vDirectory;
    end;
    ///////End Demoend.
      

  2.   

    zswangII(伴水清清)(职业清洁工) 
      多谢了!还有一个问题能在帮一下吗?怎样用sql中的in子句连接带密码的access数据库?
      

  3.   

    //try
    SELECT [Test].* INTO [C:\Test.mdb;pwd=1234].[test] FROM [Test] 
    SELECT * FROM [C:\Test.mdb;pwd=1234].[test]