Delphi 文件处理实例（6）

取得该快捷方式的指向EXE
关键词:快捷方式 LNK

implementationuses activex,comobj,shlobj;{$R *.dfm}function ResolveLink(const ALinkfile: String): String;varlink: IShellLink;storage: IPersistFile;filedata: TWin32FindData;buf: Array[0..MAX_PATH] of Char;widepath: WideString;beginOleCheck(CoCreateInstance(CLSID_ShellLink, nil, CLSCTX_INPROC_SERVER, IShellLink, link));OleCheck(link.QueryInterface(IPersistFile, storage));widepath := ALinkFile;Result := 'unable to resolve link';If Succeeded(storage.Load(@widepath[1], STGM_READ)) ThenIf Succeeded(link.Resolve(GetActiveWindow, SLR_NOUPDATE)) ThenIf Succeeded(link.GetPath(buf, sizeof(buf), filedata, SLGP_UNCPRIORITY)) ThenResult := buf;storage := nil;link:= nil;end;// 用法:procedure TForm1.Button1Click(Sender: TObject);beginShowMessage(ResolveLink('C:\delphi 7.lnk'));end;end.

 

发表评语

在Delphi中获取和修改文件的时间关键词:文件修改时间
本文介绍了在Delphi中利用系统函数和Windows API函数调用来获取和修改文件的时间信息的方法。

熟悉Windows 95/98的朋友一定经常会用单击鼠标右键的方法来查看所选定的文件的属性信息。在属性菜单中会列出该文件的创建时间、修改时间和访问时间。这些信息常常是很有用的，它们的设置一般都是由操作系统（也就是由Dos/Windows等等）自动完成的，不会让用户轻易修改。

这里，我向大家介绍在Delphi中如何实现文件时间的获取和修改方法。

Delphi中提供了很完备的Windows API函数的调用接口，可以方便的进行高级Windows编程。

利用Delphi中的FindFirst函数可以得到一个文件的属性记录，该记录中的FindData域中就记载了详细的文件时间信息。

然而遗憾的是，FindData中的时间信息是不能直接得到的。因此，有人（编者按：很遗憾不知此人姓名）

编写了一个转换函数来完成文件时间格式的转换。下面给出了具体的实现方法，仅供参考：
function CovFileDate(Fd:_FileTime):TDateTime;
{ 转换文件的时间格式 }
var
Tct:_SystemTime;
Temp:_FileTime;
begin
FileTimeToLocalFileTime(Fd,Temp);
FileTimeToSystemTime(Temp,Tct);
CovFileDate:=SystemTimeToDateTime(Tct);
end;
有了上面的函数支持，我们就可以获取一个文件的时间信息了。以下是一个简单的例子：
procdeure GetFileTime(const Tf:string);
{ 获取文件时间，Tf表示目标文件路径和名称 }
const
Model=yyyy/mm/dd,hh:mm:ss; { 设定时间格式 }
var
Tp:TSearchRec; { 申明Tp为一个查找记录 }
T1,T2,T3:string;
begin
FindFirst(Tf,faAnyFile,Tp); { 查找目标文件 } T1:=FormatDateTime(Model,
CovFileDate(Tp.FindData.ftCreationTime)));
{ 返回文件的创建时间 }
T2:=FormatDateTime(Model,
CovFileDate(Tp.FindData.ftLastWriteTime)));
{ 返回文件的修改时间 }
T3:=FormatDateTime(Model,Now));
{ 返回文件的当前访问时间 }
FindClose(Tp);
end;
设置文件的时间要复杂一些，这里介绍利用Delphi中的DataTimePicker组件来辅助完成这一复杂的操作。

 

下面的例子利用了四个DataTimePicker组件来完成文件创建时间和修改时间的设置。注意：文件的访问时间用修改时间来代替。使用下面的例子时，请在您的Form上添加四个DataTimePicker组件。

其中第一和第三个DataTimePicker组件中的Kind设置为dtkDate，第二个和第四个DataTimePicker组件中的Kind设置为dtkTime.

procedure SetFileDateTime(const Tf:string); { 设置文件时间，Tf表示目标文件路径和名称 } var Dt1,Dt2:Integer; Fs:TFileStream; Fct,Flt:TFileTime; begin Dt1:=DateTimeToFileDate( Trunc(Form1.DateTimePicker1.Date) + Frac(Form1.DateTimePicker2.Time)); Dt2:=DateTimeToFileDate( Trunc(Form1.DateTimePicker3.Date) + Frac(Form1.DateTimePicker4.Time)); { 转换用户输入在DataTimePicker中的信息 } try FS := TFileStream.Create(Tf, fmOpenReadWrite); try if DosDateTimeToFileTime(LongRec(DT1).Hi, LongRec(DT1).Lo, Fct) and LocalFileTimeToFileTime(Fct, Fct) and DosDateTimeToFileTime(LongRec(DT2).Hi, LongRec(DT2).Lo, Flt) and LocalFileTimeToFileTime(Flt, Flt) then SetFileTime(FS.Handle, @Fct, @Flt, @Flt); { 设置文件时间属性 } finally FS.Free; end; except MessageDlg(日期修改操作失败！, mtError, [mbOk], 0); { 因为目标文件正在被使用等原因而导致失败 } end; end; 

以上简单介绍了文件时间属性的修改方法，请注意：修改文件时间的范围是从公元1792年9月19日开始的，上限可以达到公元2999年或更高。另外，请不要将此技术用于破坏他人文件等非正当途径。

 

 

2006-2-16 19:24:44 修改文件的扩展名关键词:扩展名 ChangeFileExt
var
filename:String;
begin
  filename := 'abcd.html';
  filename := ChangeFileExt(filename, '');
  Edit1.Text:=filename;
end;

2006-2-16 19:25:32 如何读写文本文件关键词:读写文本文件
下面源代码或许对你有些帮助:

Procedure NewTxt;Var　F : Textfile;Begin　AssignFile(F, 'c:\ek.txt'); {将文件名与变量 F 关联}　ReWrite(F); {创建一个新的文件并命名为 ek.txt}　Writeln(F, '将您要写入的文本写入到一个 .txt 文件');　Closefile(F); {关闭文件 F}End;Procedure OpenTxt;Var　F : Textfile;Begin　AssignFile(F, 'c:\ek.txt'); {将文件名与变量 F 关联}　Append(F); {以编辑方式打开文件 F }　Writeln(F, '将您要写入的文本写入到一个 .txt 文件');　Closefile(F); {关闭文件 F}End;Procedure ReadTxt;Var　F : Textfile;　str : String;Begin　AssignFile(F, 'c:\ek.txt'); {将文件名与变量 F 关联}　Reset(F); {打开并读取文件 F }　Readln(F, str);　ShowMessage('文件有:' +str + '行。');　Closefile(F); {关闭文件 F}End;

2006-2-16 19:25:57 删除某目录下所有指定扩展名文件关键词:删除文件 扩展名
//删除某目录下所有指定扩展名文件

