电脑故障

位置：IT落伍者 >> 电脑故障 >> 浏览文章

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

发布日期：2023/9/12

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

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

DocDir DirDoc 的反操作

ZipDirDoc 同 DirDoc 只是同时执行了压缩

UnZipDocDir ZipDirDoc 的反操作

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

unitUnit;

interface

uses

WindowsMessagesSysUtilsVariantsClassesGraphicsControlsForms

DialogsStdCtrls;

type

TForm=class(TForm)

Button:TButton;

procedureButtonClick(Sender:TObject);

end;

var

Form:TForm;

implementation

{$R*dfm}

usesActiveXZlib;{函数用到的单元}

{把指定文件夹下的文件保存到一个复合文件}

functionDirDoc(SourcePathDestFile:string):Boolean;

const

Mode=STGM_CREATEorSTGM_WRITEorSTGM_SHARE_EXCLUSIVE;

var

sr:TSearchRec;

Stg:IStorage;

Stm:IStream;

ms:TMemoryStream;

begin

Result:=False;

SourcePath:=ExcludeTrailingPathDelimiter(SourcePath);{去掉最后一个}

ifnotDirectoryExists(SourcePath)thenExit;{如果源路径不存在则退出}

ifnotDirectoryExists(ExtractFileDir(DestFile))then{假如目标目录不存在}

ifnotForceDirectories(ExtractFileDir(DestFile))thenExit;{就创建若创建失败退出}

{如果目标路径不存在则退出}

StgCreateDocfile(PWideChar(WideString(DestFile))ModeStg);{建立复合文件根路径}

ifFindFirst(SourcePath+**faAnyFilesr)=then

begin

repeat

ifsrName[]=thenContinue;{如果是或(当前目录或上层目录)则忽略}

if(srAttrandfaDirectory)<>faDirectorythen

begin

StgCreateStream(PWideChar(WideString(srName))ModeStm);

ms:=TMemoryStreamCreate;

msLoadFromFile(SourcePath++srName);

msPosition:=;

StmWrite(msMemorymsSizenil);

msFree;

end;

until(FindNext(sr)<>);

end;

Result:=True;

end;

{上一个DirDoc函数的反操作}

functionDocDir(SourceFileDestPath:string):Boolean;

const

Mode=STGM_READorSTGM_SHARE_EXCLUSIVE;

var

Stg:IStorage;

Stm:IStream;

StatStg:TStatStg;

EnumStatStg:IEnumStatStg;

ms:TMemoryStream;

i:Integer;

begin

Result:=False;

ifnotFileExists(SourceFile)thenExit;{如果文件不存在退出}

ifnotDirectoryExists(DestPath)then{如果目标目录不存在}

ifnotForceDirectories(DestPath)thenExit;{就创建若创建失败退出}

DestPath:=ExcludeTrailingPathDelimiter(DestPath);{去掉最后一个}

StgOpenStorage(PWideChar(WideString(SourceFile))nilModenilStg);

StgEnumElements(nilEnumStatStg);

whileTruedo

begin

EnumStatStgNext(StatStg@i);

if(i=)or(StatStgdwType=)thenBreak;{dwType=时是文件夹}

StgOpenStream(StatStgpwcsNamenilModeStm);

ms:=TMemoryStreamCreate;

msSetSize(StatStgcbSize);

StmRead(msMemorymsSizenil);

msSaveToFile(DestPath++StatStgpwcsName);

msFree;

end;

Result:=True;

end;

{把指定文件夹下的文件压缩到一个复合文件}

functionZipDirDoc(SourcePathDestFile:string):Boolean;

const

Mode=STGM_CREATEorSTGM_WRITEorSTGM_SHARE_EXCLUSIVE;

var

sr:TSearchRec;

Stg:IStorage;

Stm:IStream;

msms:TMemoryStream;

zip:TCompressionStream;

num:Int;

begin

Result:=False;

SourcePath:=ExcludeTrailingPathDelimiter(SourcePath);{去掉最后一个}

