知识大全 复杂的结构化存取(三):存取函数

Posted 文件

篇首语:将相本无种,男儿当自强。本文由小常识网(cha138.com)小编为大家整理,主要介绍了知识大全 复杂的结构化存取(三):存取函数相关的知识,希望对你有一定的参考价值。

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

  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 Docprocedure 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 Dirprocedure TForm Button Click(Sender: TObject);const TestPath =  C:Temppic ; TestFile =  C:Temppic dat ;begin if Doc Dir(TestFile  TestPath) then  ShowMessage( ok );end;

  测试 ZipDir Docprocedure 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;

cha138/Article/program/Delphi/201311/8403

相关参考

知识大全 用jquery存取照片的具体实现方法

这篇文章介绍了用jquery存取照片的具体实现方法需要的朋友可以参考一下   用jquery调用aspx内的函数:复制代码代码如下:sajax("***aspx/DoSave"//一个URL

知识大全 在PB中用OLE存取blob类型数据(三)

在PB中用OLE存取blob类型数据(三)  以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容,让我们赶快一起来看一下吧!  源程序

知识大全 数据结构 3.1 单链表中存取元素示例算法

  希赛教育计算机专业考研专业课辅导招生  希赛教育计算机专业考研专业课辅导视频  希赛教育计算机考研专业课在线测试系统  boolGetElem(SLinkLintposElemType&e

知识大全 MySQL 存取权限系统

MySQL存取权限系统  以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容,让我们赶快一起来看一下吧!  MySQL用户名和口令  

知识大全 Oracle ADO数据存取

OracleADO数据存取  以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容,让我们赶快一起来看一下吧!  ADO是ActiveD

知识大全 直接存取文件的方法

  为了方便编程Delphi在很多需要与文件打交道的组件类中都定义了直接文件存取方法使用这些方法可以非常简单地将组件中处理的数据保存到文件中或从文件中读取所需的数据到组件中LoadFromFile和S

知识大全 数据结构考研分类复习真题 第二章 答案[7]

  应用题  .()选链式存储结构它可动态申请内存空间不受表长度(即表中元素个数)的影响插入删除时间复杂度为O()  ()选顺序存储结构顺序表可以随机存取时间复杂度为O()  .链式存储结构一般说克服

知识大全 用XMLTextReader类加速XML存取

用XMLTextReader类加速XML存取  以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容,让我们赶快一起来看一下吧!  在N

知识大全 Delphi存取图像完整解决方案

Delphi存取图像完整解决方案  以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容,让我们赶快一起来看一下吧! 对于涉及图像数据的

知识大全 .Net在SqlServer中的图片存取

.Net在SqlServer中的图片存取  以下文字资料是由(全榜网网www.cha138.com)小编为大家搜集整理后发布的内容,让我们赶快一起来看一下吧!  本文总结