function DelFile(sDir,fExt: string): Boolean;varhFindfile: HWND;FindFileData: WIN32_FIND_DATA;sr: TSearchRec;beginsDir:= sDir + '\';hFindfile:= FindFirstFile(pchar(sDir + fExt), FindFileData);if hFindFile <> NULL thenbegindeletefile(sDir + FindFileData.cFileName);while FindNextFile(hFindFile, FindFileData) <> FALSE dodeletefile(sDir + FindFileData.cFileName);end;sr.FindHandle:= hFindFile;FindClose(sr);end;function getAppPath : string;varstrTmp : string;beginstrTmp := ExtractFilePath(ExtractFilePath(application.Exename));if strTmp[length(strTmp)] <> '\' thenstrTmp := strTmp + '\';result := strTmp;end; 

 

2006-2-16 19:26:41 把音频插进EXE文件并且播放关键词:资源文件
步骤1）建立一个SOUNDS.RC文件

使用NotePad记事本-象下面：

#define WAVE WAVEFILE

SOUND1 WAVE "anysound.wav"
SOUND2 WAVE "anthersound.wav"
SOUND3 WAVE "hello.wav"

步骤2）把它编译到一个RES文件

使用和Delphi一起的BRCC32.EXE程序。使用下面的命令行：

BRCC32.EXE -foSOUND32.RES SOUNDS.RC

你应该以'sound32.res'结束一个文件。

步骤3）把它加入你的程序

在DPR文件把它加入{$R*.RES}下面，如下：

{$R SOUND32.RES}

步骤4）把下面的代码加入程序去播放内含的音频

USES MMSYSTEM Procedure PlayResSound(RESName:String;uFlags:Integer); var hResInfo,hRes:Thandle; lpGlob:Pchar; BeginhResInfo:=FindResource(HInstance,PChar(RESName),MAKEINTRESOURCE('WAVEFILE'));if hResInfo = 0 thenbeginmessagebox(0,'未找到资源。',PChar(RESName),16);exit;end;hRes:=LoadResource(HInstance,hResinfo);if hRes = 0 thenbeginmessagebox(0,'不能装载资源。',PChar(RESName),16);exit;end;lpGlob:=LockResource(hRes);if lpGlob=Nil thenbeginmessagebox(0,'资源损坏。',PChar(RESName),16);exit;end;uFlags:=snd_Memory or uFlags;SndPlaySound(lpGlob,uFlags);UnlockResource(hRes);FreeResource(hRes); End; 

步骤5）调用程序，用你在步骤（1）编译的声音文件名。

PlayResSound('SOUND1',SND_ASYNC)
Flags are:
SND_ASYNC = Start playing, and don't wait to return
SND_SYNC = Start playing, and wait for the sound to finish
SND_LOOP = Keep looping the sound until another sound is played

2006-2-16 19:27:29 delphi如何修改文件的时间关键词:文件创建时间 最后修改时间 最后访问时间
在windows下，属性里面有三个日起，创建，修改，存储。我怎么来修改啊？

代码如下：

type// indicates the file time to set, used by SetFileTimesHelper and SetDirTimesHelperTFileTimes = (ftLastAccess, ftLastWrite, ftCreation);function SetFileTimesHelper(const FileName: string; const DateTime: TDateTime; Times: TFileTimes): Boolean;varHandle: THandle;FileTime: TFileTime;SystemTime: TSystemTime;beginResult := False;Handle := CreateFile(PChar(FileName), GENERIC_WRITE, FILE_SHARE_READ, nil,OPEN_EXISTING, 0, 0);if Handle <> INVALID_HANDLE_VALUE thentry//SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime), SystemTime);SysUtils.DateTimeToSystemTime(DateTime, SystemTime);if Windows.SystemTimeToFileTime(SystemTime, FileTime) thenbegincase Times offtLastAccess:Result := SetFileTime(Handle, nil, @FileTime, nil);ftLastWrite:Result := SetFileTime(Handle, nil, nil, @FileTime);ftCreation:Result := SetFileTime(Handle, @FileTime, nil, nil);end;end;finallyCloseHandle(Handle);end;end;//--------------------------------------------------------------------------------------------------function SetFileLastAccess(const FileName: string; const DateTime: TDateTime): Boolean;beginResult := SetFileTimesHelper(FileName, DateTime, ftLastAccess);end;//--------------------------------------------------------------------------------------------------function SetFileLastWrite(const FileName: string; const DateTime: TDateTime): Boolean;beginResult := SetFileTimesHelper(FileName, DateTime, ftLastWrite);end;//--------------------------------------------------------------------------------------------------function SetFileCreation(const FileName: string; const DateTime: TDateTime): Boolean;beginResult := SetFileTimesHelper(FileName, DateTime, ftCreation);end;---------------------------------------------------------------------- 2006-2-16 19:27:57 获取文件修改时间varfhandle:Thandle;s:String;beginfhandle:=fileopen('f:\abc.txt',0);trys:=datetimetostr(filedatetodatetime(filegetdate(fhandle)));finallyfileclose(fhandle);end;showMessage(s);end; 2006-2-16 19:28:32 获得和相应扩展文件名关联的应用程序的名字关键词:扩展名 关联程序名 uses{$IFDEF WIN32}Registry; {We will get it from the registry}{$ELSE}IniFiles; {We will get it from the win.ini file}{$ENDIF}{$IFNDEF WIN32}const MAX_PATH = 144;{$ENDIF}function GetProgramAssociation (Ext : string) : string;var{$IFDEF WIN32}reg: TRegistry;s : string;{$ELSE}WinIni : TIniFile;WinIniFileName : array[0..MAX_PATH] of char;s : string;{$ENDIF}begin{$IFDEF WIN32}s := '';reg := TRegistry.Create;reg.RootKey := HKEY_CLASSES_ROOT;if reg.OpenKey('.' + ext + '\shell\open\command',false) <> false then begin{The open command has been found}s := reg.ReadString('');reg.CloseKey;end else begin{perhaps thier is a system file pointer}if reg.OpenKey('.' + ext,false) <> false then begins := reg.ReadString('');reg.CloseKey;if s <> '' then begin{A system file pointer was found}if reg.OpenKey(s + '\shell\open\command',false) <> false then{The open command has been found}s := reg.ReadString('');reg.CloseKey;end;end;end;{Delete any command line, quotes and spaces}if Pos('%', s) > 0 thenDelete(s, Pos('%', s), length(s));if ((length(s) > 0) and(s[1] = '"')) thenDelete(s, 1, 1);if ((length(s) > 0) and(s[length(s)] = '"')) thenDelete(s, Length(s), 1);while ((length(s) > 0) and((s[length(s)] = #32) or(s[length(s)] = '"'))) doDelete(s, Length(s), 1);{$ELSE}GetWindowsDirectory(WinIniFileName, sizeof(WinIniFileName));StrCat(WinIniFileName, '\win.ini');WinIni := TIniFile.Create(WinIniFileName);s := WinIni.ReadString('Extensions',ext,'');WinIni.Free;{Delete any command line}if Pos(' ^', s) > 0 thenDelete(s, Pos(' ^', s), length(s));{$ENDIF}result := s;end;procedure TForm1.Button1Click(Sender: TObject);beginShowMessage(GetProgramAssociation('gif'));end; 2006-2-16 19:29:21 删除目录里的文件但保留目录关键词:删除文件 uses Windows, Classes, ShellAPI; const FOF_DEFAULT_IDEAL = FOF_MULTIDESTFILES + FOF_RENAMEONCOLLISION + FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_FILESONLY + FOF_NOCONFIRMMKDIR + FOF_NOERRORUI + FOF_SIMPLEPROGRESS; FOF_DEFAULT_DELTREE = FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_NOERRORUI; FOF_DEFAULT_COPY = FOF_NOCONFIRMATION + FOF_ALLOWUNDO + FOF_NOCONFIRMMKDIR + FOF_NOERRORUI + FOF_MULTIDESTFILES; FOF_DEFAULT_DELFILES = FOF_DEFAULT_DELTREE; function ShellDeleteFiles( hWnd : THandle ; const DirName : string; Flags : FILEOP_FLAGS; WinTitle : PChar ) : integer; {---------------------------------------------------------------------------------------------} {Apaga arquivos/Diretorios atraves do shell do windows} //Notas: Ver comentario sobre o uso de duplo #0 nos parametros de Origem e destino var FileOpShell : TSHFileOpStruct; Oper : array[0..1024] of char; begin if WinTitle <> nil then begin Flags:=Flags + FOF_SIMPLEPROGRESS; end; with FileOpShell do begin wFunc:=FO_DELETE; pFrom:=Oper; pTo:=Oper; //pra garantir a rapadura! fFlags:=Flags; lpszProgressTitle:=WinTitle; Wnd:=hWnd; hNameMappings:=nil; fAnyOperationsAborted:=False; end; StrPCopy( Oper, DirName ); StrCat(Oper, PChar( ExtractFileName( FindFirstChildFile( DirName )) ) ); Result:=0; try while Oper <> EmptyStr do begin Result:=ShFileOperation( FileOpShell ); if FileOpShell.fAnyOperationsAborted then begin Result:=ERROR_REQUEST_ABORTED; break; end else begin if Result <> 0 then begin Break; end; end; StrPCopy(Oper, FindFirstChildFile( DirName ) ); end; except Result:=ERROR_EXCEPTION_IN_SERVICE; end; end; 

 

