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

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

　　今天写了四个小函数 拿来与大家共享

　　Dir Doc 把文件夹下的所有文件（不包括子文件夹）保存成一个复合文件

　　Doc Dir Dir Doc 的反操作

　　ZipDir Doc 同 Dir Doc 只是同时执行了压缩

　　UnZipDoc Dir ZipDir Doc 的反操作

　　函数及测试代码（分别在 Delphi 和 Delphi 下测试通过） unit　Unit ;

　　interface

　　uses　Windows 　Messages 　SysUtils 　Variants 　Classes 　Graphics 　Controls 　Forms 　Dialogs 　StdCtrls;

　　type　TForm 　=　class(TForm)　　Button :　TButton;　　Button :　TButton;　　Button :　TButton;　　Button :　TButton;　　procedure　Button Click(Sender:　TObject);　　procedure　Button Click(Sender:　TObject);　　procedure　Button Click(Sender:　TObject);　　procedure　Button Click(Sender:　TObject);　end;

　　var　Form :　TForm ;

　　implementation

　　{$R　* dfm}

　　uses　ActiveX 　Zlib;　{函数用到的单元}

　　{把指定文件夹下的文件保存到一个复合文件}function　Dir Doc(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 　 　Stg);　{建立复合文件根路径}

　　if　FindFirst(SourcePath　+　 * * 　faAnyFile 　sr)　=　 　then　begin　　repeat　　　if　sr Name[ ]　=　 　then　Continue;　{如果是 　或　 　(当前目录或上层目录)则忽略}　　　if　(sr Attr　and　faDirectory)　<>　faDirectory　then　　　begin　　　　Stg CreateStream(PWideChar(WideString(sr Name)) 　Mode 　 　 　Stm);　　　　ms　:=　TMemoryStream Create;　　　　ms LoadFromFile(SourcePath　+　 　+　sr Name);　　　　ms Position　:=　 ;　　　　Stm Write(ms Memory 　ms Size 　nil);　　　　ms Free;　　　end;　　until　(FindNext(sr)　<>　 );　end;　Result　:=　True;end;

　　{上一个　Dir Doc　函数的反操作}function　Doc Dir(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 　 　Stg);　Stg EnumElements( 　nil 　 　EnumStatStg);

　　while　True　do　begin　　EnumStatStg Next( 　StatStg 　@i);　　if　(i　=　 )　or　(StatStg dwType　=　 )　then　Break;　{dwType　=　 　时是文件夹}　　Stg OpenStream(StatStg pwcsName 　nil 　Mode 　 　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　ZipDir Doc(SourcePath 　DestFile:　string):　Boolean;const　Mode　=　STGM_CREATE　or　STGM_WRITE　or　STGM_SHARE_EXCLUSIVE;var　sr:　TSearchRec;　Stg:　IStorage;　Stm:　IStream;　ms ms :　TMemoryStream;　zip:　TCompressionStream;　num:　Int ;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 　 　Stg);　{建立复合文件根路径}

　　if　FindFirst(SourcePath　+　 * * 　faAnyFile 　sr)　=　 　then　begin　　repeat　　　if　sr Name[ ]　=　 　then　Continue;　{如果是 　或　 　(当前目录或上层目录)则忽略}　　　if　(sr Attr　and　faDirectory)　<>　faDirectory　then　　　begin　　　　Stg CreateStream(PWideChar(WideString(sr Name)) 　Mode 　 　 　Stm);　　　　ms 　:=　TMemoryStream Create;　　　　ms 　:=　TMemoryStream Create;　　　　ms LoadFromFile(SourcePath　+　 　+　sr Name);

　　num　:=　ms Size;　　　　ms Write(num 　SizeOf(num));　　　　zip　:=　TCompressionStream Create(clMax 　ms );　　　　ms SaveToStream(zip);　　　　zip Free;

　　ms Position　:=　 ;　　　　Stm Write(ms Memory 　ms Size 　nil);

　　ms Free;　　　　ms Free;　　　end;　　until　(FindNext(sr)　<>　 );　end;　Result　:=　True;end;

　　{上一个　ZipDir Doc　函数的反操作}function　UnZipDoc Dir(SourceFile 　DestPath:　string):　Boolean;const　Mode　=　STGM_READ　or　STGM_SHARE_EXCLUSIVE;var　Stg:　IStorage;　Stm:　IStream;　StatStg:　TStatStg;　EnumStatStg:　IEnumStatStg;　ms ms :　TMemoryStream;　i:　Integer;　num:　Int ;　UnZip:　TDepressionStream;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 　 　Stg);　Stg EnumElements( 　nil 　 　EnumStatStg);

　　while　True　do　begin　　EnumStatStg Next( 　StatStg 　@i);　　if　(i　=　 )　or　(StatStg dwType　=　 )　then　Break;　{dwType　=　 　时是文件夹}　　Stg OpenStream(StatStg pwcsName 　nil 　Mode 　 　Stm);　　ms 　:=　TMemoryStream Create;　　ms SetSize(StatStg cbSize);　　Stm Read(ms Memory 　ms Size 　nil);　　ms Position　:=　 ;　　ms ReadBuffer(num 　SizeOf(num));　　ms 　:=　TMemoryStream Create;　　ms SetSize(num);

　　UnZip　:=　TDepressionStream Create(ms );　　ms Position　:=　 ;　　UnZip Read(ms Memory^ 　num);　　UnZip Free;

　　ms SaveToFile(DestPath　+　 　+　StatStg pwcsName);　　ms Free;　　ms Free;　end;　Result　:=　True;end;

　　{测试　Dir Doc}procedure　TForm Button Click(Sender:　TObject);const　TestPath　=　 C:Documents　and　SettingsAll　UsersDocumentsMy　Pictures示例图片 ;　TestFile　=　 C:Temppic dat ;begin　if　Dir Doc(TestPath 　TestFile)　then　　ShowMessage( ok );end;

　　{测试　Doc Dir}procedure　TForm Button Click(Sender:　TObject);const　TestPath　=　 C:Temppic ;　TestFile　=　 C:Temppic dat ;begin　if　Doc Dir(TestFile 　TestPath)　then　　ShowMessage( ok );end;

　　{测试　ZipDir Doc}procedure　TForm Button Click(Sender:　TObject);const　TestPath　=　 C:Documents　and　SettingsAll　UsersDocumentsMy　Pictures示例图片 ;　TestFile　=　 C:Temppic dat ;begin　if　ZipDir Doc(TestPath 　TestFile)　then　　ShowMessage( ok );end;