怀念一下这些经常不记得的Delphi代码...
2009-03-05 22:01
344 查看
几年前混 大富翁论坛(delphibbs) 时,陆陆续续记录了很多不常用,但需要起来踏破Google、百度都找不到的技巧(Google这两年搜出来的垃圾网站越来越多...)。现在大富翁没落了,都给搬过来
![](http://www.cnblogs.com/Emoticons/QQ/lol.gif)
2009-03-17 添加两个关于系统服务的。
1.[b]防止刷新时闪烁的终极解决办法[/b]
{ 防止刷新时闪烁的终极解决办法(对付双缓冲无效时) }
Perform($000B, 0, 0); //锁屏幕 防止闪烁
// 做一些会发生严重闪烁的事情..
//解锁屏幕并重画
Perform($000B, 1, 0);
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_ALLCHILDREN + RDW_NOINTERNALPAINT);
2.图片上显示透明文字
//图片上显示透明的文字
//直接用.Canvas.Brush.Style:=bsClear;
//然后.Canvas.TextOut(x,y,'文字显示透明');
procedure TForm1.Button1Click(Sender: TObject);
var
bitBuf:TBitmap;
begin
bitBuf := TBitmap.Create;
try
bitbuf.LoadFromFile('测试图片.bmp');
Self.Canvas.Draw(0,0,bitbuf);
bitbuf.Transparent := True;
bitbuf.TransparentColor := clWhite; //文字显示透明
bitbuf.Canvas.font.color := clBlue; //文字颜色
bitbuf.Canvas.TextOut(10,10,'这样就是透明的字了!');
Self.Canvas.Draw(0,0,bitbuf);
finally
bitBuf.Free;
end;
end;
3.取得本机IP地址(精简版)
//取得本地IP地址(精简版)
//注:使用函数前需要 WSAStartup($202, wsdata);
function GetLocalIP(): String;
var
HostName: array[0..255] of Char;
HostEnt: PHostEnt;
begin
Result := '';
if gethostname(HostName, 255) = 0 then
begin
HostEnt := gethostbyname(HostName);
Result := StrPas(inet_ntoa(PInAddr(PInAddr(HostEnt^.h_addr_list)^)^));
end;
end;
4.报告内存泄漏
// 在程序中加上这句,当退出时会报告内存泄漏
ReportMemoryLeaksOnShutdown := True;
5.释放资源文件
// 首先加入.RC文件,写上 MyDLL DAT testDLL.dll
// 然后程序里 ExtractRes('DAT','MyDLL','123DLL.dll');
procedure ExtractRes(ResType, ResName, ResNewName:String);
var Res:TResourceStream;
begin
Res:=TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile('.\'+ResNewName); // 释放到当前目录
finally
Res.Free;
end;
end;
6.[b]延时[/b]
// 模仿VB里DoEvents的延时
procedure Delay(const uDelay: DWORD);
var
n: DWORD;
begin
n := GetTickCount;
while ( (GetTickCount - n) <= uDelay ) do
Application.ProcessMessages;
end;
7.标准C中的 itoa() 函数Delphi版,将Int型变量转化为(radix)进制输出
//二进制 itoa(i, 2);
//八进制 itoa(i, 8);
//十六进制 itoa(i, 16);
function itoa(aData, radix: Integer): String;
var
t: Integer;
begin
Result := '';
repeat
t := aData mod radix;
if t < 10 then
Result := InttoStr(t)+Result
else
Result := InttoHex(t, 1)+Result;
aData := aData div radix;
until (aData = 0);
end;
8.程序删除自身
// 利用批处理文件构造一个循环,只要在 OnClose() 中调用 DeleteMe() 就可以删除自身
procedure DeleteMe();
var
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
BatchFileName := ExtractFilePath(ParamStr(0)) + '_deleteme.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, ':try');
Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
Writeln(BatchFile,
'if exist "' + ParamStr(0) + '"' + ' goto try');
Writeln(BatchFile, 'del %0');
CloseFile(BatchFile);
FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end;
9.安装服务后立即启动
普通编写的服务,安装后必须重启才能启动,这是自动启动服务的方法:
{ Automatically start a service after using /Install or /Uniinstall switch
In the service unit add these statements before the 'end.' statement.
To automatically start or stop the service during install or uninstall
Tested only on Win2k and WinXP
Change the 'myservice' in both WinExec statements to your own service name.
}
// 在Service的初始化和结束部分加入如下代码:
initialization
if (ParamCount >= 1) and (CompareText('/uninstall',ParamStr(1))=0) then
begin
// 如果是卸载,先停止服务。注意修改 myservice 为你的服务名
WinExec('cmd.exe /c net stop myservice', sw_hide);
sleep(3000);
end;
finalization
if (ParamCount >= 1) and (CompareText('/Install',ParamStr(1))=0) then
// 用 net start 执行服务
WinExec('cmd.exe /c net start myservice',sw_hide);
end.
10.给自己编写的服务程序添加描述
没有描述的服务看起来要多可疑有多可疑,仿照微软的写法给你的服务加个描述吧:
procedure TMyService1.ServiceAfterInstall(Sender: TService);
var
MyReg: TRegistry;
begin
MyReg := TRegistry.Create;
try
with MyReg do
begin
RootKey := HKEY_LOCAL_MACHINE;
{ Service1是服务的名字,注意修改成你自己的 }
if Openkey('SYSTEM\CurrentControlSet\Services\Service1', true) then
WriteString('Description', '你自己的服务描述...');
CloseKey;
end;
finally
MyReg.Free;
end;
end;
比如伪装装成这样:Security Debug Manager (仿Security Accounts Manager)
描述:管理系统安全设置和配置,并提供调试信息。如果此服务被终止,此类型安全措施将不可用。如果此服务被禁用,任何依赖它的服务将无法启动。
![](http://www.cnblogs.com/Emoticons/QQ/lol.gif)
2009-03-17 添加两个关于系统服务的。
1.[b]防止刷新时闪烁的终极解决办法[/b]
{ 防止刷新时闪烁的终极解决办法(对付双缓冲无效时) }
Perform($000B, 0, 0); //锁屏幕 防止闪烁
// 做一些会发生严重闪烁的事情..
//解锁屏幕并重画
Perform($000B, 1, 0);
RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_ALLCHILDREN + RDW_NOINTERNALPAINT);
2.图片上显示透明文字
//图片上显示透明的文字
//直接用.Canvas.Brush.Style:=bsClear;
//然后.Canvas.TextOut(x,y,'文字显示透明');
procedure TForm1.Button1Click(Sender: TObject);
var
bitBuf:TBitmap;
begin
bitBuf := TBitmap.Create;
try
bitbuf.LoadFromFile('测试图片.bmp');
Self.Canvas.Draw(0,0,bitbuf);
bitbuf.Transparent := True;
bitbuf.TransparentColor := clWhite; //文字显示透明
bitbuf.Canvas.font.color := clBlue; //文字颜色
bitbuf.Canvas.TextOut(10,10,'这样就是透明的字了!');
Self.Canvas.Draw(0,0,bitbuf);
finally
bitBuf.Free;
end;
end;
3.取得本机IP地址(精简版)
//取得本地IP地址(精简版)
//注:使用函数前需要 WSAStartup($202, wsdata);
function GetLocalIP(): String;
var
HostName: array[0..255] of Char;
HostEnt: PHostEnt;
begin
Result := '';
if gethostname(HostName, 255) = 0 then
begin
HostEnt := gethostbyname(HostName);
Result := StrPas(inet_ntoa(PInAddr(PInAddr(HostEnt^.h_addr_list)^)^));
end;
end;
4.报告内存泄漏
// 在程序中加上这句,当退出时会报告内存泄漏
ReportMemoryLeaksOnShutdown := True;
5.释放资源文件
// 首先加入.RC文件,写上 MyDLL DAT testDLL.dll
// 然后程序里 ExtractRes('DAT','MyDLL','123DLL.dll');
procedure ExtractRes(ResType, ResName, ResNewName:String);
var Res:TResourceStream;
begin
Res:=TResourceStream.Create(Hinstance, Resname, Pchar(ResType));
try
Res.SavetoFile('.\'+ResNewName); // 释放到当前目录
finally
Res.Free;
end;
end;
6.[b]延时[/b]
// 模仿VB里DoEvents的延时
procedure Delay(const uDelay: DWORD);
var
n: DWORD;
begin
n := GetTickCount;
while ( (GetTickCount - n) <= uDelay ) do
Application.ProcessMessages;
end;
7.标准C中的 itoa() 函数Delphi版,将Int型变量转化为(radix)进制输出
//二进制 itoa(i, 2);
//八进制 itoa(i, 8);
//十六进制 itoa(i, 16);
function itoa(aData, radix: Integer): String;
var
t: Integer;
begin
Result := '';
repeat
t := aData mod radix;
if t < 10 then
Result := InttoStr(t)+Result
else
Result := InttoHex(t, 1)+Result;
aData := aData div radix;
until (aData = 0);
end;
8.程序删除自身
// 利用批处理文件构造一个循环,只要在 OnClose() 中调用 DeleteMe() 就可以删除自身
procedure DeleteMe();
var
BatchFile: TextFile;
BatchFileName: string;
ProcessInfo: TProcessInformation;
StartUpInfo: TStartupInfo;
begin
BatchFileName := ExtractFilePath(ParamStr(0)) + '_deleteme.bat';
AssignFile(BatchFile, BatchFileName);
Rewrite(BatchFile);
Writeln(BatchFile, ':try');
Writeln(BatchFile, 'del "' + ParamStr(0) + '"');
Writeln(BatchFile,
'if exist "' + ParamStr(0) + '"' + ' goto try');
Writeln(BatchFile, 'del %0');
CloseFile(BatchFile);
FillChar(StartUpInfo, SizeOf(StartUpInfo), $00);
StartUpInfo.dwFlags := STARTF_USESHOWWINDOW;
StartUpInfo.wShowWindow := SW_HIDE;
if CreateProcess(nil, PChar(BatchFileName), nil, nil, False, IDLE_PRIORITY_CLASS, nil, nil, StartUpInfo, ProcessInfo) then
begin
CloseHandle(ProcessInfo.hThread);
CloseHandle(ProcessInfo.hProcess);
end;
end;
9.安装服务后立即启动
普通编写的服务,安装后必须重启才能启动,这是自动启动服务的方法:
{ Automatically start a service after using /Install or /Uniinstall switch
In the service unit add these statements before the 'end.' statement.
To automatically start or stop the service during install or uninstall
Tested only on Win2k and WinXP
Change the 'myservice' in both WinExec statements to your own service name.
}
// 在Service的初始化和结束部分加入如下代码:
initialization
if (ParamCount >= 1) and (CompareText('/uninstall',ParamStr(1))=0) then
begin
// 如果是卸载,先停止服务。注意修改 myservice 为你的服务名
WinExec('cmd.exe /c net stop myservice', sw_hide);
sleep(3000);
end;
finalization
if (ParamCount >= 1) and (CompareText('/Install',ParamStr(1))=0) then
// 用 net start 执行服务
WinExec('cmd.exe /c net start myservice',sw_hide);
end.
10.给自己编写的服务程序添加描述
没有描述的服务看起来要多可疑有多可疑,仿照微软的写法给你的服务加个描述吧:
procedure TMyService1.ServiceAfterInstall(Sender: TService);
var
MyReg: TRegistry;
begin
MyReg := TRegistry.Create;
try
with MyReg do
begin
RootKey := HKEY_LOCAL_MACHINE;
{ Service1是服务的名字,注意修改成你自己的 }
if Openkey('SYSTEM\CurrentControlSet\Services\Service1', true) then
WriteString('Description', '你自己的服务描述...');
CloseKey;
end;
finally
MyReg.Free;
end;
end;
比如伪装装成这样:Security Debug Manager (仿Security Accounts Manager)
描述:管理系统安全设置和配置,并提供调试信息。如果此服务被终止,此类型安全措施将不可用。如果此服务被禁用,任何依赖它的服务将无法启动。
相关文章推荐
- 怀念一下这些经常不记得的Delphi代码...
- 怀念一下这些经常不记得的Delphi代码
- 有没有大神能够逐行解释一下代码?Delphi
- 本人在代码中经常使用到两种控件 highchart 和highstock。现在分享一下两种控件互换方法
- 有没有大神能够逐行解释一下代码?Delphi
- java servlet 几种页面跳转的方法,需要的朋友可以参考一下 在访问网页的过程中,页面自动刷新、跳转和重定向是经常用到的,这里就说说在Java中是如何实现这些功能的! 一、页面自动刷新
- c语言编写的2048游戏代码,大家可以参考一下这些
- delphi的文件夹监控控件,直接封装成可视化的控件,拖一下即可代码。核心为:ReadDirectoryChangesW
- 有没有大神能够逐行解释一下代码?Delphi
- Delphi 程序经常用到的公共代码 Tools.pas
- 黑马程序员-多线程-在android开发中经常会遇到从子线程切换到主线程,但是频繁地切换会使代码变得很臃肿,也不好维护,想请教一下各位大牛都是怎么处理的?
- C++类中各种不同类型成员根据是否static 、是否const类型的初始化方法不尽相同,写代码时经常搞乱,网上搜了一下资料,全部总结一下。一、例子 [cpp] view plaincopy ---
- 有没有大神能够逐行解释一下代码?Delphi
- 研究一下FBrush,它是从TWinControl才有的属性(可能是因为需要句柄)——发现{$R *.dfm}在运行期执行,而且很有深意,读到属性后赋值还会触发事件,这些无法在VCL代码里直接看到
- 25个强大的CSS代码,据说这些是开发者经常遇到比较棘手的代码
- 有没有大神能够逐行解释一下代码?Delphi
- 离职前记得上传这些代码
- 收藏的25个非常有用的CSS代码片段,在你开发基于CSS的网站时,这些代码是经常用到的,比方说一些特殊的效果,圆角边框,CSS透明度,梯形环绕,CSS小三角等,希望对你有用
- 实际应用中经常用的代码片段,但是没有必要记住的
- 安装Oracle后,经常使用的修改表空间的SQL代码