2006-2-16 19:30:55 放置任意的文件到exe文件里关键词:Exe 资源文件 RES
           通常在Delphi的应用程序中，我们会调用到很多的资源，例如图片，动画（AVI），声音，甚至于别的执行文件。

          当然，把这些资源分布到不同的目录不失为一个好办法，但是有没有可能把这些资源编译成标准的windows资源从而链接到一个执行文件里面呢？

我们可以自己做一个RC文件，例如 sample.rc ，RC文件其实就是一个资源文件的描述文本，通过“记事本”程序创建就行了。然后可以输入一些我们要定义的资源，例如：

MEN BITMAP c:\bitmap\men.bitmap
ARJ EXEFILE c:\arj.exe
MOV AVI c:\mov.avi

然后用BRCC32把这个RC文件编译成sample.res（真正的资源文件）。

在Delphi的工程文件中使用 $R 编译指令让Delphi包括资源到EXE文件里面。

{$R sample.res}

这样我们就可以在这个单一的执行文件中调用资源了。举例如下：

EXEFILE：

procedure ExtractRes(ResType, ResName, ResNewName : String);
var
Res : TResourceStream;
begin
Res := TResourceStream.Create(Hinstance, Resname, Pchar(ResType)); Res.SavetoFile(ResNewName);
Res.Free;
end;

AVI：

procedure LoadAVI;
begin
{Avi1是一个TAnimate类}
Avi1.ResName:='AVI';
Avi1.Active:=True;
end;

 

2006-2-16 19:31:30 如何把文件删除到回收站中关键词:删除文件 回收站
program del;
uses ShellApi;
{ 利用ShellApi中: function SHFileOperation(const lpFileOp: TSHFileOpStruct): Integer; stdcall; }
Var T:TSHFileOpStruct;
P:String;
begin
P:='C:\Windows\System\EL_CONTROL.CPL';
With T do
Begin
Wnd:=0;
wFunc:=FO_DELETE;
pFrom:=Pchar(P);
fFlags:=FOF_ALLOWUNDO
End;
SHFileOperation(T);
End.

注意：
1. 给出文件的绝对路径名，否则可能不能恢复；
2. MS的文档说对于多个文件，每个文件名必须被#)字符分隔，而整个字符串必须用两个#0结束。

2006-2-16 19:31:56 实现打开或运行一个指定文件关键词:打开文件 运行文件 ShellExecute 打开网页
打开Windows已经注册的文件其实很简单，根据以下代码定义一个过程：
procedure URLink(URL:PChar);
begin
ShellExecute(0, nil, URL, nil, nil, SW_NORMAL);
end;
在要调用的地方使用
URLink('Readme.txt');
如果是链接主页的话，那么改用
URLink('http://gui.yeah.net');

2006-2-16 19:32:44 查找一个目录下的某些特定的文件关键词:搜索文件 查找文件 检索文件
方法如下：
FileSearch ：查找目录中是否存在某一特定文件
FindFirst ：在目录中查找与给定文件名（可以包含匹配符）及属性集相匹配的第一个文件
FindNext ：返回符合条件的下一个文件
FindClose ：中止一个FindFirst / FindNext序列

//参数：
//Directory : string 目录路径
//RetList : TStringList 包含了目录路径和查询到的文件

Funtion FindAllFileInADirectory(const : string; var RetList : TStringList):Boolean;
var
SearchRec: TSearchRec;
begin
if FindFirst(Directory + ’*.*’, faAnyFile, SearchRec) = 0 then
begin
repeat
RetList.Add(Directory + ’’ + SearchRec.Name);
until (FindNext(SearchRec) <> 0);
end
FindClose(SearchRec);
end;

2006-2-16 19:33:21 Delphi中关于文件、目录操作的函数关键词:文件、目录操作
//关于文件、目录操作
Chdir('c:\abcdir'); // 转到目录
Mkdir('dirname'); //建立目录
Rmdir('dirname'); //删除目录
GetCurrentDir; //取当前目录名，无'\'
Getdir(0,s); //取工作目录名s:='c:\abcdir';
Deletfile('abc.txt'); //删除文件
Renamefile('old.txt','new.txt'); //文件更名
ExtractFilename(filelistbox1.filename); //取文件名
ExtractFileExt(filelistbox1.filename); //取文件后缀

 

