|
Delphi常用技巧 3
**********************************
判断程序是否运行
if FindWindow(主程序窗体类,主程序窗体标题) = 0 then //找到这个程序
begin
ShowMessage('主程序没有运行') ;
Application.Terminate ;
end;
*******************************
得到鼠标位置上的类
procedure TForm1.Timer1Timer(Sender: TObject);
var
ClassName: PChar;
atCursor: TPoint;
hWndMouseOver: HWND;//鼠标的句柄
Text: PChar;
begin
GetCursorPos(atCursor);//得到鼠标坐标
hWndMouseOver:=WindowFromPoint(atCursor);//得到鼠标句柄和位置
GetMem(ClassName, 100);
GetMem(Text, 255);
try
GetClassName(hWndMouseOver, ClassName, 100);
SendMessage(hWndMouseOver, WM_GETTEXT, 255, LongInt(Text));
Label_ClassName.Caption:='类名(Classname)： '+String(ClassName);
Edit1.Text:=String(Text);
finally
FreeMem(ClassName);
FreeMem(Text);
end;
end;
*****************************
实现断点续传
如果使用ICS控件，那么
HttpCli.ContentRangeBegin := '100' 表示从100开始
HttpCli.ContentRangeEnd :='' 表示一直到结束
HttpCli.ContentRangeEnd :='200' 表示到200字节处结束
如果使用 TNMHTTP 控件
在OnAboutToSend事件，写：
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-' 表示从100字节处开始下载到最后
NMHTTP1.SendHeader.values['Range'] := 'bytes=100-200' 表示从100字节处开始下载到200字节处结束
***************
procedure TForm1.Button6Click(Sender: TObject);
var
f:TSearchRec;
begin
FindFirst('a.doc',faAnyFile,f);
fPreSize:=f.Size;
NMFtp.DoCommand('Rest '+IntToStr(fPreSize));
NMFtp.DownloadRestore('a.doc','a.doc');
end;
这是用TNMFtp来续传的代码。
**********************************
Delphi中用Sender参数实现代码重用
面向对象的编程工具的特点之一就是要提高代码重用性(Reuse)，作为新一代可视化开发工具，Delphi中的代码重用性相当高。我们知道，在Delphi中，大部分程序代码都直接或间接地对应着一个事件，此程序称为事件处理句柄，它实际上就是一个过程。从应用程序的工程到表单、构件和程序，Delphi强调的是其开发过程中每一层次的重用性，可以通过编写某些构件常用的事件处理句柄来达到程序重用目的。你可以在属性窗口的Events页上将A事件的处理句柄指向B事件的处理句柄，这样A事件和B事件就共享了一个过程段，从而达到了重用的目的。如果共享的程序段与发生该事件的控件无关，如ShowMessage(′hello,world′)，那这种共享是最简单的。但一般来说，代码段间的共享都跟发生该事件的控件有关，需要根据控件类型做出相应的处理，这时就要用到Sender参数。
每个过程段的开头都类似procedure TForm1FormClick(Sender:TObject)；其中的Sender是一个TObject类型的参数，它告诉Delphi哪个控件接收这个事件并调用相应的处理过程。你可以编写一个单一的事件处理句柄，通过Sender参数和IF…THEN…语句或者CASE语句配合，来处理多个构件。发生事件的构件或控件的值已经赋给了Sender参数，该参数的用途之一就在于：可以使用保留字IS来测试Sender，以便找到调用这个事件处理句柄的构件或控件的类型。例如，将表单中编辑框和标签的Click事件的处理句柄都指向表单的xxx过程，编辑框和标签对Click事件有不同的反应：
procedure TForm1xxx(Sender:TObject);
begin
if(sender if Tedit) then
showmessage(′this is a editbox′);
if(sender is Tlabel) then
showmessage(′this is a label′);
end;
Sender参数的第二个用途是结合AS操作符进行类型转换，将若干个派生于某一父类的子类强制转换成该父类。例如表单中有一个TEdit类控件和一个TMemo控件，它们实际上都派生于TcustomEdit类，如果你要为二者的某一事件提供同样处理，可以将二者事件句柄都指向自定义的过程yyy:
Procedure TForm1.yyy(Sender:TObject);
begin
(sender as TcustomEdit).text:=′This is some demo text′;
end;
在过程中，AS操作符将TEdit类和TMemo类均强制转换成TcustomEdit类，再对TcustomEdit类的属性赋值。注意这种转换必须符合Delphi中类的层次关系。
使用Sender参数可以通过单一过程段处理多类控件，真正体现了Delphi面向对象的重用性。
*****************************
窗口渐渐出现
AnimateWindow(Handle,1000,AW_CENTER);
*****************************
delphi中嵌入汇编的方法
function cyclecount:int64;
asm
db $0f
db $31
end;
**********************
读BIOS名称日期序列号
读BIOS名称日期序列号，这个程序最短！在D5中测试通过！
with Memo1.Lines do
begin
Add('MainBoardBiosName:'+^I+string(Pchar(Ptr($FE061))));
Add('MainBoardBiosCopyRight:'+^I+string(Pchar(Ptr($FE091))));
Add('MainBoardBiosDate:'+^I+string(Pchar(Ptr($FFFF5))));
Add('MainBoardBiosSerialNo:'+^I+string(Pchar(Ptr($FEC71))));
end;
///////////////////////////////////////////////////////////////////
读主板信息：
主板名称： String(PChar(Ptr($FE061)));
版权： String(PChar(Ptr($FE091)));
日期： String(PChar(Ptr($FFFF5)));
序列号： String(PChar(Ptr($FEC71)));
***********************
在20000下关机
在20000下关机不象在98下直接调用ExitWindows函数就成，你首先要用OpenProcessToken函数打开与进程相关的访问信令然后再使用ExitWindow函数退出Win2000.
以下这段程序可供参考：
var
hToken :THandle ;
tkp :TOKEN_PRIVILEGES ;
otkp :TOKEN_PRIVILEGES ;
dwLen :Dword ;
begin
if OpenProcessToken(GetCurrentProcess ,TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY ,hToken) then
begin
LookupPrivilegevalue(Nil ,'SeShutdownPrivilege' ,tkp.Privileges[0].Luid) ;
tkp.PrivilegeCount := 1 ;
tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
AdjustTokenPrivileges(hToken ,False ,tkp ,sizeof(tkp) ,otkp,dwLen) ;
if (GetLastError() = ERROR_SUCCESS) then
begin
ExitWindowsEx(EWX_POWEROFF ,0) ; //关机
end ;
end ;
end;
***************************
模拟键盘击键
shift + 'a' 换成Delphi 就是:
keybd_event(VK_SHIFT,0,KEYEVENTF_EXTENDEDKEY + 0,0);
keybd_event(65,0,KEYEVENTF_EXTENDEDKEY + 0,0);
keybd_event(65,0,KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP,0);
keybd_event(VK_SHIFT,0,KEYEVENTF_EXTENDEDKEY + KEYEVENTF_KEYUP,0);
*****************************
弹出、关闭光驱
uses中加MMSYSTEM
弹出光驱
mciSendString('Set cdaudio door open wait', nil, 0, handle);
关闭光驱
mciSendString('Set cdaudio door closed wait', nil, 0, handle);
*******************************
防止对话框ALT+F4关闭
TForm1 = class(TForm)
...
private
procedure WMSysCommand(var Msg: TWMSysCommand); message WM_SYSCOMMAND;
...
end;
procedure TForm1.WMSysCommand(var Msg: TWMSysCommand);
begin
if Msg.CmdType <> SC_CLOSE then
inherited
end;
*********************************
调用Windows内核
对程序员而言，有一句至理名言就是：“写得好就是写得少！(Writing better is writing less)”
回答:
以下命令可以直接在Windows的运行窗口直接执行，在Delphi中你要这样使用：
winexec(Pchar('ABCD'),sw_Show);
其中"ABCD"代表以下命令之一：
"rundll32 shell32,Control_RunDLL" - 运行控制面板
"rundll32 shell32,OpenAs_RunDLL" - 打开"打开方式"窗口
"rundll32 shell32,ShellAboutA Info-Box" - 打开"关于"窗口
"rundll32 shell32,Control_RunDLL desk.cpl" - 打开"显示属性"窗口
"rundll32 user,cascadechildwindows" - 层叠全部窗口
"rundll32 user,tilechildwindows" - 最小化所有的子窗口
"rundll32 user,repaintscreen" - 刷新桌面
"rundll32 shell,shellexecute Explorer" - 重新运行Windows Explorer
"rundll32 keyboard,disable" - 锁写键盘
"rundll32 mouse,disable" - 让鼠标失效
"rundll32 user,swapmousebutton" - 交换鼠标按钮
"rundll32 user,setcursorpos" - 设置鼠标位置为(0,0)
"rundll32 user,wnetconnectdialog" - 打开"映射网络驱动器"窗口
"rundll32 user,wnetdisconnectdialog" - 打开"断开网络驱动器"窗口
"rundll32 user,disableoemlayer" - 显示BSOD窗口, (BSOD) = Blue Screen Of Death, 即蓝屏
"rundll32 diskcopy,DiskCopyRunDll" - 打开磁盘复制窗口
"rundll32 rnaui.dll,RnaWizard" - 运行"Internet连接向导", 如果加上参数"/1"则为silent模式
"rundll32 shell32,SHFormatDrive" - 打开"格式化磁盘(A)"窗口
"rundll32 shell32,SHExitWindowsEx -1" - 冷启动Windows Explorer
"rundll32 shell32,SHExitWindowsEx 1" - 关机
"rundll32 shell32,SHExitWindowsEx 0" - 退当前用户
"rundll32 shell32,SHExitWindowsEx 2" Windows9x 快速重启
"rundll32 krnl386.exe,exitkernel" - 强行退出Windows 9x(无确认)
"rundll rnaui.dll,RnaDial "MyConnect" - 运行"网络连接"对话框
"rundll32 msprint2.dll,RUNDLL_PrintTestPage" - 选择打印机和打印测试页
"rundll32 user,setcaretblinktime" - 设置光标闪烁速度
"rundll32 user, setdoubleclicktime" - 测试鼠标双击速度
"rundll32 sysdm.cpl,InstallDevice_Rundll" - 搜索非PnP设备
***********************************
messagebeep(0);//声卡发出be声
windows.beep(2000,2000);//pc喇叭发出be声，很吓人//前一个是频率，后一个是延时，98下会忽略
*******************************************************
得到可用内存和系统资源
procedure Tversion.FormCreate(Sender: TObject);
var
MS: TMemoryStatus;
begin
GlobalMemoryStatus(MS);
label5.Caption := '可用内存：'+FormatFloat('#,###" KB"', MS.dwTotalPhys / 1024);
label6.Caption := '系统资源 '+Format('%d %%', [MS.dwMemoryLoad])+' 可用';
end;
*****************************************************
检查程序是否无响映
function IsBusy(ProcessId: Integer): Integer;
var
Ph: THandle;
begin
Ph := OpenProcess(PROCESS_ALL_ACCESS, false, ProcessId);
if Ph <> 0 then
begin
if WaitForInputIdle(Ph, 10) = WAIT_TIMEOUT then
Result := 1
else
Result := 0;
CloseHandle(Ph);
end
else Result := -1;
end;
******************************
琐住鼠标 + 琐住键盘
-*******-*-*****************
var a:TRect;
temp:integer;
begin
{屏蔽系统键}
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 1, @temp, 0);
a:=rect(0,0,5,5);
{锁定鼠标在一定区域内，最好锁在你的窗口里}
ClipCursor(@a);
end;
{解除锁定}
begin
SystemParametersInfo( SPI_SCREENSAVERRUNNING, 0, @temp, 0);
ClipCursor(nil);
end;
******************************
copy屏幕
-*-*-*-*-*-*-*-*-*-*-*-*-*-*-*
procedure TForm1.Button1Click(Sender: TObject);
var
dc:hdc;
mycanvas:TCanVas;
mybitmap:TBitmap;
begin
application.Minimize;
mycanvas:=TCanvas.Create;
mybitmap:=tbitmap.Create;
dc:=getdc(0);
try
myCanvas.Handle := DC;
with Screen do
begin
MyBitmap.Width := Width;
MyBitmap.Height := Height;
MyBitmap.Canvas.CopyRect(Rect(0,0,Width,Height),myCanvas,Rect(0,0,Width,Height));
image1.Picture.Bitmap.Assign(mybitmap);
end;
finally
releasedc(0,dc);
mycanvas.Free;
mybitmap.Free;
end;
application.Restore;
end;
***************************
ACCESS技巧集
作者:ysai
转载请保持文章完整并标明出处
1.DELPHI中操作ACCESS数据库(建立.mdb文件,压缩数据库)
以下代码在WIN2K,D6,MDAC2.6下测试通过,
编译好的程序在WIN98第二版无ACCESS环境下运行成功.
//声明连接字符串
Const
SConnectionString = 'Provider=Microsoft.Jet.OLEDB.4.0;Data Source=%s;'
+'Jet OLEDB:Database Password=%s;';
//=============================================================================
// Procedure: GetTempPathFileName
// Author : ysai
// Date : 2003-01-27
// Arguments: (None)
// Result : string
//=============================================================================
function GetTempPathFileName():string;
//取得临时文件名
var
SPath,SFile:array [0..254] of char;
begin
GetTempPath(254,SPath);
GetTempFileName(SPath,'~SM',0,SFile);
result:=SFile;
DeleteFile(result);
end;
//=============================================================================
// Procedure: CreateAccessFile
// Author : ysai
// Date : 2003-01-27
// Arguments: FileName:String;PassWord:string=''
// Result : boolean
//=============================================================================
function CreateAccessFile(FileName:String;PassWord:string=''):boolean;
//建立Access文件，如果文件存在则失败
var
STempFileName:string;
vCatalog:OleVariant;
begin
STempFileName:=GetTempPathFileName;
try
vCatalog:=CreateOleObject('ADOX.Catalog');
vCatalog.Create(format(SConnectionString,[STempFileName,PassWord]));
result:=CopyFile(PChar(STempFileName),PChar(FileName),True);
DeleteFile(STempFileName);
except
result:=false;
end;
end;
//=============================================================================
// Procedure: CompactDatabase
// Author : ysai
// Date : 2003-01-27
// Arguments: AFileName,APassWord:string
// Result : boolean
//=============================================================================
function CompactDatabase(AFileName,APassWord:string):boolean;
//压缩与修复数据库,覆盖源文件
var
STempFileName:string;
vJE:OleVariant;
begin
STempFileName:=GetTempPathFileName;
try
vJE:=CreateOleObject('JRO.JetEngine');
vJE.CompactDatabase(format(SConnectionString,[AFileName,APassWord]),
format(SConnectionString,[STempFileName,APassWord]));
result:=CopyFile(PChar(STempFileName),PChar(AFileName),false);
DeleteFile(STempFileName);
except
result:=false;
end;
end;
2.ACCESS中使用SQL语句应注意的地方及几点技巧
以下SQL语句在ACCESS XP的查询中测试通过
建表:
Create Table Tab1 (
ID Counter,
Name string,
Age integer,
[Date] DateTime);
技巧:
自增字段用 Counter 声明.
字段名为关键字的字段用方括号[]括起来,数字作为字段名也可行.
建立索引:
下面的语句在Tab1的Date列上建立可重复索引
Create Index iDate ON Tab1 ([Date]);
完成后ACCESS中字段Date索引属性显示为 - 有(有重复).
下面的语句在Tab1的Name列上建立不可重复索引
Create Unique Index iName ON Tab1 (Name);
完成后ACCESS中字段Name索引属性显示为 - 有(无重复).
ACCESS与SQLSERVER中的UPDATE语句对比:
SQLSERVER中更新多表的UPDATE语句:
UPDATE Tab1
SET a.Name = b.Name
FROM Tab1 a,Tab2 b
WHERE a.ID = b.ID;
同样功能的SQL语句在ACCESS中应该是
UPDATE Tab1 a,Tab2 b
SET a.Name = b.Name
WHERE a.ID = b.ID;
即:ACCESS中的UPDATE语句没有FROM子句,所有引用的表都列在UPDATE关键字后.
上例中如果Tab2可以不是一个表,而是一个查询,例:
UPDATE Tab1 a,(Select ID,Name From Tab2) b
SET a.Name = b.Name
WHERE a.ID = b.ID;
访问多个不同的ACCESS数据库-在SQL中使用In子句:
Select a.*,b.* From Tab1 a,Tab2 b In 'db2.mdb' Where a.ID=b.ID;
上面的SQL语句查询出当前数据库中Tab1和db2.mdb(当前文件夹中)中Tab2以ID为关联的所有记录.
缺点-外部数据库不能带密码.
在ACCESS中访问其它ODBC数据源
下例在ACCESS中查询SQLSERVER中的数据
SELECT * FROM Tab1 IN [ODBC]
[ODBC;Driver=SQL Server;UID=sa;PWD=;Server=127.0.0.1;DataBase=Demo;]
外部数据源连接属性的完整参数是:
[ODBC;DRIVER=driver;SERVER=server;DATABASE=database;UID=user;PWD=password;]
其中的DRIVER=driver可以在注册表中的
HKEY_LOCAL_MACHINE\SOFTWARE\ODBC\ODBCINST.INI\
中找到
ACCESS支持子查询
ACCESS支持外连接,但不包括完整外部联接,如支持
LEFT JOIN 或 RIGHT JOIN
但不支持
FULL OUTER JOIN 或 FULL JOIN
ACCESS中的日期查询
注意:ACCESS中的日期时间分隔符是#而不是引号
Select * From Tab1 Where [Date]>#2002-1-1#;
在DELPHI中我这样用
SQL.Add(Format(
'Select * From Tab1 Where [Date]>#%s#;',
[DateToStr(Date)])); |