取得該快捷方式的指向EXE
關鍵詞:快捷方式 LNK
[delphi]
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.
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.
發表評語
在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.
[delphi] view plaincopyprint?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;
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 如何讀寫文本文件關鍵詞:讀寫文本文件
下面源代碼或許對你有些幫助:
[delphi]
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 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 刪除某目錄下所有指定擴展名文件關鍵詞:刪除文件 擴展名
//刪除某目錄下所有指定擴展名文件
[delphi]
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;
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）把下面的代碼加入程序去播放內含的音頻
[delphi]
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;
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下，屬性裡面有三個日起，創建，修改，存儲。我怎麼來修改啊？
代碼如下：
[delphi]
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}
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 begin
s := 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 then
Delete(s, Pos('%', s), length(s));
if ((length(s) > 0) and
(s[1] = '"')) then
Delete(s, 1, 1);
if ((length(s) > 0) and
(s[length(s)] = '"')) then
Delete(s, Length(s), 1);
while ((length(s) > 0) and
((s[length(s)] = #32) or
(s[length(s)] = '"'))) do
Delete(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 then
Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
result := s;
end;
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;
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}
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 begin
s := 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 then
Delete(s, Pos('%', s), length(s));
if ((length(s) > 0) and
(s[1] = '"')) then
Delete(s, 1, 1);
if ((length(s) > 0) and
(s[length(s)] = '"')) then
Delete(s, Length(s), 1);
while ((length(s) > 0) and
((s[length(s)] = #32) or
(s[length(s)] = '"'))) do
Delete(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 then
Delete(s, Pos(' ^', s), length(s));
{$ENDIF}
result := s;
end;
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); //取文件後綴
[delphi]
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;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if isAscii(OpenDialog1.FileName) then
begin
ShowMessage('ASCII File');
end;
end;
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;
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;
end;
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;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute then
begin
if isAscii(OpenDialog1.FileName) then
begin
ShowMessage('ASCII File');
end;
end;
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;
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;
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 系統程序設計
這是關於這個軟件實現的核心部分全部代碼，在這裡詳細講述這個軟件所有的技術細節。
[delphi]
// 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.
// 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 遍歷所有硬盤的所有目錄關鍵詞:遍歷 文件夾 目錄
//一個遍歷所有硬盤的所有目錄的實例源碼:
[delphi]
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;
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;
end;
end;
//取得IDList中ItemID的個數
function GetItemCount(IDList: PItemIDList): Integer;
begin
Result := 0;
while IDList^.mkid.cb <> 0 do
begin
Inc(Result);
IDList := NextPIDL(IDList);
end;
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;
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;
end;
end;
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;
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;
end;
end;
//取得IDList中ItemID的個數
function GetItemCount(IDList: PItemIDList): Integer;
begin
Result := 0;
while IDList^.mkid.cb <> 0 do
begin
Inc(Result);
IDList := NextPIDL(IDList);
end;
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;
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;
end;
end;
此函數的用法：
//傳進的參數為一目錄的全路經
if IfFolderShared('C:Documents') then showmessage('shared')
else showmessage('not shared');
另外，有一函數 SHBindToParent 可以直接取得此目錄的上一級目錄的IShellFolder接口和此目錄相對於上一級目錄的ItemIDList，這樣一來就省去了上面多個對ItemIDList進行操作的函數（這些函數從delphi6的TShellTreeView所在的單元拷貝而來），但是此函數為新加入的API，只在win2000、winxp和winme下可以使用（這麼有用的函數微軟怎麼就沒早點想出來呢
