复杂的结构化存取(三) : 存取函数

╰半夏微凉° 2022-01-15 10:51 337阅读 0赞

[为什么80%的码农都做不了架构师？>>> ][80_] ![hot3.png][]

今天写了四个小函数, 拿来与大家共享:  
  
Dir2Doc: 把文件夹下的所有文件(不包括子文件夹)保存成一个复合文件;  
  
Doc2Dir: Dir2Doc 的反操作;  
  
ZipDir2Doc: 同 Dir2Doc, 只是同时执行了压缩;  
  
UnZipDoc2Dir: ZipDir2Doc 的反操作.

--------------------

函数及测试代码(分别在 Delphi 2007 和 Delphi 2009 下测试通过):

--------------------

unit Unit1;
    
    interface
    
    uses
      Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
      Dialogs, StdCtrls;
    
    type
      TForm1 = class(TForm)
        Button1: TButton;
        Button2: TButton;
        Button3: TButton;
        Button4: TButton;
        procedure Button1Click(Sender: TObject);
        procedure Button2Click(Sender: TObject);
        procedure Button3Click(Sender: TObject);
        procedure Button4Click(Sender: TObject);
      end;
    
    var
      Form1: TForm1;
    
    implementation
    
    {$R *.dfm}
    
    uses ActiveX, Zlib; {函数用到的单元}
    
    {把指定文件夹下的文件保存到一个复合文件}
    function Dir2Doc(SourcePath, DestFile: string): Boolean;
    const
      Mode = STGM_CREATE or STGM_WRITE or STGM_SHARE_EXCLUSIVE;
    var
      sr: TSearchRec;
      Stg: IStorage;
      Stm: IStream;
      ms: TMemoryStream;
    begin
      Result := False;
      SourcePath := ExcludeTrailingPathDelimiter(SourcePath);        {去掉最后一个 '\'}
      if not DirectoryExists(SourcePath) then Exit;                  {如果源路径不存在则退出}
    
      if not DirectoryExists(ExtractFileDir(DestFile)) then          {假如目标目录不存在}
        if not ForceDirectories(ExtractFileDir(DestFile)) then Exit; {就创建, 若创建失败退出.}
    
      {如果目标路径不存在则退出}
    
      StgCreateDocfile(PWideChar(WideString(DestFile)), Mode, 0, Stg); {建立复合文件根路径}
    
      if FindFirst(SourcePath + '\*.*', faAnyFile, sr) = 0 then
      begin
        repeat
          if sr.Name[1] = '.' then Continue; {如果是'.' 或 '..' (当前目录或上层目录)则忽略}
          if (sr.Attr and faDirectory) <> faDirectory then
          begin
            Stg.CreateStream(PWideChar(WideString(sr.Name)), Mode, 0, 0, Stm);
            ms := TMemoryStream.Create;
            ms.LoadFromFile(SourcePath + '\' + sr.Name);
            ms.Position := 0;
            Stm.Write(ms.Memory, ms.Size, nil);
            ms.Free;
          end;
        until (FindNext(sr) <> 0);
      end;
      Result := True;
    end;
    
    {上一个 Dir2Doc 函数的反操作}
    function Doc2Dir(SourceFile, DestPath: string): Boolean;
    const
      Mode = STGM_READ or STGM_SHARE_EXCLUSIVE;
    var
      Stg: IStorage;
      Stm: IStream;
      StatStg: TStatStg;
      EnumStatStg: IEnumStatStg;
      ms: TMemoryStream;
      i: Integer;
    begin
      Result := False;
      if not FileExists(SourceFile) then Exit;       {如果文件不存在退出}
      if not DirectoryExists(DestPath) then          {如果目标目录不存在}
        if not ForceDirectories(DestPath) then Exit; {就创建, 若创建失败退出}
    
      DestPath := ExcludeTrailingPathDelimiter(DestPath); {去掉最后一个 '\'}
    
      StgOpenStorage(PWideChar(WideString(SourceFile)), nil, Mode, nil, 0, Stg);
      Stg.EnumElements(0, nil, 0, EnumStatStg);
    
      while True do
      begin
        EnumStatStg.Next(1, StatStg, @i);
        if (i = 0) or (StatStg.dwType = 1) then Break; {dwType = 1 时是文件夹}
        Stg.OpenStream(StatStg.pwcsName, nil, Mode, 0, Stm);
        ms := TMemoryStream.Create;
        ms.SetSize(StatStg.cbSize);
        Stm.Read(ms.Memory, ms.Size, nil);
        ms.SaveToFile(DestPath + '\' + StatStg.pwcsName);
        ms.Free;
      end;
      Result := True;
    end;
    
    {把指定文件夹下的文件压缩到一个复合文件}
    function ZipDir2Doc(SourcePath, DestFile: string): Boolean;
    const
      Mode = STGM_CREATE or STGM_WRITE or STGM_SHARE_EXCLUSIVE;
    var
      sr: TSearchRec;
      Stg: IStorage;
      Stm: IStream;
      ms1,ms2: TMemoryStream;
      zip: TCompressionStream;
      num: Int64;
    begin
      Result := False;
      SourcePath := ExcludeTrailingPathDelimiter(SourcePath);        {去掉最后一个 '\'}
      if not DirectoryExists(SourcePath) then Exit;                  {如果源路径不存在则退出}
      if not DirectoryExists(ExtractFileDir(DestFile)) then          {假如目标目录不存在}
        if not ForceDirectories(ExtractFileDir(DestFile)) then Exit; {就创建, 若创建失败退出.}
    
      StgCreateDocfile(PWideChar(WideString(DestFile)), Mode, 0, Stg); {建立复合文件根路径}
    
      if FindFirst(SourcePath + '\*.*', faAnyFile, sr) = 0 then
      begin
        repeat
          if sr.Name[1] = '.' then Continue; {如果是'.' 或 '..' (当前目录或上层目录)则忽略}
          if (sr.Attr and faDirectory) <> faDirectory then
          begin
            Stg.CreateStream(PWideChar(WideString(sr.Name)), Mode, 0, 0, Stm);
            ms1 := TMemoryStream.Create;
            ms2 := TMemoryStream.Create;
            ms1.LoadFromFile(SourcePath + '\' + sr.Name);
    
            num := ms1.Size;
            ms2.Write(num, SizeOf(num));
            zip := TCompressionStream.Create(clMax, ms2);
            ms1.SaveToStream(zip);
            zip.Free;
    
            ms2.Position := 0;
            Stm.Write(ms2.Memory, ms2.Size, nil);
    
            ms1.Free;
            ms2.Free;
          end;
        until (FindNext(sr) <> 0);
      end;
      Result := True;
    end;
    
    {上一个 ZipDir2Doc 函数的反操作}
    function UnZipDoc2Dir(SourceFile, DestPath: string): Boolean;
    const
      Mode = STGM_READ or STGM_SHARE_EXCLUSIVE;
    var
      Stg: IStorage;
      Stm: IStream;
      StatStg: TStatStg;
      EnumStatStg: IEnumStatStg;
      ms1,ms2: TMemoryStream;
      i: Integer;
      num: Int64;
      UnZip: TDecompressionStream;
    begin
      Result := False;
      if not FileExists(SourceFile) then Exit;    {如果文件不存在退出}
      if not DirectoryExists(DestPath) then          {如果目标目录不存在}
        if not ForceDirectories(DestPath) then Exit; {就创建, 若创建失败退出}
    
      DestPath := ExcludeTrailingPathDelimiter(DestPath); {去掉最后一个 '\'}
    
      StgOpenStorage(PWideChar(WideString(SourceFile)), nil, Mode, nil, 0, Stg);
      Stg.EnumElements(0, nil, 0, EnumStatStg);
    
      while True do
      begin
        EnumStatStg.Next(1, StatStg, @i);
        if (i = 0) or (StatStg.dwType = 1) then Break; {dwType = 1 时是文件夹}
        Stg.OpenStream(StatStg.pwcsName, nil, Mode, 0, Stm);
        ms1 := TMemoryStream.Create;
        ms1.SetSize(StatStg.cbSize);
        Stm.Read(ms1.Memory, ms1.Size, nil);
        ms1.Position := 0;
        ms1.ReadBuffer(num, SizeOf(num));
        ms2 := TMemoryStream.Create;
        ms2.SetSize(num);
    
        UnZip := TDecompressionStream.Create(ms1);
        ms2.Position := 0;
        UnZip.Read(ms2.Memory^, num);
        UnZip.Free;
    
        ms2.SaveToFile(DestPath + '\' + StatStg.pwcsName);
        ms1.Free;
        ms2.Free;
      end;
      Result := True;
    end;
    
    {测试 Dir2Doc}
    procedure TForm1.Button1Click(Sender: TObject);
    const
      TestPath = 'C:\Documents and Settings\All Users\Documents\My Pictures\示例图片';
      TestFile = 'C:\Temp\pic1.dat';
    begin
      if Dir2Doc(TestPath, TestFile) then
        ShowMessage('ok');
    end;
    
    {测试 Doc2Dir}
    procedure TForm1.Button2Click(Sender: TObject);
    const
      TestPath = 'C:\Temp\pic1';
      TestFile = 'C:\Temp\pic1.dat';
    begin
      if Doc2Dir(TestFile, TestPath) then
        ShowMessage('ok');
    end;
    
    {测试 ZipDir2Doc}
    procedure TForm1.Button3Click(Sender: TObject);
    const
      TestPath = 'C:\Documents and Settings\All Users\Documents\My Pictures\示例图片';
      TestFile = 'C:\Temp\pic2.dat';
    begin
      if ZipDir2Doc(TestPath, TestFile) then
        ShowMessage('ok');
    end;
    
    {测试 UnZipDoc2Dir}
    procedure TForm1.Button4Click(Sender: TObject);
    const
      TestPath = 'C:\Temp\pic2';
      TestFile = 'C:\Temp\pic2.dat';
    begin
      if UnZipDoc2Dir(TestFile, TestPath) then
        ShowMessage('ok');
    end;
    
    end.

转载于:https://my.oschina.net/hermer/blog/319480

[80_]: https://my.oschina.net/u/2663968/blog/3051541
[hot3.png]: /images/20220115/a5ed1a550cfe44cab60894236f05ec72.png