2006-2-16 19:34:28 如何判断一个文件是不是正在被使用关键词:文件状态 function IsFileInUse(FileName: TFileName): Boolean; var HFileRes: HFILE; begin Result := False; if not FileExists(FileName) then Exit; HFileRes := CreateFile(PChar(FileName), GENERIC_READ or GENERIC_WRITE, 0, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0); Result := (HFileRes = INVALID_HANDLE_VALUE); if not Result then CloseHandle(HFileRes); end;  2006-2-16 19:36:03 检查文件是否为文本文件关键词:文本文件 Function isAscii(Nomefile: String): Boolean; constSett=2048;vari: Integer;F: file;a: Boolean;TotSize, IncSize, ReadSize: Integer;c: Array[0..Sett] of byte;beginIf FileExists(NomeFile) thenbegin{$I-}AssignFile(F, NomeFile);Reset(F, 1);TotSize:=FileSize(F);IncSize:=0;a:=true;while (IncSize<TotSize) and (a=true) dobeginReadSize:=Sett;If IncSize+ReadSize>TotSize then ReadSize:=TotSize-IncSize;IncSize:=IncSize+ReadSize;BlockRead(F, c, ReadSize);For i := 0 to ReadSize-1 do // IterateIf (c[i]<32) and (not (c[i] in [9, 10, 13, 26])) then a:=False;end; // whileCloseFile(F);{$I+}If IOResult<>0 then Result:=Falseelse Result:=a;end;end;procedure TForm1.Button1Click(Sender: TObject);beginif OpenDialog1.Execute thenbeginif isAscii(OpenDialog1.FileName) thenbeginShowMessage('ASCII File');end;end;end;  2006-2-16 19:37:30 查找所有文件关键词:查找所有文件 procedure findall(disk,path: String; var fileresult: Tstrings); varfpath: String;fs: TsearchRec;beginfpath:=disk+path+'\*.*';if findfirst(fpath,faAnyFile,fs)=0 thenbeginif (fs.Name<>'.')and(fs.Name<>'..') thenif (fs.Attr and faDirectory)=faDirectory thenfindall(disk,path+'\'+fs.Name,fileresult)elsefileresult.add(disk+strpas(strupper(pchar(path)))+'\'+strpas(strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');while findnext(fs)=0 dobeginif (fs.Name<>'.')and(fs.Name<>'..') thenif (fs.Attr and faDirectory)=faDirectory thenfindall(disk,path+'\'+fs.Name,fileresult)elsefileresult.add(disk+strpas(strupper(pchar(path)))+'\'+strpas(strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');end;end;findclose(fs);end;procedure DoSearchFile(Path: string; Files: TStrings = nil);varInfo: TSearchRec;procedure ProcessAFile(FileName: string);beginif Assigned(PnlPanel) thenPnlPanel.Caption := FileName;Label2.Caption := FileName;end;function IsDir: Boolean;beginwith Info doResult := (Name <> '.') and (Name <> '..') and ((attr and fadirectory) = fadirectory);end;function IsFile: Boolean;beginResult := not ((Info.Attr and faDirectory) = faDirectory);end;beginPath := IncludeTrailingBackslash(Path);tryif FindFirst(Path + '*.*', faAnyFile, Info) = 0 thenif IsFile thenProcessAFile(Path + Info.Name)else if IsDir then DoSearchFile(Path + Info.Name);while FindNext(Info) = 0 dobeginif IsDir thenDoSearchFile(Path + Info.Name)else if IsFile thenProcessAFile(Path + Info.Name);Application.ProcessMessages;if QuitFlag then Break;Sleep(100);end;finallyFindClose(Info);end;end; 

2006-2-16 19:38:17 用DELPHI实现文件加密压缩关键词:加密压缩、Zlib、流、资源文件
概述：
在这篇文件中，讲述对单个文件的数据加密、数据压缩、自解压的实现。

      同样，也可以实现对多个文件或文件夹的压缩，只要稍加修改便可实现。

 

关键字：加密压缩、Zlib、流、资源文件

引　言：
在日常中，我们一定使用过WINZIP、WINRAR这样的出名的压缩软件，就是我们开发软件过程中不免要遇到数据加密、数据压缩的问题！

     本文中就这一技术问题展开探讨,同时感谢各位网友的技巧,在我每次面对问题要解决的时候,是你们辛苦地摸索出来的技巧总是让我豁然开朗,问题迎刃而解。

本篇文章主要是运用DELPH的强大的流处理方面的技巧来实现的数据加密压缩，并用于实际的软件程序开发中，将我个人的心得、开发经验写出来与大家分享。

 

1、 系统功能
1）、数据压缩
使用DELPHI提供的两个流类（TCompressionStream和TDecompressionStream）来完成数据的压缩和解压缩。
2）、数据加密压缩
通过Delphi编程中“流”的应用实现数据加密，主要采用Tstream的两个派生类Tfilestream、Tmemorystream 来完成的；其中数据压缩部分采用1）的实现方法
3）、双击压缩文件自动关联解压
通过更改注册表的实现扩展名与程序文件的关联，主要采用Tregistry；并且，API函数SHChangeNotify实现注册效果的立即呈现。
4）、可生成自解压文件
自解压的文件实现数据压缩1）与数据加密压缩2）的自动解压；并且，通过资源文件的使用实现可执行的自解压文件与数据文件的合并，来完成数据的自解压实现。

2、 系统实现
2.1、工作原理

 

 

 

 

 

 

 

2.2、关键技术的讲述
（一）ZLIB
1）、基类 TCustomZlibStream：是类TCompressionStream和TDecompressionStream 类的基类，它主要有一个属性： OnProgress，在类进行压缩或解压缩的过程中会发生这个的事件。
格式：Procedure OnProgress (Sender: TObject); dynamic;
2）、压缩类TCompressionStream：除了继承了基类的OnProgress 属性外，又增加了一个属性：CompressionRate，它的定义如下：
Property CompressionRate: Single read GetCompressionRate;
通过这个属性，可以得到压缩比。
它的几个重要的方法定义如下：
Constructor TCompressionStream.Create (CompressionLevel: TCompressionLevel; Dest: TStream);
其中：TcompressionLevel（压缩类型），它由如下几个定义：
　　　１）、 clNone ：不进行数据压缩；
　　　２）、 clFastest：进行快速压缩，牺牲压缩效率；
　　　３）、 clDefault：进行正常压缩；
　　　４）、 clMax： 进行最大化压缩，牺牲速度；
Dest：目的流，用于存放压缩过的数据。
Function TCompressionStream.Write (const Buffer; Count: Longint): Longint;
其中：Buffer：需要压缩的数据；
　　　Count: 需要压缩的数据的字节数；
函数返回写入流的字节数。
注意：压缩类TCompressionStream的数据只能是写入的，如果试图从其内部读取数据，将发生一个"Error "异常。需要压缩的数据通过方法 Write写入流中，在写入的过程中就被压缩，并保存在由构造函数提供的内存流（TmemoryStream）中,同时触发 OnProcess 事件。

3）、 解压缩类 TDecompressionStream :和压缩类TcompressionStream相反，它的数据是只能读出的，如果试图往其内部写数据，将发生一个"Error "异常。
它的几个重要方法定义如下：
构造函数：Constructor Create(Source: TStream);
　　其中：Source 是保存着压缩数据的流；
Function Read(var Buffer; Count: Longint): Longint;
　　数据读出函数，Buffer： 存数据缓冲区；Count: 缓冲区的大小；
　　函数返回读出的字节数。数据在读出的过程中，数据被解压缩，并触发 OnProcess 事件。

 

