【分享】几个有用的Delphi函数

阿杰发表于 2009-7-26 14:37:29

<div class="tit"> </div>
<table style="TABLE-LAYOUT: fixed">
<tbody>
<tr>
<td>
<div id="blog_text" class="cnt">
1.防止刷新时闪烁的终极解决办法

<div class="cnblogs_code" twffan="done">{ 防止刷新时闪烁的终极解决办法(对付双缓冲无效时) }    Perform($000B, 0, 0); //锁屏幕   防止闪烁   // 做一些会发生严重闪烁的事情..   //解锁屏幕并重画    Perform($000B, 1, 0);    RedrawWindow(Handle, nil, 0, RDW_FRAME + RDW_INVALIDATE + RDW_ALLCHILDREN + RDW_NOINTERNALPAINT);</div>


2.图片上显示透明文字

<div class="cnblogs_code" twffan="done">//图片上显示透明的文字 //直接用.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;</div>


3.取得本机IP地址(精简版)

<div class="cnblogs_code" twffan="done">//取得本地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;</div>


4.报告内存泄漏

<div class="cnblogs_code" twffan="done">  // 在程序中加上这句，当退出时会报告内存泄漏    ReportMemoryLeaksOnShutdown := True;</div>


5.释放资源文件

<div class="cnblogs_code" twffan="done">// 首先加入.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;</div>


6.延时

<div class="cnblogs_code" twffan="done">// 模仿VB里DoEvents的延时 procedure Delay(const uDelay: DWORD); var    n: DWORD; begin    n := GetTickCount;   while ( (GetTickCount - n) <= uDelay ) do      Application.ProcessMessages; end; </div>


7.标准C中的 itoa() 函数Delphi版，将Int型变量转化为(radix)进制输出

<div class="cnblogs_code" twffan="done">//二进制    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; </div>


8.程序删除自身

<div class="cnblogs_code" twffan="done">// 利用批处理文件构造一个循环，只要在 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;</div>

9.安装服务后立即启动
普通编写的服务，安装后必须重启才能启动，这是自动启动服务的方法：
<div class="cnblogs_code" twffan="done">{   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. </div>


10.给自己编写的服务程序添加描述
没有描述的服务看起来要多可疑有多可疑，仿照微软的写法给你的服务加个描述吧：
<div class="cnblogs_code" twffan="done">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; </div>
比如伪装装成这样：Security Debug Manager (仿Security Accounts Manager) 描述：管理系统安全设置和配置，并提供调试信息。如果此服务被终止，此类型安全措施将不可用。如果此服务被禁用，任何依赖它的服务将无法启动。</div></td></tr></tbody></table>来源:<a href="http://hi.baidu.com/hacklzt/blog/item/0f784da8bf9ec9f51f17a264.html">http://hi.baidu.com/hacklzt/blog/item/0f784da8bf9ec9f51f17a264.html</a>

upring 发表于 2015-5-21 11:37:46

不好意思代码乱码了

页: [1]

紫水晶编程技术论坛 - 努力打造成全国最好的编程论坛's Archiver

【分享】几个有用的Delphi函数