ifnotDirectoryExists(SourcePath)thenExit;{如果源路径不存在则退出}

ifnotDirectoryExists(ExtractFileDir(DestFile))then{假如目标目录不存在}

ifnotForceDirectories(ExtractFileDir(DestFile))thenExit;{就创建若创建失败退出}

StgCreateDocfile(PWideChar(WideString(DestFile))ModeStg);{建立复合文件根路径}

ifFindFirst(SourcePath+**faAnyFilesr)=then

begin

repeat

ifsrName[]=thenContinue;{如果是或(当前目录或上层目录)则忽略}

if(srAttrandfaDirectory)<>faDirectorythen

begin

StgCreateStream(PWideChar(WideString(srName))ModeStm);

ms:=TMemoryStreamCreate;

msLoadFromFile(SourcePath++srName);

num:=msSize;

msWrite(numSizeOf(num));

zip:=TCompressionStreamCreate(clMaxms);

msSaveToStream(zip);

zipFree;

msPosition:=;

StmWrite(msMemorymsSizenil);

msFree;

end;

until(FindNext(sr)<>);

end;

Result:=True;

end;

{上一个ZipDirDoc函数的反操作}

functionUnZipDocDir(SourceFileDestPath:string):Boolean;

const

Mode=STGM_READorSTGM_SHARE_EXCLUSIVE;

var

Stg:IStorage;

Stm:IStream;

StatStg:TStatStg;

EnumStatStg:IEnumStatStg;

msms:TMemoryStream;

i:Integer;

num:Int;

UnZip:TDecompressionStream;

begin

Result:=False;

ifnotFileExists(SourceFile)thenExit;{如果文件不存在退出}

ifnotDirectoryExists(DestPath)then{如果目标目录不存在}

ifnotForceDirectories(DestPath)thenExit;{就创建若创建失败退出}

DestPath:=ExcludeTrailingPathDelimiter(DestPath);{去掉最后一个}

StgOpenStorage(PWideChar(WideString(SourceFile))nilModenilStg);

StgEnumElements(nilEnumStatStg);

whileTruedo

begin

EnumStatStgNext(StatStg@i);

if(i=)or(StatStgdwType=)thenBreak;{dwType=时是文件夹}

StgOpenStream(StatStgpwcsNamenilModeStm);

ms:=TMemoryStreamCreate;

msSetSize(StatStgcbSize);

StmRead(msMemorymsSizenil);

msPosition:=;

msReadBuffer(numSizeOf(num));

ms:=TMemoryStreamCreate;

msSetSize(num);

UnZip:=TDecompressionStreamCreate(ms);

msPosition:=;

UnZipRead(msMemory^num);

UnZipFree;

msSaveToFile(DestPath++StatStgpwcsName);

msFree;

end;

Result:=True;

end;

{测试DirDoc}

procedureTFormButtonClick(Sender:TObject);

const

TestPath=C:DocumentsandSettingsAllUsersDocumentsMyPictures示例图片;

TestFile=C:Temppicdat;

begin

ifDirDoc(TestPathTestFile)then

ShowMessage(ok);

end;

{测试DocDir}

procedureTFormButtonClick(Sender:TObject);

const

TestPath=C:Temppic;

TestFile=C:Temppicdat;

begin

ifDocDir(TestFileTestPath)then

ShowMessage(ok);

end;

{测试ZipDirDoc}

procedureTFormButtonClick(Sender:TObject);

const

TestPath=C:DocumentsandSettingsAllUsersDocumentsMyPictures示例图片;

TestFile=C:Temppicdat;

begin

ifZipDirDoc(TestPathTestFile)then

ShowMessage(ok);

end;

{测试UnZipDocDir}

procedureTFormButtonClick(Sender:TObject);

const

TestPath=C:Temppic;

TestFile=C:Temppicdat;

begin

ifUnZipDocDir(TestFileTestPath)then

ShowMessage(ok);

end;

上一篇：从入门到精通：MSAgent经典用法

下一篇：实现自动化对象的一种简易方法