（二）流
在Delphi中，所有流对象的基类为TStream类，其中定义了所有流的共同属性和方法。
TStream类中定义的属性如下：

1）、Size:此属性以字节返回流中数据大小。
2）、Position:此属性控制流中存取指针的位置。

 

Tstream中定义的虚方法有四个：
1）、Read:此方法实现将数据从流中读出，返回值为实际读出的字节数，它可以小于或等于指定的值。
2）、Write:此方法实现将数据写入流中，返回值为实际写入流中的字节数。
3）、Seek:此方法实现流中读取指针的移动，返回值为移动后指针的位置。

函数原形为：Function Seek(Offset:Longint;Origint:Word):Longint;virtual;abstract;
参数Offset为偏移字节数,参数Origint指出Offset的实际意义，其可能的取值如下：
soFromBeginning:Offset为指针距离数据开始的位置。此时Offset必须大于或者等于零。
soFromCurrent:Offset为移动后指针与当前指针的相对位置。
soFromEnd:Offset为移动后指针距离数据结束的位置。此时Offset必须小于或者等于零。

4）、Setsize:此方法实现改变数据的大小。

另外，TStream类中还定义了几个静态方法：
1）、ReadBuffer:此方法的作用是从流中当前位置读取数据，跟上面的Read相同。
注意：当读取的数据字节数与需要读取的字节数不相同时，将产生EReadError异常。
2）、WriteBuffer:此方法的作用是在当前位置向流写入数据，跟上面的Write相同。
注意：当写入的数据字节数与需要写入的字节数不相同时，将产生EWriteError异常。
3）、CopyFrom:此方法的作用是从其它流中拷贝数据流。
函数原形为：Function CopyFrom(Source:TStream;Count:Longint):Longint;
参数Source为提供数据的流，Count为拷贝的数据字节数。当Count大于0时，CopyFrom从Source参数的当前位置拷贝Count个字节的数据；当Count等于0时，CopyFrom设置Source参数的Position属性为0,然后拷贝Source的所有数据；

 

Tstream常见派生类：
TFileStream (文件流的存取)
TStringStream (处理内存中的字符串类型数据)
TmemoryStream (对于工作的内存区域数据处理)
TBlobStream (BLOB类型字段的数据处理)
TwinSocketStream (socket的读写处理)
ToleStream (COM接口的数据处理)
TresourceStream (资源文件流的处理)
其中最常用的是TFileStream类。使用TFileStream类来存取文件，首先要建立一个实例。声明如下：
constructor Create(const Filename:string;Mode:Word);
Filename为文件名（包括路径）
Mode为打开文件的方式，它包括文件的打开模式和共享模式，其可能的取值和意义如下：
打开模式：
fmCreate :用指定的文件名建立文件，如果文件已经存在则打开它。
fmOpenRead :以只读方式打开指定文件
fmOpenWrite :以只写方式打开指定文件
fmOpenReadWrite:以写写方式打开指定文件
共享模式：
fmShareCompat :共享模式与FCBs兼容
fmShareExclusive:不允许别的程序以任何方式打开该文件
fmShareDenyWrite:不允许别的程序以写方式打开该文件
fmShareDenyRead :不允许别的程序以读方式打开该文件
fmShareDenyNone :别的程序可以以任何方式打开该文件

（三）资源文件
1）、创建资源文件
首先创建一个.Rc的纯文本文件。
格式： 资源标识符 关键字 资源文件名

资源标识符：程序中调用资源时的特殊标号；
关键字：标识资源文件类型；
Wave： 资源文件是声音文件；
RCDATA： JPEG文件；
AVI： AVI动画；
ICON： 图标文件；
BITMAP： 位图文件；
CURSOR： 光标文件；
EXEFILE ： EXE文件
资源文件名：资源文件的在磁盘上存储的文件全名

例如：
myzjy exefile zjy.exe

2）、编译资源文件
在DELPHI的安装目录的\Bin下，使用BRCC32.exe编译资源文件.RC。当然，也可以将BRCC32单独拷贝到程序文档目录使用。
例如：
Brcc32 wnhoo_reg.Rc

3）、资源文件引用
…
implementation

{$R *.dfm}
{$R wnhoo_reg.Res}
…
4）、调用资源文件
(1)存取资源文件中的位图(Bitmap)
Image.Picture.Bitmap.Handle :=LoadBitmap(hInstance,'资源标识符');
注：如果位图没有装载成功，程序仍旧执行，但是Image将不再显示图片。你可以根据LoadBitmap函数的返回值判断是否装载成功，如果装载成功返回值是非0，如果装载失败返回值是0。

另外一个存取显示位图的方法如下
Image.Picture.Bitmap.LoadFromResourceName(hInstance,'资源标识符');

(2)存取资源文件中的光标
Screen.Cursors[]是一个光标数组，使用光标文件我们可以将定制的光标加入到这个属性中。因为默认的光标在数组中索引值是0，所以除非想取代默认光标，最好将定制的光标索引值设为1。
Screen.Cursors[1] :=LoadCursor(hInstance,'资源标识符');
Image.Cursor :=1;

(3)存取资源文件中的图标
将图标放在资源文件中，可以实现动态改变应用程序图标。
Application.Icon.Handle := LoadIcon(hInstance,'资源标识符');

(4)存取资源文件中的AVI
Animate.ResName :='MyAvi' ; //资源标识符号
Animate.Active :=True ;

(5)存取资源文件中的JPEG
把jpeg单元加入到uses单元中。
var
Fjpg : TJpegImage ;
FStream :TResourceStream ;
begin
Fjpg :=TJpegImage.Create ;
//TresourceStream使用
FStream := TResourceStream.Create (Hinstance,'资源标识符',资源类型) ;
FJpg.LoadFromStream (FStream) ;
Image.Picture.Bitmap.Assign (FJpg);

(6)存取资源文件中的Wave
把MMSystem加入uses单元中
PlaySound(pchar('mywav')，Hinstance，Snd_ASync or Snd_Memory or snd_Resource) ;

 

(四)INI文件操作
（1） INI文件的结构：
;这是关于INI文件的注释部分
[节点]
关键字=值
...
INI文件允许有多个节点，每个节点又允许有多个关键字， “=”后面是该关键字的值（类型有三种：字符串、整型数值和布尔值。其中字符串存贮在INI文件中时没有引号，布尔真值用1表示，布尔假值用0表示）。注释以分号“;”开头。

