取得該快捷方式的指向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}
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;
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}
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); //取文件後綴
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）、數據壓縮
使用DELPHI提供的兩個流類（TCompressionStream和TDecompressionStream）來完成數據的壓縮和解壓縮。
2）、數據加密壓縮
經過Delphi編程中「流」的應用實現數據加密，主要採用Tstream的兩個派生類Tfilestream、Tmemorystream 來完成的；其中數據壓縮部分採用1）的實現方法
3）、雙擊壓縮文件自動關聯解壓
經過更改註冊表的實現擴展名與程序文件的關聯，主要採用Tregistry；而且，API函數SHChangeNotify實現註冊效果的當即呈現。
4）、可生成自解壓文件
自解壓的文件實現數據壓縮1）與數據加密壓縮2）的自動解壓；而且，經過資源文件的使用實現可執行的自解壓文件與數據文件的合併，來完成數據的自解壓實現。
二、 系統實現
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文件的操做
一、 在Interface的Uses節增長IniFiles；
二、 在Var變量定義部分增長一行：inifile:Tinifile;而後，就能夠對變量myinifile進行建立、打開、讀取、寫入等操做了。
三、 打開INI文件：inifile:=Tinifile.create('tmp.ini');
四、 讀取關鍵字的值:
a:=inifile.Readstring('節點','關鍵字',缺省值);// string類型
b:=inifile.Readinteger('節點','關鍵字',缺省值);// integer類型
c:=inifile.Readbool('節點','關鍵字',缺省值);// boolean類型
其中[缺省值]爲該INI文件不存在該關鍵字時返回的缺省值。
五、 寫入INI文件:
inifile.writestring('節點','關鍵字',變量或字符串值);
inifile.writeinteger('節點','關鍵字',變量或整型值);
inifile.writebool('節點','關鍵字',變量或True或False);
當這個INI文件的節點不存在時，上面的語句還會自動建立該INI文件。
六、 刪除關鍵字：
inifile.DeleteKey('節點','關鍵字');//關鍵字刪除
inifile.EraseSection('節點');// 節點刪除
七、 節點操做：
inifile.readsection('節點',TStrings變量);//可將指定小節中的全部關鍵字名讀取至一個字符串列表變量中；
inifile.readsections(TStrings變量);//可將INI文件中全部小節名讀取至一個字符串列表變量中去。
inifile.readsectionvalues('節點',TStrings變量);//可將INI文件中指定小節的全部行（包括關鍵字、=、值）讀取至一個字符串列表變量中去。
八、 釋放：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.三、加密壓縮的實現
一、 生成INI臨時加密文件
用於加密的INI的臨時文件格式：
[FILE1]//節點，在軟件中使用FILE1..N能夠實現多文件加密
FILENAME=壓縮文件名
PASSWORD=解壓密碼
FILESIZE=文件大小
FILEDATE=建立日期
ISJM=解壓是否須要密碼
若是是實現多文件、文件夾的信息存儲，能夠將密碼關鍵字存在一個總的節點下。本文中僅是實現對單個文件的加密，因此只要上述格式就能夠了。
二、 將數據文件與用於加密的INI文件的合併，這能夠採用文件流的形式實現。
加密後文件結構圖：
圖（1）
圖（2）
上面兩種形式，能夠根據實際採用。本文采用圖（1）的結構。
三、 對於加密後的數據，採用ZLIB技術實現壓縮存儲，生成新壓縮形式的文件。
2.四、文件關聯的實現 見2.2 (五)
2.五、自解壓的實現
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中能夠很方便的利用流實現文件處理、動態內存處理、網絡數據處理等多種數據形式，寫起程序也會大大提升效率的。
參考文獻：
一、DELPHI系統幫助
二、馮志強. Delphi 中壓縮流和解壓流的應用
三、陳經韜.談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;
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下可使用（這麼有用的函數微軟怎麼就沒早點想出來呢html |