delphi关于文件操作集锦

2022-10-14 18:06:17

关于文件操作集锦

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

unit
Unit1;

interface

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

type
TForm1
= class(TForm)
Button1: TButton;
procedure Button1Click(Sender:
TObject);
private
{ Private declarations }
public
{ Public
declarations }
end;

var
Form1:
TForm1;

implementation
uses activex,comobj,shlobj;
{$R
*.dfm}

function ResolveLink(const ALinkfile: String):
String;
var
link: IShellLink;
storage: IPersistFile;
filedata:
TWin32FindData;
buf: Array[0..MAX_PATH] of Char;
widepath:
WideString;
begin
OleCheck(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)) Then
If
Succeeded(link.Resolve(GetActiveWindow, SLR_NOUPDATE)) Then
If
Succeeded(link.GetPath(buf, sizeof(buf), filedata, SLGP_UNCPRIORITY))
Then
Result := buf;
storage := nil;
link:= nil;
end;

//
用法:
procedure TForm1.Button1Click(Sender:
TObject);
begin
ShowMessage(ResolveLink('C:\delphi
7.lnk'));
end;

end.

2006-2-16 19:23:20

发表评语»»»

2006-2-16 19:23:45
在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:09 从快捷方式取得该快捷方式的指向文档关键词:快捷方式

unit
Unit1;

interface

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

type
TForm1
= class(TForm)
Button1: TButton;
procedure Button1Click(Sender:
TObject);
private
{ Private declarations }
public
{ Public
declarations }
end;

var
Form1:
TForm1;

implementation
uses activex,comobj,shlobj;
{$R
*.dfm}

//
用法:
procedure TForm1.Button1Click(Sender:
TObject);
begin
ShowMessage(ResolveLink('C:\delphi
7.lnk'));
end;

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;

procedure
TForm1.Button1Click(Sender:
TObject);
begin
　NewTxt;
end;

procedure
TForm1.Button2Click(Sender:
TObject);
begin
　OpenTxt;
end;

procedure
TForm1.Button3Click(Sender: TObject);
begin
　ReadTxt;
end;

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

//删除某目录下所有指定扩展名文件
function DelFile(sDir,fExt: string):
Boolean;
var
hFindfile: HWND;
FindFileData: WIN32_FIND_DATA;
sr:
TSearchRec;
begin
sDir:= sDir + '\';
hFindfile:=
FindFirstFile(pchar(sDir + fExt), FindFileData);
if hFindFile <> NULL
then
begin
deletefile(sDir + FindFileData.cFileName);
while
FindNextFile(hFindFile, FindFileData) <> FALSE do
deletefile(sDir +
FindFileData.cFileName);
end;
sr.FindHandle:=
hFindFile;
FindClose(sr);
end;

function getAppPath :
string;
var
strTmp : string;
begin
strTmp :=
ExtractFilePath(ExtractFilePath(application.Exename));
if
strTmp[length(strTmp)] <> '\' then
strTmp := 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;

Begin
hResInfo:=FindResource(HInstance,PChar(RESName),MAKEINTRESOURCE('WAVEFILE'));
if
hResInfo = 0
then
begin
messagebox(0,'未找到资源。',PChar(RESName),16);
exit;
end;
hRes:=LoadResource(HInstance,hResinfo);
if
hRes = 0
then
begin
messagebox(0,'不能装载资源。',PChar(RESName),16);
exit;
end;
lpGlob:=LockResource(hRes);
if
lpGlob=Nil
then
begin
messagebox(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
SetDirTimesHelper
TFileTimes = (ftLastAccess, ftLastWrite,
ftCreation);

function SetFileTimesHelper(const FileName: string; const
DateTime: TDateTime; Times: TFileTimes): Boolean;
var
Handle:
THandle;
FileTime: TFileTime;
SystemTime: TSystemTime;
begin
Result
:= False;
Handle := CreateFile(PChar(FileName), GENERIC_WRITE,
FILE_SHARE_READ, nil,
OPEN_EXISTING, 0, 0);
if Handle <>
INVALID_HANDLE_VALUE
then
try
//SysUtils.DateTimeToSystemTime(DateTimeToLocalDateTime(DateTime),
SystemTime);
SysUtils.DateTimeToSystemTime(DateTime, SystemTime);
if
Windows.SystemTimeToFileTime(SystemTime, FileTime) then
begin
case Times
of
ftLastAccess:
Result := SetFileTime(Handle, nil, @FileTime,
nil);
ftLastWrite:
Result := SetFileTime(Handle, nil, nil,
@FileTime);
ftCreation:
Result := SetFileTime(Handle, @FileTime, nil,
nil);
end;
end;
finally
CloseHandle(Handle);
end;
end;

//--------------------------------------------------------------------------------------------------

function
SetFileLastAccess(const FileName: string; const DateTime: TDateTime):
Boolean;
begin
Result := SetFileTimesHelper(FileName, DateTime,
ftLastAccess);
end;

//--------------------------------------------------------------------------------------------------

function
SetFileLastWrite(const FileName: string; const DateTime: TDateTime):
Boolean;
begin
Result := SetFileTimesHelper(FileName, DateTime,
ftLastWrite);
end;

//--------------------------------------------------------------------------------------------------

function
SetFileCreation(const FileName: string; const DateTime: TDateTime):
Boolean;
begin
Result := SetFileTimesHelper(FileName, DateTime,
ftCreation);
end;
----------------------------------------------------------------------

2006-2-16 19:27:57
获取文件修改时间var
fhandle:Thandle;
s:String;
begin
fhandle:=fileopen('f:\abc.txt',0);
try
s:=datetimetostr(filedatetodatetime(filegetdate(fhandle)));
finally
fileclose(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}

procedure
TForm1.Button1Click(Sender:
TObject);
begin
ShowMessage(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;
const
Sett=2048;
var
i:
Integer;
F: file;
a: Boolean;
TotSize, IncSize, ReadSize:
Integer;
c: Array[0..Sett] of byte;
begin
If FileExists(NomeFile)
then
begin
{$I-}
AssignFile(F, NomeFile);
Reset(F,
1);
TotSize:=FileSize(F);
IncSize:=0;
a:=true;
while
(IncSize<TotSize) and (a=true) do
begin

ReadSize:=Sett;

If
IncSize+ReadSize>TotSize then
ReadSize:=TotSize-IncSize;

IncSize:=IncSize+ReadSize;

BlockRead(F,
c, ReadSize);

For i := 0 to ReadSize-1 do // Iterate

If
(c[i]<32) and (not (c[i] in [9, 10, 13, 26])) then a:=False;

end; //
while

CloseFile(F);

{$I+}

If IOResult<>0 then
Result:=False

else Result:=a;

end;

procedure
TForm1.Button1Click(Sender: TObject);

begin

if OpenDialog1.Execute
then

begin

if isAscii(OpenDialog1.FileName)
then

begin

ShowMessage('ASCII
File');

end;

2006-2-16
19:37:30 查找所有文件关键词:查找所有文件
procedure findall(disk,path: String; var
fileresult: Tstrings);
var

fpath: String;

fs:
TsearchRec;

begin

fpath:=disk+path+'\*.*';

if
findfirst(fpath,faAnyFile,fs)=0 then

begin

if
(fs.Name<>'.')and(fs.Name<>'..') then

if (fs.Attr and
faDirectory)=faDirectory
then

findall(disk,path+'\'+fs.Name,fileresult)

else

fileresult.add(disk+strpas(strupper(pchar(path)))+'\'+strpas(

strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');

while
findnext(fs)=0 do

begin

if
(fs.Name<>'.')and(fs.Name<>'..') then

if (fs.Attr and
faDirectory)=faDirectory
then

findall(disk,path+'\'+fs.Name,fileresult)

else

fileresult.add(disk+strpas(strupper(pchar(path)))+'\'+str

pas(strupper(pchar(fs.Name)))+'('+inttostr(fs.Size)+')');

end;

findclose(fs);

end;

procedure
DoSearchFile(Path: string; Files: TStrings = nil);

var

Info:
TSearchRec;

procedure ProcessAFile(FileName:
string);

begin

if Assigned(PnlPanel) then

PnlPanel.Caption
:= FileName;

Label2.Caption := FileName;

end;

function
IsDir: Boolean;

begin

with Info do

Result := (Name <>
'.') and (Name <> '..') and ((attr and fadirectory) =
fadirectory);

end;

function IsFile:
Boolean;

begin

Result := not ((Info.Attr and faDirectory) =
faDirectory);

end;

begin

Path :=
IncludeTrailingBackslash(Path);

try

if FindFirst(Path + '*.*',
faAnyFile, Info) = 0 then

if IsFile then

ProcessAFile(Path +
Info.Name)

else if IsDir then DoSearchFile(Path +
Info.Name);

while FindNext(Info) = 0 do

begin

if IsDir
then

DoSearchFile(Path + Info.Name)

else if IsFile
then

ProcessAFile(Path +
Info.Name);

Application.ProcessMessages;

if QuitFlag then
Break;

Sleep(100);

end;

finally

FindClose(Info);

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.pas

unit
wnhoo_zzz;
interface

uses
Windows,Forms,SysUtils,Classes,zlib,Registry,INIFILES,
Dialogs, shlobj;
type
pass=string[20];
type
Tmyzip =
class

private
{ private declarations here}
protected
{ protected
declarations here }
public
procedure 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;

implementation

constructor
Tmyzip.Create;
begin
inherited Create; //
初始化继承下来的部分
end;

//#####################################################
//原文件加密
procedure
jm_File(vfile:string;var
Target:TMemoryStream;password:pass;isjm:boolean);
{
vfile:加密文件
target:加密后输出目标流
》》》
password:密码
isjm:是否加密
-------------------------------------------------------------
加密后文件SIZE＝原文件SIZE＋[INI加密压缩信息文件]的SIZE＋存储[INI加密压缩信息文件]的大小数据类型的SIZE
---------------------------------------------------------------
}
var

tmpstream,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));
finally
inistream.Free
;
deletefile(filename);
end;
finally
tmpstream.Free;
end;

end;

//**************************************************************

//流压缩
procedure
ys_stream(instream, outStream: TStream;ysbz:integer);
{
instream：
待压缩的已加密文件流
outStream 压缩后输出文件流
ysbz:压缩标准
}
var
ys:
TCompressionStream;
begin
//流指针指向头部
inStream.Position :=
0;
//压缩标准的选择
case ysbz of
1: ys :=
TCompressionStream.Create(clnone,OutStream);//不压缩
2: ys :=
TCompressionStream.Create(clFastest,OutStream);//快速压缩
3: ys :=
TCompressionStream.Create(cldefault,OutStream);//标准压缩
4: ys :=
TCompressionStream.Create(clmax,OutStream); //最大压缩
else

ys :=
TCompressionStream.Create(clFastest,OutStream);
end;

try
//压缩流
ys.CopyFrom(inStream,
0);
finally
ys.Free;
end;
end;

//*****************************************************************

//流解压
procedure
jy_Stream(instream, outStream: TStream);
{
instream
:原压缩流文件
outStream：解压后流文件
}
var
jyl: TDeCompressionStream;
buf:
array[1..512] of byte;
sjread: integer;
begin
inStream.Position :=
0;
jyl :=
TDeCompressionStream.Create(inStream);
try
repeat
//读入实际大小
sjRead :=
jyl.Read(buf, sizeof(buf));
if sjread > 0 then
OutStream.Write(buf,
sjRead);
until (sjRead =
0);
finally
jyl.Free;
end;
end;

//**************************************************************

//实现关联注册
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;

//压缩文件
procedure
Tmyzip.ys_file(infileName, outfileName:
string;password:pass;isjm:boolean;ysbz:integer);
{
infileName：//需要压缩加密的文件
outfileName：//压缩加密后产生的文件
password：//解压密码
ysbz：//压缩标准
}
var
instream:TMemoryStream;
//文件加密后的临时流
outStream: TFileStream; //压缩输出文件流

begin
//创建
[文件加密后的临时流]
instream:=TMemoryStream.Create;
//文件加密
jm_file(infileName,instream,password,isjm);
//创建压缩输出文件流
outStream
:= TFileStream.create(outFIleName, fmCreate);
try
//[文件加密后的临时流]
压缩
ys_stream(instream,OutStream,ysbz);
finally
OutStream.free;
instream.Free
;
end;
end;

//解压文件
function Tmyzip.jy_file(infileName:
string;password:pass=''):boolean;
var
inStream,inistream,filestream_ok:
TFileStream;
{
instream://解压文件名称
inistream://INI临时文件流
filestream_ok://解压OK的文件
}
outStream:tmemorystream;
//临时内存流
inifile:TINIFILE; //临时INI文件
FileSize:integer;
//密码文件的SIZE
resultvalue:boolean;//返回值

begin

try
inStream :=
TFileStream.create(inFIleName, fmOpenRead);

try
outStream :=
tmemorystream.create;
try
jy_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 then
begin
if inifile.ReadString
('file1','password','')=trim(password)
then
resultvalue:=true
else
resultvalue:=false;
end
else
resultvalue:=true;

if
resultvalue
then
begin

filestream_ok:=TFileStream.create(ExtractFilePath(paramstr(1))+inifile.ReadString('file1','filename','wnhoo.zzz'),fmCreate);
try
OutStream.Position
:=0;
filestream_ok.CopyFrom(OutStream,inifile.ReadInteger('file1','filesize',0));
finally
filestream_ok.Free
;
end;

end;

inifile.Free;
finally
//删除临时INI文件
deletefile(ExtractFilePath(paramstr(0))+'tmp.in_');
end;
//
finally
OutStream.free;
end;
finally
inStream.free;
end;
except
resultvalue:=false
;

end;
result:=resultvalue;
end;

//自解压创建
procedure
tmyzip.zjywj(var filename:string);
var
myRes:
TResourceStream;//临时存放自解压EXE文件
myfile:tfilestream;//原文件流
xfilename:string;//临时文件名称
file_ok:tmemorystream;
//生成文件的内存流
filesize:integer; //原文件大小
begin
if FileExists(filename)
then
begin
//创建内存流
file_ok:=tmemorystream.Create ;
//释放资源文件--
自解压EXE文件
myRes := TResourceStream.Create(Hinstance, 'myzjy',
Pchar('exefile'));
//将原文件读入内存
myfile:=tfilestream.Create(filename,fmOpenRead);
try

myres.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);

finally
myfile.Free
;
myres.Free ;
file_ok.Free
;

end;
DeleteFile(filename);
filename:=xfilename;

end;
end;

//#####################################################

destructor
Tmyzip.Destroy;
begin

inherited Destroy;
end;
end.

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

参考文献：

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

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

unit
Unit1;

interface

uses
Windows, Messages, FileCtrl,SysUtils,
Classes, Graphics, Controls, Forms, Dialogs,
ComCtrls, StdCtrls, ImgList,
ExtCtrls;

type
TForm1 = class(TForm)
TreeView:
TTreeView;
Button3: TButton;
procedure Button3Click(Sender:
TObject);
private
{ Private declarations }
public
procedure
CreateDirectoryTree(RootDir, RootCaption: string);
end;

var
Form1:
TForm1;

implementation

{$R *.DFM}
procedure
TForm1.CreateDirectoryTree(RootDir, RootCaption: string);
procedure
AddSubDirToTree(RootNode: TTreeNode);
var
SearchRec: TSearchRec;
Path:
string;
Found: integer;
begin
Path := PChar(RootNode.Data) +
'\*.*';
Found := FindFirst(Path, faAnyFile, SearchRec);
while Found = 0
do
begin
if (SearchRec.Attr = faDirectory) and (SearchRec.Name <>
'.') and (SearchRec.Name <> '..')
then
AddSubDirToTree(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);
var
i:integer;
abc:Tstrings;
s:string;
begin
abc:=TStringlist.Create;
for
i:=0 to 23 do begin
s := Chr(65+i)+':\';
// if GetDriveType(PChar(s))=
DRIVE_cdrom then
if directoryexists(s) then
begin
s:=copy(s,0,2)
;
abc.Add(s);
end;
end;
for i:=0 to abc.Count-1
do
BEGIN
S:=abc.strings[i];
CreateDirectoryTree(S,
'['+s+'\]');
END
end;

end.

2006-2-16 19:40:27
文件或目录转换成TreeView关键词:treeview
下面的这个函数就可以了：
procedure DirToTreeView(Tree:
TTreeView; Directory: string; Root: TTreeNode;
IncludeFiles:

Boolean);

var

SearchRec :
TSearchRec;

ItemTemp : TTreeNode;

begin

with Tree.Items
do

try

BeginUpdate;

if Directory[Length(Directory)]
<> ' \' then Directory := Directory + '\';

if FindFirst(Directory +
'*.*', faDirectory, SearchRec) = 0 then

begin

repeat

if
(SearchRec.Attr and faDirectory = faDirectory) and (SearchRec.Name[1] <>
'.') then

begin

if (SearchRec.Attr and faDirectory > 0)
then

Root := AddChild(Root, SearchRec.Name);

ItemTemp :=
Root.Parent;

DirToTreeView(Tree, Directory + SearchRec.Name, Root,
IncludeFiles);

Root := ItemTemp;

end

else if IncludeFiles
then

if SearchRec.Name[1] <> '.' then

AddChild(Root,
SearchRec.Name);

until FindNext(SearchRec) <>
0;

FindClose(SearchRec);

end;

finally

EndUpdate;

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;

var

P:
PChar;

begin

case StrRet.uType
of

STRRET_CSTR:

SetString(Result, StrRet.cStr,
lStrLen(StrRet.cStr));

STRRET_OFFSET:

begin

P :=
@PIDL.mkid.abID[StrRet.uOffset - SizeOf(PIDL.mkid.cb)];

SetString(Result,
P, PIDL.mkid.cb - StrRet.uOffset);

end;

STRRET_WSTR:

if
Assigned(StrRet.pOleStr) then

Result :=
StrRet.pOleStr

else

Result := '';

end;

{ This is a
hack bug fix to get around Windows Shell Controls returning

spurious "?"s
in date/time detail fields }

if (Length(Result) > 1) and (Result[1] =
'?') and (Result[2] in ['0'..'9']) then

Result :=
StringReplace(Result,'?','',[rfReplaceAll]);

end;

//返回Desktop的IShellFolder接口

function
DesktopShellFolder:
IShellFolder;

begin

OleCheck(SHGetDesktopFolder(Result));

end;

//返回IDList去掉第一个ItemID后的IDList

function
NextPIDL(IDList: PItemIDList): PItemIDList;

begin

Result :=
IDList;

Inc(PChar(Result),
IDList^.mkid.cb);

end;

//返回IDList的长度

function
GetPIDLSize(IDList: PItemIDList): Integer;

begin

Result :=
0;

if Assigned(IDList) then

begin

Result :=
SizeOf(IDList^.mkid.cb);

while IDList^.mkid.cb <> 0
do

begin

Result := Result + IDList^.mkid.cb;

IDList :=
NextPIDL(IDList);

end;

//取得IDList中ItemID的个数

function
GetItemCount(IDList: PItemIDList): Integer;

begin

Result :=
0;

while IDList^.mkid.cb <> 0
do

begin

Inc(Result);

IDList :=
NextPIDL(IDList);

end;

//创建一ItemIDList对象

function
CreatePIDL(Size: Integer): PItemIDList;

var

Malloc:
IMalloc;

begin

OleCheck(SHGetMalloc(Malloc));

Result :=
Malloc.Alloc(Size);

if Assigned(Result) then

FillChar(Result^,
Size, 0);

end;

//返回IDList的一个内存拷贝

function CopyPIDL(IDList:
PItemIDList): PItemIDList;

var

Size:
Integer;

begin

Size := GetPIDLSize(IDList);

Result :=
CreatePIDL(Size);

if Assigned(Result) then

CopyMemory(Result,
IDList,
Size);

end;

//返回AbsoluteID最后一个ItemID，即此对象相对于父对象的ItemID

function
RelativeFromAbsolute(AbsoluteID: PItemIDList):
PItemIDList;

begin

Result := AbsoluteID;

while
GetItemCount(Result) > 1 do

Result := NextPIDL(Result);

Result
:=
CopyPIDL(Result);

end;

//将IDList的最后一个ItemID去掉，即得到IDList的父对象的ItemID

procedure
StripLastID(IDList: PItemIDList);

var

MarkerID:
PItemIDList;

begin

MarkerID := IDList;

if Assigned(IDList)
then

begin

while IDList.mkid.cb <> 0
do

begin

MarkerID := IDList;

IDList :=
NextPIDL(IDList);

end;

MarkerID.mkid.cb :=
0;

end;

//判断返回值Flag中是否包含属性Element

function
IsElement(Element, Flag: Integer): Boolean;

begin

Result :=
Element and Flag <> 0;

end;

var

P:
Pointer;

NumChars, Flags: LongWord;

ID, NewPIDL, ParentPIDL:
PItemIDList;

ParentShellFolder: IShellFolder;

begin

Result
:= false;

NumChars := Length(FullFolderPath);

P :=
StringToOleStr(FullFolderPath);

//取出该目录的绝对ItemIDList

OleCheck(DesktopShellFolder.ParseDisplayName(0,
nil, P, NumChars, NewPIDL, Flags));

if NewPIDL <> nil
then

begin

ParentPIDL :=
CopyPIDL(NewPIDL);

StripLastID(ParentPIDL);
//得到该目录上一级目录的ItemIDList

ID := RelativeFromAbsolute(NewPIDL);
//得到该目录相对于上一级目录的ItemIDList

//取得该目录上一级目录的IShellFolder接口

OleCheck(DesktopShellFolder.BindToObject(ParentPIDL,
nil, IID_IShellFolder,

Pointer(ParentShellFolder)));

if
ParentShellFolder <> nil then

begin

Flags :=
SFGAO_SHARE;

//取得该目录的属性

OleCheck(ParentShellFolder.GetAttributesOf(1,
ID, Flags));

if IsElement(SFGAO_SHARE, Flags) then Result :=
true;

end;

此函数的用法：

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

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

else
showmessage('not shared');

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

（出处：http://www.delphibbs.com/keylife/iblog_show.asp?xid=20091）

2007-6-14
15:06:14

查看评语»»»

码农公寓

相关文章