（2） INI文件的操作
1、 在Interface的Uses节增加IniFiles；
2、 在Var变量定义部分增加一行：inifile:Tinifile;然后，就可以对变量myinifile进行创建、打开、读取、写入等操作了。
3、 打开INI文件：inifile:=Tinifile.create('tmp.ini');
4、 读取关键字的值:
a:=inifile.Readstring('节点','关键字',缺省值);// string类型
b:=inifile.Readinteger('节点','关键字',缺省值);// integer类型
c:=inifile.Readbool('节点','关键字',缺省值);// boolean类型
其中[缺省值]为该INI文件不存在该关键字时返回的缺省值。
5、 写入INI文件:
inifile.writestring('节点','关键字',变量或字符串值);
inifile.writeinteger('节点','关键字',变量或整型值);
inifile.writebool('节点','关键字',变量或True或False);
当这个INI文件的节点不存在时，上面的语句还会自动创建该INI文件。
6、 删除关键字：
inifile.DeleteKey('节点','关键字');//关键字删除
inifile.EraseSection('节点');// 节点删除
7、 节点操作：
inifile.readsection('节点',TStrings变量);//可将指定小节中的所有关键字名读取至一个字符串列表变量中；
inifile.readsections(TStrings变量);//可将INI文件中所有小节名读取至一个字符串列表变量中去。
inifile.readsectionvalues('节点',TStrings变量);//可将INI文件中指定小节的所有行（包括关键字、=、值）读取至一个字符串列表变量中去。
8、 释放：inifile.distory;或inifile.free;

 

(五)文件关联
uses
registry, shlobj;
//实现关联注册
procedure Tmyzip.regzzz;
var
reg: TRegistry;
begin
reg := TRegistry.Create;
reg.RootKey := HKEY_CLASSES_ROOT;
reg.OpenKey('.zzz', true);
reg.WriteString('', 'myzip');
reg.CloseKey;
reg.OpenKey('myzip\shell\open\command', true);
//用于打开.zzz文件的可执行程序
reg.WriteString('', '"' + application.ExeName + '" "%1"');
reg.CloseKey;
reg.OpenKey('myzip\DefaultIcon',true);
//取当前可执行程序的图标为.zzz文件的图标
reg.WriteString('',''+application.ExeName+',0');
reg.Free;
//立即刷新
SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);

end;

 

2.3、加密压缩的实现
1、 生成INI临时加密文件
用于加密的INI的临时文件格式：
[FILE1]//节点，在软件中使用FILE1..N可以实现多文件加密
FILENAME=压缩文件名
PASSWORD=解压密码
FILESIZE=文件大小
FILEDATE=创建日期
ISJM=解压是否需要密码
如果是实现多文件、文件夹的信息存储，可以将密码关键字存在一个总的节点下。本文中仅是实现对单个文件的加密，所以只要上述格式就可以了。
2、 将数据文件与用于加密的INI文件的合并，这可以采用文件流的形式实现。
加密后文件结构图：
图（1）

图（2）

上面两种形式，可以根据实际采用。本文采用图（1）的结构。
3、 对于加密后的数据，采用ZLIB技术实现压缩存储，生成新压缩形式的文件。

 

2.4、文件关联的实现 见2.2 (五)

2.5、自解压的实现
1． 建立一个专门用来自解压的可执行程序文件
2． 将1中建立的文件，生成资源文件
3． 将资源文件放到本文中这个压缩工具的程序中一起编译。
4． 通过将资源文件与压缩文件的合并，生成自解压文件。
自解压文件结构图：

5．自解压实现：通过将自身文件中的加密压缩数据的分解，然后对分解的加密压缩数据再一次解压并分解出真正的数据文件。

2.6 系统程序设计

这是关于这个软件实现的核心部分全部代码，在这里详细讲述这个软件所有的技术细节。

