怀念一下这些经常不记得的Delphi代码...

原作者: [db:作者] 来自: [db:来源] 收藏邀请

几年前混大富翁论坛(delphibbs) 时，陆陆续续记录了很多不常用，但需要起来踏破Google、百度都找不到的技巧（Google这两年搜出来的垃圾网站越来越多...）。现在大富翁没落了，都给搬过来

2009-03-17 添加两个关于系统服务的。

1.防止刷新时闪烁的终极解决办法

{ 防止刷新时闪烁的终极解决办法(对付双缓冲无效时) }
  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.延时

// 模仿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)
描述：管理系统安全设置和配置，并提供调试信息。如果此服务被终止，此类型安全措施将不可用。如果此服务被禁用，任何依赖它的服务将无法启动。

鲜花

握手

雷人

路过

鸡蛋

该文章已有0人参与评论

请发表评论

全部评论

专题导读

More+

10-27 六六分期app的软件客服如何联系？(六六分期

11-06 可心卡盟:win10系统火狐flash插件崩溃怎么

11-06 亲亲特价:怎么删除回收站图标

11-06 济南大学虚拟社区:鲁大师节能降温的具体办

11-06 xlueops.exe:无线网络安装向导

11-06 女斗合众国:win7系统cf与主机连接不稳定怎

11-06 0xc000022-[cf烟雾头]cf怎么调烟雾头

11-06 qizideyouhuo:应用程序无法正常启动0xc0000

11-06 ipz-185:win7系统vcf文件怎么打开

11-06 傻哥蹦迪:win10系统s4怎么打开usb调试

11-06 八神浩树gtaste:回收站清空了怎么恢复

11-06 妖尾之黑色守护:win10系统电脑没有1440x900

11-06 校园至尊魔王小说:win7系统浏览网页时字体

11-06 女斗合众国:win10系统访问共享文件夹提示请

11-06 tokyo hot n0654:恢复win7系统默认字体一招

11-06 雨酷仙境:设置win7系统转移临时文件夹腾出

11-06 阿穆纳伊之杖:win7系统开始菜单在右边还原

11-06 tunespotting:win10系统火狐flash插件总是

11-06 甘尔葛分析师：计谋网站seo关键词暴涨有什

11-06 蔡贵霖: 计谋网站seo关键词暴涨有什么秘密

11-06 博益网首页:ao3网页版进入不了解决方法

11-06 漏斗子专栏: 网站数据分析小白易懂精华篇

11-06 见证双虹怎么做:win7系统开启telnet命令的

11-06 颾狐蝶蜋:系统资源不足无法完成请求的服务

11-06 国光中学校歌:提交网站到alexa查询详细步骤

11-06 西安有情天:静态网页和动态网页的区别

11-06 红木雅尚斋:外部链接构造对网站的好处

11-06 前官礼遇：防止域名劫持–增强域安全性的10

11-06 密传二转答案: 中文分词算法有哪些

11-06 金泉家园邮编:百度快照劫持的表现及应对方

ubuntu16.04安装matlab_R2018a/R2017a发布时间：2022-07-18

Java中调用Matlab方法计算数值，以解二维标准正态分布累计函数为例 ...发布时间：2022-07-18

剪的笔顺,诠释剪的笔画,认识剪的部首

1 六六分期app的软件客服如何联系？(六六分期

六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期

阅读：9105|2023-10-27

2 可心卡盟:win10系统火狐flash插件崩溃怎么

今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知

阅读：6558|2022-11-06

3 亲亲特价:怎么删除回收站图标

今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道

阅读：5452|2022-11-06

4 济南大学虚拟社区:鲁大师节能降温的具体办

今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要

阅读：5930|2022-11-06

5 xlueops.exe:无线网络安装向导

我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多

阅读：5806|2022-11-06

6 女斗合众国:win7系统cf与主机连接不稳定怎

今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不

阅读：6189|2022-11-06

7 0xc000022-[cf烟雾头]cf怎么调烟雾头

电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很

阅读：5765|2022-11-06

8 qizideyouhuo:应用程序无法正常启动0xc0000

我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法

阅读：5235|2022-11-06

9 ipz-185:win7系统vcf文件怎么打开

今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win

阅读：5594|2022-11-06

10 傻哥蹦迪:win10系统s4怎么打开usb调试

今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎

阅读：4955|2022-11-06

客服电话

电子邮件

怀念一下这些经常不记得的Delphi代码...

请发表评论

全部评论

上一篇：

下一篇：

solegalli/feature-selection-for-machine-

CVE-2022-35416

tianli/matlab_offscreen: Matlab offscree

win7系统重装系统初始设置的操作方法

clipperz/javascript-crypto-library: The

剪的笔顺,诠释剪的笔画,认识剪的部首

florent37/ViewAnimator: A fluent Android

florent37/Shrine-MaterialDesign2: implem

CVE-2020-36276

六六分期app的软件客服如何联系？(六六分期

doraiso/Mastodon

关于我们

产品与服务

解决方案

139-2527-9053