// wnhoo_zzz.pasunit wnhoo_zzz;interfaceusesWindows,Forms,SysUtils,Classes,zlib,Registry,INIFILES, Dialogs, shlobj;typepass=string[20];typeTmyzip = classprivate{ private declarations here}protected{ protected declarations here }publicprocedure regzzz;procedure ys_file(infileName, outfileName: string;password:pass;isjm:boolean;ysbz:integer);function jy_file(infileName: string;password:pass=''):boolean;procedure zjywj(var filename:string);constructor Create;destructor Destroy; override;{ public declarations here }published{ published declarations here }end;implementationconstructor Tmyzip.Create;begininherited Create; // 初始化继承下来的部分end;//#####################################################//原文件加密procedure jm_File(vfile:string;var Target:TMemoryStream;password:pass;isjm:boolean);{vfile:加密文件target:加密后输出目标流 》》》password:密码isjm:是否加密-------------------------------------------------------------加密后文件SIZE＝原文件SIZE＋[INI加密压缩信息文件]的SIZE＋存储[INI加密压缩信息文件]的大小数据类型的SIZE---------------------------------------------------------------}vartmpstream,inistream:TFileStream;FileSize:integer;inifile:TINIFILE;filename:string;begin//打开需要 [加密压缩文件]tmpstream:=TFileStream.Create(vFile,fmOpenread or fmShareExclusive);try//向 [临时加密压缩文件流] 尾部写入 [原文件流]Target.Seek(0,soFromEnd);Target.CopyFrom(tmpstream,0);//取得文件路径 ，生成 [INI加密压缩信息文件]filename:=ExtractFilePath(paramstr(0))+'tmp.in_';inifile:=TInifile.Create(filename);inifile.WriteString('file1','filename',ExtractFileName(vFile));inifile.WriteString('file1','password',password);inifile.WriteInteger('file1','filesize',Target.Size);inifile.WriteDateTime('file1','fileDate',now());inifile.WriteBool('file1','isjm',isjm);inifile.Free ;//读入 [INI加密压缩信息文件流]inistream:=TFileStream.Create(filename,fmOpenread or fmShareExclusive);try//继续在 [临时加密压缩文件流] 尾部加入 [INI加密压缩信息文件]inistream.Position :=0;Target.Seek(0,sofromend);Target.CopyFrom(inistream,0);//计算当前 [INI加密压缩信息文件] 的大小FileSize:=inistream.Size ;//继续在 [临时加密文件尾部] 加入 [INI加密压缩信息文件] 的SIZE信息Target.WriteBuffer(FileSize,sizeof(FileSize));finallyinistream.Free ;deletefile(filename);end;finallytmpstream.Free;end;end;//**************************************************************//流压缩procedure ys_stream(instream, outStream: TStream;ysbz:integer);{instream： 待压缩的已加密文件流outStream 压缩后输出文件流ysbz:压缩标准}varys: TCompressionStream;begin//流指针指向头部inStream.Position := 0;//压缩标准的选择case ysbz of1: ys := TCompressionStream.Create(clnone,OutStream);//不压缩2: ys := TCompressionStream.Create(clFastest,OutStream);//快速压缩3: ys := TCompressionStream.Create(cldefault,OutStream);//标准压缩4: ys := TCompressionStream.Create(clmax,OutStream); //最大压缩elseys := TCompressionStream.Create(clFastest,OutStream);end;try//压缩流ys.CopyFrom(inStream, 0);finallyys.Free;end;end;//*****************************************************************//流解压procedure jy_Stream(instream, outStream: TStream);{instream :原压缩流文件outStream：解压后流文件}varjyl: TDeCompressionStream;buf: array[1..512] of byte;sjread: integer;begininStream.Position := 0;jyl := TDeCompressionStream.Create(inStream);tryrepeat//读入实际大小sjRead := jyl.Read(buf, sizeof(buf));if sjread > 0 thenOutStream.Write(buf, sjRead);until (sjRead = 0);finallyjyl.Free;end;end;//**************************************************************//实现关联注册procedure Tmyzip.regzzz;varreg: TRegistry;beginreg := TRegistry.Create;reg.RootKey := HKEY_CLASSES_ROOT;reg.OpenKey('.zzz', true);reg.WriteString('', 'myzip');reg.CloseKey;reg.OpenKey('myzip\shell\open\command', true);//用于打开.zzz文件的可执行程序reg.WriteString('', '"' + application.ExeName + '" "%1"');reg.CloseKey;reg.OpenKey('myzip\DefaultIcon',true);//取当前可执行程序的图标为.zzz文件的图标reg.WriteString('',''+application.ExeName+',0');reg.Free;//立即刷新SHChangeNotify(SHCNE_ASSOCCHANGED, SHCNF_IDLIST, nil, nil);end;//压缩文件procedure Tmyzip.ys_file(infileName, outfileName: string;password:pass;isjm:boolean;ysbz:integer);{infileName：//需要压缩加密的文件outfileName：//压缩加密后产生的文件password：//解压密码ysbz：//压缩标准}varinstream:TMemoryStream; //文件加密后的临时流outStream: TFileStream; //压缩输出文件流begin//创建 [文件加密后的临时流]instream:=TMemoryStream.Create;//文件加密jm_file(infileName,instream,password,isjm);//创建压缩输出文件流outStream := TFileStream.create(outFIleName, fmCreate);try//[文件加密后的临时流] 压缩ys_stream(instream,OutStream,ysbz);finallyOutStream.free;instream.Free ;end;end;//解压文件function Tmyzip.jy_file(infileName: string;password:pass=''):boolean;varinStream,inistream,filestream_ok: TFileStream;{instream://解压文件名称inistream://INI临时文件流filestream_ok://解压OK的文件}outStream:tmemorystream; //临时内存流inifile:TINIFILE; //临时INI文件FileSize:integer; //密码文件的SIZEresultvalue:boolean;//返回值begintryinStream := TFileStream.create(inFIleName, fmOpenRead);tryoutStream := tmemorystream.create;tryjy_stream(insTream,OutStream);//生成临时INI文件inistream:=TFileStream.create(ExtractFilePath(paramstr(0))+'tmp.in_', fmCreate);try//指向存储解码信息的INTEGER型变量位置OutStream.Seek(-sizeof(FileSize),sofromend);//读入变量信息OutStream.ReadBuffer(FileSize,sizeof(FileSize));//指向解码信息位置OutStream.Seek(-(FileSize+sizeof(FileSize)),sofromend);//将解码信息读入INI流中inistream.CopyFrom(OutStream,FileSize);//释放INI文件流inistream.Free ;//读入INI文件信息inifile:=TINIFILE.Create(ExtractFilePath(paramstr(0))+'tmp.in_');resultvalue:=inifile.ReadBool('file1','isjm',false);if resultvalue thenbeginif inifile.ReadString ('file1','password','')=trim(password) thenresultvalue:=trueelseresultvalue:=false;endelseresultvalue:=true;if resultvalue thenbeginfilestream_ok:=TFileStream.create(ExtractFilePath(paramstr(1))+inifile.ReadString('file1','filename','wnhoo.zzz'),fmCreate);tryOutStream.Position :=0;filestream_ok.CopyFrom(OutStream,inifile.ReadInteger('file1','filesize',0));finallyfilestream_ok.Free ;end;end;inifile.Free;finally//删除临时INI文件deletefile(ExtractFilePath(paramstr(0))+'tmp.in_');end;//finallyOutStream.free;end;finallyinStream.free;end;exceptresultvalue:=false ;end;result:=resultvalue;end; //自解压创建procedure tmyzip.zjywj(var filename:string);varmyRes: TResourceStream;//临时存放自解压EXE文件myfile:tfilestream;//原文件流xfilename:string;//临时文件名称file_ok:tmemorystream; //生成文件的内存流filesize:integer; //原文件大小beginif FileExists(filename) thenbegin//创建内存流file_ok:=tmemorystream.Create ;//释放资源文件-- 自解压EXE文件myRes := TResourceStream.Create(Hinstance, 'myzjy', Pchar('exefile'));//将原文件读入内存myfile:=tfilestream.Create(filename,fmOpenRead);trymyres.Position:=0;file_ok.CopyFrom(myres,0);file_ok.Seek(0,sofromend);myfile.Position:=0;file_ok.CopyFrom(myfile,0);file_ok.Seek(0,sofromend);filesize:=myfile.Size;file_ok.WriteBuffer(filesize,sizeof(filesize));file_ok.Position:=0;xfilename:=ChangeFileExt(filename,'.exe') ;file_ok.SaveToFile(xfilename);finallymyfile.Free ;myres.Free ;file_ok.Free ;end;DeleteFile(filename);filename:=xfilename;end;end;//#####################################################destructor Tmyzip.Destroy;begininherited Destroy;end;end.

3 、结束语
Delphi的全新可视化编程环境，为我们提供了一种方便、快捷的Windows应用程序开发工具。对于程序开发人员来讲，使用Delphi开发应用软件，无疑会大大地提高编程效率。在delphi中可以很方便的利用流实现文件处理、动态内存处理、网络数据处理等多种数据形式，写起程序也会大大提高效率的。

参考文献：
1、DELPHI系统帮助
2、冯志强. Delphi 中压缩流和解压流的应用
3、陈经韬.谈Delphi编程中“流”

 

2006-2-16 19:39:39 遍历所有硬盘的所有目录关键词:遍历 文件夹 目录
//一个遍历所有硬盘的所有目录的实例源码:

unit Unit1;interfaceusesWindows, Messages, FileCtrl,SysUtils, Classes, Graphics, Controls, Forms, Dialogs,ComCtrls, StdCtrls, ImgList, ExtCtrls;typeTForm1 = class(TForm)TreeView: TTreeView;Button3: TButton;procedure Button3Click(Sender: TObject);private{ Private declarations }publicprocedure CreateDirectoryTree(RootDir, RootCaption: string);end;varForm1: TForm1;implementation{$R *.DFM}procedure TForm1.CreateDirectoryTree(RootDir, RootCaption: string);procedure AddSubDirToTree(RootNode: TTreeNode);varSearchRec: TSearchRec;Path: string;Found: integer;beginPath := PChar(RootNode.Data) + '\*.*';Found := FindFirst(Path, faAnyFile, SearchRec);while Found = 0 dobeginif (SearchRec.Attr = faDirectory) and (SearchRec.Name <> '.') and (SearchRec.Name <> '..') thenAddSubDirToTree(TreeView.Items.AddChildObject(RootNode, SearchRec.Name,PChar(PChar(RootNode.Data) + '\' + SearchRec.Name)));Found := FindNext(SearchRec);end;FindClose(SearchRec);end;begin//TreeView.Items.Clear;AddSubDirToTree(TreeView.Items.AddObject(nil, RootCaption, PChar(RootDir)));end;procedure TForm1.Button3Click(Sender: TObject);vari:integer;abc:Tstrings;s:string;beginabc:=TStringlist.Create;for i:=0 to 23 do begins := Chr(65+i)+':\';// if GetDriveType(PChar(s))= DRIVE_cdrom thenif directoryexists(s) thenbegins:=copy(s,0,2) ;abc.Add(s);end;end;for i:=0 to abc.Count-1 doBEGINS:=abc.strings[i];CreateDirectoryTree(S, '['+s+'\]');ENDend;end. 2006-2-16 19:40:27 文件或目录转换成TreeView关键词:treeview 下面的这个函数就可以了： procedure DirToTreeView(Tree: TTreeView; Directory: string; Root: TTreeNode; IncludeFiles:Boolean);varSearchRec : TSearchRec;ItemTemp : TTreeNode;beginwith Tree.Items dotryBeginUpdate;if Directory[Length(Directory)] <> ' then Directory := Directory + ';if FindFirst(Directory + '*.*', faDirectory, SearchRec) = 0 thenbeginrepeatif (SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <> '.') thenbeginif (SearchRec.Attr and faDirectory > 0) thenRoot := AddChild(Root, SearchRec.Name);ItemTemp := Root.Parent;DirToTreeView(Tree, Directory + SearchRec.Name, Root, IncludeFiles);Root := ItemTemp;endelse if IncludeFiles thenif SearchRec.Name[1] <> '.' thenAddChild(Root, SearchRec.Name);until FindNext(SearchRec) <> 0;FindClose(SearchRec);end;finallyEndUpdate;end;end; 2006-2-16 19:40:58 如何判断一目录是否共享关键词:判断 共享目录 共享文件夹 Shell编程---如何判断一目录是否共享？下面函数要额外引用 ShlObj, ComObj, ActiveX 单元。function TForm1.IfFolderShared(FullFolderPath: string): Boolean;//将TStrRet类型转换为字符串function StrRetToString(PIDL: PItemIDList; StrRet: TStrRet; Flag:string=''): string;varP: PChar;begincase StrRet.uType ofSTRRET_CSTR:SetString(Result, StrRet.cStr, lStrLen(StrRet.cStr));STRRET_OFFSET:beginP := @PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];SetString(Result, P, PIDL.mkid.cb - StrRet.uOffset);end;STRRET_WSTR:if Assigned(StrRet.pOleStr) thenResult := StrRet.pOleStrelseResult := '';end;{ This is a hack bug fix to get around Windows Shell Controls returningspurious "?"s in date/time detail fields }if (Length(Result) > 1) and (Result[1] = '?') and (Result[2] in ['0'..'9']) thenResult := StringReplace(Result,'?','',[rfReplaceAll]);end;//返回Desktop的IShellFolder接口function DesktopShellFolder: IShellFolder;beginOleCheck(SHGetDesktopFolder(Result));end;//返回IDList去掉第一个ItemID后的IDListfunction NextPIDL(IDList: PItemIDList): PItemIDList;beginResult := IDList;Inc(PChar(Result), IDList^.mkid.cb);end;//返回IDList的长度function GetPIDLSize(IDList: PItemIDList): Integer;beginResult := 0;if Assigned(IDList) thenbeginResult := SizeOf(IDList^.mkid.cb);while IDList^.mkid.cb <> 0 dobeginResult := Result + IDList^.mkid.cb;IDList := NextPIDL(IDList);end;end;end;//取得IDList中ItemID的个数function GetItemCount(IDList: PItemIDList): Integer;beginResult := 0;while IDList^.mkid.cb <> 0 dobeginInc(Result);IDList := NextPIDL(IDList);end;end;//创建一ItemIDList对象function CreatePIDL(Size: Integer): PItemIDList;varMalloc: IMalloc;beginOleCheck(SHGetMalloc(Malloc));Result := Malloc.Alloc(Size);if Assigned(Result) thenFillChar(Result^, Size, 0);end;//返回IDList的一个内存拷贝function CopyPIDL(IDList: PItemIDList): PItemIDList;varSize: Integer;beginSize := GetPIDLSize(IDList);Result := CreatePIDL(Size);if Assigned(Result) thenCopyMemory(Result, IDList, Size);end;//返回AbsoluteID最后一个ItemID，即此对象相对于父对象的ItemIDfunction RelativeFromAbsolute(AbsoluteID: PItemIDList): PItemIDList;beginResult := AbsoluteID;while GetItemCount(Result) > 1 doResult := NextPIDL(Result);Result := CopyPIDL(Result);end;//将IDList的最后一个ItemID去掉，即得到IDList的父对象的ItemIDprocedure StripLastID(IDList: PItemIDList);varMarkerID: PItemIDList;beginMarkerID := IDList;if Assigned(IDList) thenbeginwhile IDList.mkid.cb <> 0 dobeginMarkerID := IDList;IDList := NextPIDL(IDList);end;MarkerID.mkid.cb := 0;end;end;//判断返回值Flag中是否包含属性Elementfunction IsElement(Element, Flag: Integer): Boolean;beginResult := Element and Flag <> 0;end;varP: Pointer;NumChars, Flags: LongWord;ID, NewPIDL, ParentPIDL: PItemIDList;ParentShellFolder: IShellFolder;beginResult := false;NumChars := Length(FullFolderPath);P := StringToOleStr(FullFolderPath);//取出该目录的绝对ItemIDListOleCheck(DesktopShellFolder.ParseDisplayName(0, nil, P, NumChars, NewPIDL, Flags));if NewPIDL <> nil thenbeginParentPIDL := CopyPIDL(NewPIDL);StripLastID(ParentPIDL); //得到该目录上一级目录的ItemIDListID := RelativeFromAbsolute(NewPIDL); //得到该目录相对于上一级目录的ItemIDList//取得该目录上一级目录的IShellFolder接口OleCheck(DesktopShellFolder.BindToObject(ParentPIDL, nil, IID_IShellFolder,Pointer(ParentShellFolder)));if ParentShellFolder <> nil thenbeginFlags := SFGAO_SHARE;//取得该目录的属性OleCheck(ParentShellFolder.GetAttributesOf(1, ID, Flags));if IsElement(SFGAO_SHARE, Flags) then Result := true;end;end;end;

此函数的用法：

//传进的参数为一目录的全路经

if IfFolderShared('C:Documents') then showmessage('shared')

else showmessage('not shared');

另外，有一函数 SHBindToParent 可以直接取得此目录的上一级目录的IShellFolder接口和此目录相对于上一级目录的ItemIDList，这样一来就省去了上面多个对ItemIDList进行操作的函数（这些函数从delphi6的TShellTreeView所在的单元拷贝而来），但是此函数为新加入的API，只在win2000、winxp和winme下可以使用（这么有用的函数微软怎么就没早点想出来呢