随笔-88  评论-52  文章-0  trackbacks-1
  2012年5月31日
用hook实现dll注入详解

该日志由 傻猫 发表于 2010-07-21 13:00:31

需要一个用来注入的dll（inject.dll）及一个调用程序(caller.exe)
流程：
 
caller.exe
procedure TestHook;
var pwnd,hChild, hwndInject :hwnd;
    msg:tmsg;
begin
   //通过窗口标题用FindWindow找到要注入的程序的主窗口句柄pwnd
   pwnd := findwindow('Progman',nil);
   //用FindwindowEx(hMain,0,nil,nil)找到要处理的子窗口句柄hChild
   hChild := findWindowEx(pwnd,0,nil,nil);
   //用getwindowThreadProcessid(hChild,nil)找到要注入的线程
   dwThreadID := getwindowThreadProcessid(hChild,nil);
   //调用 inject.dll的SetInjectHook方法
   SetInjectHook(dwThreadID);
   //等待消息返回


   getmessage(msg,0,0,0);
   //找到注入的窗口
   hwndInject:= findwindow(nil,'InjectForm');
   //发送控制消息,将目标窗体的句柄作为wparam，控制参数以lparam传入
   sendMessage( hwndInject, wm_app,hChild,integer(true));
   //关闭注入的窗口
   sendMessage( hwndInject,wm_close,0,0);
   //等待窗口关闭
   sleep(500);
   //检查是否成功关闭
   assert(not iswindow( hwndInject));
   //去掉挂钩
   setDipsHook(0);
end;  

//下面说明 Inject.dll的SetInjectHook的具体操作
在全局定义以下变量
 var
   g_hhook :Hhook=0;
   g_dwThreadidInject :dword=0;
   g_hInjectfrm:hwnd;


function SetInjectHook(dwThreadid:DWORD):boolean;
begin
  result := false;
  //如果线程标志为0则用于去掉钩子，否则进行动态库注入
  if dwThreadid<>0 then
  begin
    assert(g_hhook=0);
    //保存当前线程的ID到 g_dwThreadidInject
    g_dwThreadidInject := getCurrentThreadid;
    //下一个GetMessage的钩子到目标线程
    //GetMsgProc是在下面定义的一个函数，在第一次调用时将自定义的form在目标线程中创建出来
    //这样就能通过这个自定义的form对目标线程进行进程内控制了
    g_hhook := setWindowsHookEx(wh_getMessage,GetMsgProc,hInstance,dwThreadid);
    result := g_hhook <> null;
    if result then
      //发一个空的信息以便于立即创建这个自定义form
      result := postThreadMessage(dwThreadid, wm_Null,0,0);
    //等待半秒钟，以保证调用者可以找到这个刚创建的form
    sleep(500);
  end else
  begin
    assert(g_hhook<>0);
    //去掉钩子
    result := unHookWindowsHookEx(g_hhook);
    g_Hhook := 0;
  end;
end;

//定义一个全局的是否第一个消息的标志
var
  fFirstTime:boolean = true;
//这个函数用于在收到第一个消息时创建自定义窗体，以便于远程控制
function GetMsgProc(code: Integer; wparam: WPARAM; lparam: LPARAM): LRESULT; stdcall;
begin
  //如果是第一次
  if fFirstTime then
  begin
    fFirstTime := false;
    //创建窗体
    InjectFrm := TinjectFrm.create(nil);
    //保存窗体句柄
    g_hInjectfrm := InjectFrm.handle;
  end;
  //调用默认处理，这一句可不能忘记
  result := callNexthookEx(g_hhook,code,wparam,lparam);
end;

 

posted @ 2012-05-31 21:52 为人民服务 阅读(2) 评论(0) 编辑
技巧

keybd_event模拟键盘输入密码

该日志由 傻猫 发表于 2011-01-23 13:25:34

 

function TFrm_main.InputChar(str: string): Boolean;

var

 i     : integer;

 c     : byte;

begin

      for i := 1 to Length(str) do

      begin

       c := VkKeyScan(str[i]) and 255;                //输入文字

       keybd_event(c,0,0,0);

       keybd_event(c,0,KEYEVENTF_KEYUP,0);

      end;

end;

 

 

Delphi统计字数（汉字+字母+符号）

该日志由 傻猫 发表于 2011-01-07 22:03:03

 

根据asc码分别进行统计，看有多少字母和符号，汉字分开统计，一个汉字算计数1

 

function TFrm_main.MsgCounter(str: string): string;

var

 s:string;  //保存字符串

 i,e,c:integer;//保存变量

begin

 s:=str;

 e:=0;c:=0;

 for i:=1 to length(s) do

 begin

    if (ord(s[i])>=33)and(ord(s[i])<=126) then

    //判断字符的顺序号

      begin

        inc(e);

      end

    else

    if (ord(s[i])>=127) then

    //判断字符的顺序号

      begin

        inc(c);

      end;

 end; 

 

 Result:=IntToStr(e+(c div 2));

end;

 

文章来源于《傻猫网络日志》 http://www.samool.com/category/Delphi/2/

 

//模拟ctrl+回车
keybd_event(VK_CONTROL,   0,   0,   0);
keybd_event(VK_RETURN,   0,   0,   0);
keybd_event(VK_RETURN,   0,   KEYEVENTF_KEYUP,   0);
keybd_event(VK_CONTROL,   0,   KEYEVENTF_KEYUP,   0);

{ Virtual Keys, Standard Set }
  {$EXTERNALSYM VK_LBUTTON}
  VK_LBUTTON = 1;
  {$EXTERNALSYM VK_RBUTTON}
  VK_RBUTTON = 2;
  {$EXTERNALSYM VK_CANCEL}
  VK_CANCEL = 3;
  {$EXTERNALSYM VK_MBUTTON}
  VK_MBUTTON = 4;  { NOT contiguous with L & RBUTTON }
  {$EXTERNALSYM VK_BACK}
  VK_BACK = 8;
  {$EXTERNALSYM VK_TAB}
  VK_TAB = 9;
  {$EXTERNALSYM VK_CLEAR}
  VK_CLEAR = 12;
  {$EXTERNALSYM VK_RETURN}
  VK_RETURN = 13;
  {$EXTERNALSYM VK_SHIFT}
  VK_SHIFT = $10;
  {$EXTERNALSYM VK_CONTROL}
  VK_CONTROL = 17;
  {$EXTERNALSYM VK_MENU}
  VK_MENU = 18;
  {$EXTERNALSYM VK_PAUSE}
  VK_PAUSE = 19;
  {$EXTERNALSYM VK_CAPITAL}
  VK_CAPITAL = 20;
  {$EXTERNALSYM VK_KANA }
  VK_KANA = 21;
  {$EXTERNALSYM VK_HANGUL }
  VK_HANGUL = 21;
  {$EXTERNALSYM VK_JUNJA }
  VK_JUNJA = 23;
  {$EXTERNALSYM VK_FINAL }
  VK_FINAL = 24;
  {$EXTERNALSYM VK_HANJA }
  VK_HANJA = 25;
  {$EXTERNALSYM VK_KANJI }
  VK_KANJI = 25;
  {$EXTERNALSYM VK_CONVERT }
  VK_CONVERT = 28;
  {$EXTERNALSYM VK_NONCONVERT }
  VK_NONCONVERT = 29;
  {$EXTERNALSYM VK_ACCEPT }
  VK_ACCEPT = 30;
  {$EXTERNALSYM VK_MODECHANGE }
  VK_MODECHANGE = 31;
  {$EXTERNALSYM VK_ESCAPE}
  VK_ESCAPE = 27;
  {$EXTERNALSYM VK_SPACE}
  VK_SPACE = $20;
  {$EXTERNALSYM VK_PRIOR}
  VK_PRIOR = 33;
  {$EXTERNALSYM VK_NEXT}
  VK_NEXT = 34;
  {$EXTERNALSYM VK_END}
  VK_END = 35;
  {$EXTERNALSYM VK_HOME}
  VK_HOME = 36;
  {$EXTERNALSYM VK_LEFT}
  VK_LEFT = 37;
  {$EXTERNALSYM VK_UP}
  VK_UP = 38;
  {$EXTERNALSYM VK_RIGHT}
  VK_RIGHT = 39;
  {$EXTERNALSYM VK_DOWN}
  VK_DOWN = 40;
  {$EXTERNALSYM VK_SELECT}
  VK_SELECT = 41;
  {$EXTERNALSYM VK_PRINT}
  VK_PRINT = 42;
  {$EXTERNALSYM VK_EXECUTE}
  VK_EXECUTE = 43;
  {$EXTERNALSYM VK_SNAPSHOT}
  VK_SNAPSHOT = 44;
  {$EXTERNALSYM VK_INSERT}
  VK_INSERT = 45;
  {$EXTERNALSYM VK_DELETE}
  VK_DELETE = 46;
  {$EXTERNALSYM VK_HELP}
  VK_HELP = 47;
{ VK_0 thru VK_9 are the same as ASCII '0' thru '9' ($30 - $39) }
{ VK_A thru VK_Z are the same as ASCII 'A' thru 'Z' ($41 - $5A) }
  {$EXTERNALSYM VK_LWIN}
  VK_LWIN = 91;
  {$EXTERNALSYM VK_RWIN}
  VK_RWIN = 92;
  {$EXTERNALSYM VK_APPS}
  VK_APPS = 93;
  {$EXTERNALSYM VK_NUMPAD0}
  VK_NUMPAD0 = 96;
  {$EXTERNALSYM VK_NUMPAD1}
  VK_NUMPAD1 = 97;
  {$EXTERNALSYM VK_NUMPAD2}
  VK_NUMPAD2 = 98;
  {$EXTERNALSYM VK_NUMPAD3}
  VK_NUMPAD3 = 99;
  {$EXTERNALSYM VK_NUMPAD4}
  VK_NUMPAD4 = 100;
  {$EXTERNALSYM VK_NUMPAD5}
  VK_NUMPAD5 = 101;
  {$EXTERNALSYM VK_NUMPAD6}
  VK_NUMPAD6 = 102;
  {$EXTERNALSYM VK_NUMPAD7}
  VK_NUMPAD7 = 103;
  {$EXTERNALSYM VK_NUMPAD8}
  VK_NUMPAD8 = 104;
  {$EXTERNALSYM VK_NUMPAD9}
  VK_NUMPAD9 = 105;
  {$EXTERNALSYM VK_MULTIPLY}
  VK_MULTIPLY = 106;
  {$EXTERNALSYM VK_ADD}
  VK_ADD = 107;
  {$EXTERNALSYM VK_SEPARATOR}
  VK_SEPARATOR = 108;
  {$EXTERNALSYM VK_SUBTRACT}
  VK_SUBTRACT = 109;
  {$EXTERNALSYM VK_DECIMAL}
  VK_DECIMAL = 110;
  {$EXTERNALSYM VK_DIVIDE}
  VK_DIVIDE = 111;
  {$EXTERNALSYM VK_F1}
  VK_F1 = 112;
  {$EXTERNALSYM VK_F2}
  VK_F2 = 113;
  {$EXTERNALSYM VK_F3}
  VK_F3 = 114;
  {$EXTERNALSYM VK_F4}
  VK_F4 = 115;
  {$EXTERNALSYM VK_F5}
  VK_F5 = 116;
  {$EXTERNALSYM VK_F6}
  VK_F6 = 117;
  {$EXTERNALSYM VK_F7}
  VK_F7 = 118;
  {$EXTERNALSYM VK_F8}
  VK_F8 = 119;
  {$EXTERNALSYM VK_F9}
  VK_F9 = 120;
  {$EXTERNALSYM VK_F10}
  VK_F10 = 121;
  {$EXTERNALSYM VK_F11}
  VK_F11 = 122;
  {$EXTERNALSYM VK_F12}
  VK_F12 = 123;
  {$EXTERNALSYM VK_F13}
  VK_F13 = 124;
  {$EXTERNALSYM VK_F14}
  VK_F14 = 125;
  {$EXTERNALSYM VK_F15}
  VK_F15 = 126;
  {$EXTERNALSYM VK_F16}
  VK_F16 = 127;
  {$EXTERNALSYM VK_F17}
  VK_F17 = 128;
  {$EXTERNALSYM VK_F18}
  VK_F18 = 129;
  {$EXTERNALSYM VK_F19}
  VK_F19 = 130;
  {$EXTERNALSYM VK_F20}
  VK_F20 = 131;
  {$EXTERNALSYM VK_F21}
  VK_F21 = 132;
  {$EXTERNALSYM VK_F22}
  VK_F22 = 133;
  {$EXTERNALSYM VK_F23}
  VK_F23 = 134;
  {$EXTERNALSYM VK_F24}
  VK_F24 = 135;
  {$EXTERNALSYM VK_NUMLOCK}
  VK_NUMLOCK = 144;
  {$EXTERNALSYM VK_SCROLL}
  VK_SCROLL = 145;
{ VK_L & VK_R - left and right Alt, Ctrl and Shift virtual keys.
  Used only as parameters to GetAsyncKeyState() and GetKeyState().
  No other API or message will distinguish left and right keys in this way. }
  {$EXTERNALSYM VK_LSHIFT}
  VK_LSHIFT = 160;
  {$EXTERNALSYM VK_RSHIFT}
  VK_RSHIFT = 161;
  {$EXTERNALSYM VK_LCONTROL}
  VK_LCONTROL = 162;
  {$EXTERNALSYM VK_RCONTROL}
  VK_RCONTROL = 163;
  {$EXTERNALSYM VK_LMENU}
  VK_LMENU = 164;
  {$EXTERNALSYM VK_RMENU}
  VK_RMENU = 165;
  {$EXTERNALSYM VK_PROCESSKEY}
  VK_PROCESSKEY = 229;
  {$EXTERNALSYM VK_ATTN}
  VK_ATTN = 246;
  {$EXTERNALSYM VK_CRSEL}
  VK_CRSEL = 247;
  {$EXTERNALSYM VK_EXSEL}
  VK_EXSEL = 248;
  {$EXTERNALSYM VK_EREOF}
  VK_EREOF = 249;
  {$EXTERNALSYM VK_PLAY}
  VK_PLAY = 250;
  {$EXTERNALSYM VK_ZOOM}
  VK_ZOOM = 251;
  {$EXTERNALSYM VK_NONAME}
  VK_NONAME = 252;
  {$EXTERNALSYM VK_PA1}
  VK_PA1 = 253;
  {$EXTERNALSYM VK_OEM_CLEAR}
  VK_OEM_CLEAR = 254;

posted @ 2012-05-31 21:50 为人民服务 阅读(3) 评论(0) 编辑
  2012年3月15日
把EXE可执行文件等作为资源包含在Delphi编译文件中

摘自我自己过去写的一段心得。

1.编辑资源文件 *.RC
Wave： 资源文件是声音文件；
RCDATA： 二进制数据
AVI： AVI动画；
ICON： 图标文件；
BITMAP： 位图文件；
CURSOR： 光标文件；
比如:
MyWav WAVE "FileName.Wav"

2.使用Brcc32转化为*.RES文件

3.在工程中引用RES文件
比如:{$R MyRes.RES}

4.运行时读入
    通过TResourceStream ,比如TResourceStream.Create(HInstance, ResName, RT_RCDATA);
    API:LoadBitmap,LoadIcon等
    组件:Image1.Picture.Bitmap.LoadFromResourceName
/////////////////////////////////////////////////////////
把EXE可执行文件等作为资源包含在Delphi编译文件中2010/01/18 8:29 P.M.感觉还是挺有用的，转载保存了~~~  

建立文本文件       TEST.RC       撰写下面的一行  
   
     AEXE     EXEFILE     c:\test.exe  
   
     存盘  
   
     copy     test.rc     到你DELPHI目录里的     bin     目录  
   
     执行     brcc32     test.rc  
     得到     test.res  
   
     copy     test.res     到你的工程目录  
   
     记得在工程文件里加上     {$R     test.res}  
   
     提取RES中的TEST.EXE的函数  
   
     procedure     extractexeres(restype,     resname,     resnewname:string);  
     var    
         res:tresourcestream;    
     begin  
         res:=tresourcestream.create(hinstance,resname,pchar(resyype));  
         res.savetofile(resnewname);  
         res.free;    
     end;  

建立文本文件       myjpg.RC       撰写下面的一行  
   
     Hash     JPGFILE     c:\myjpg.jpg  
   
     存盘  
   
     copy     myjpg.rc     到你DELPHI目录里的     bin     目录  
   
     执行     brcc32     myjpg.rc  
     得到     myjpg.res  
   
     copy     myjpg.res     到你的工程目录  
   
     记得在工程文件里加上     {$R     myjpg.res}  
   
     提取RES中的MYJPG.jpg的函数  
   
     procedure     extractexeres(resname,     restype,     resnewname:string);  
     var    
         res:Tresourcestream;    
     begin  
         res:=Tresourcestream.create(hinstance,resname,pchar(restype));  
         res.savetofile(resnewname);  
         res.free;    
     end;  
     //这样你就可以调用resnewname这个     jpg文件了。  
     调用的时候如下：  
     Extractexeres('Hash','JPGFILE','f:\myjpg.jpg');

换一种说法：

1、生成一个rc文件，文件格式如下：
     rwww exefile "test.exe"     //rwww是资源名称
                               //exefile是资源类型
                             //text.exe是资源
   资源类型列表：
   Wave：     资源文件是声音文件； 
   RCDATA：     一般二进制文件； 
   AVI：     AVI动画； 
   ICON：     图标文件；   
   BITMAP：     位图文件；   
   CURSOR：     光标文件；
   exefile:   exe文件
   FILE:     一般文件  


2、将delphi安装目录下bin中的brcc32.exe文件拷出，用brcc32.exe执行
     生成的rc文件，在dos窗口下 运行：brcc32 test.rc   生成正式的
     后缀为.res的次源文件

3、在delphi中加入编译指令{$R test.res}用以编译。但注意，以上的test.exe文件
     一定要在当前路径下存在。

4、调用：

       var
         t : TResourceStream;
       begin
         try
           t := TResourceStream.Create(HInstance,'rwww','exefile'); //其中HInstance为一个句柄常量；rwww为资源名；exefile为资源类型
           t.SaveToFile('c:\2.exe'); //保存文件成2.exe
         finally

           t.free;
         end;
       end;
///////////////////////////////////////////////////////////
编辑一个 resource.rc 文件 ,里面类似如下 :

  hookdll RC_Dll YourHookDllFileName.Dll

2: 然后用 Brcc32.exe 编译 :

  brcc32 resource.rc

  结果生成 resource.res 文件

3: 修改窗体 Pas 或者 Dpr 文件 ,添加下面的代码 :

  {$R *.res}

  {$R resource.res}

4: 关键的代码 :

   在窗体初始化或者工程的开头部分添加代码 :

  var

   res:tresourcestream;

   ....

   res:=tresourcestream.create(instance,'hookdll','RC_Dll');

   res.SaveToFile('YourHookDllFileName.Dll');

   res.Free;

5: 你的程序退出的时候 :

   DeleteFile('YourHookDllFile.Dll');

6:End

posted @ 2012-03-15 12:48 为人民服务 阅读(64) 评论(0) 编辑
  2012年3月13日
Delphi压缩图片代码

网上的都少了这两句

bmp:=TBitmap.create;        //先建立后才能用
      jpg:= TJpegImage.create;

///////////////////////////////////////////////

 

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls,jpeg;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}
  //uses JPEG;

//=====================图片处理函数，将覆盖原图片文件===========================
//=====filename:图片完整路径  PressQuality:压缩质量 Width:宽  Height:高
function CompressMainFun(filename: String; PressQuality,Width,Height:integer): Boolean;
var
  bmp: TBitmap;
  jpg: TJpegImage;
  i: Integer;
  sTemp:string;
begin
  Result := False;
     bmp:=TBitmap.create;        //先建立后才能用
      jpg:= TJpegImage.create;   //先建立后才能用
    if pos(UpperCase('.bmp'), UpperCase(filename)) <> 0 then   //bmp格式
    begin
      bmp.LoadFromFile(filename);
      jpg.Assign(bmp);
      jpg.CompressionQuality := PressQuality;
      jpg.Compress;
      bmp.height := Height;
      bmp.Width := Width;
      bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);
      jpg.Assign(bmp);
      sTemp := filename + '.jpg';
      jpg.SaveToFile(sTemp);
     // DeleteFile(filename);                     这三句如使用可达到覆盖原文件的效果
      //CopyFile(PChar(sTemp), PChar(filename), True);
     // DeleteFile(sTemp);
    end
    else                                                     //其它格式
    begin

      jpg.LoadFromFile(filename);
      bmp.height := Height;
      bmp.Width := Width;
      bmp.Canvas.StretchDraw(bmp.Canvas.ClipRect, jpg);
      jpg.Assign(bmp);
      jpg.CompressionQuality := PressQuality;
      jpg.Compress;
      sTemp := filename + '.jpg';
      jpg.SaveToFile(sTemp);
     // DeleteFile(filename);                          这三句如使用可达到覆盖原文件的效果
     // CopyFile(PChar(sTemp), PChar(filename), True);
     // DeleteFile(sTemp);
    end;
  Result := True;
end;


procedure TForm1.Button1Click(Sender: TObject);
begin
CompressMainFun('e:\1.jpg',75,640,480);
end;

end.

posted @ 2012-03-13 20:44 为人民服务 阅读(47) 评论(0) 编辑
  2012年3月10日
TStringList 常用操作
//TStringList 常用方法与属性:
var
List: TStringList;
i: Integer;
begin
List := TStringList.Create;
List.Add('Strings1');           {添加}
List.Add('Strings2');
List.Exchange(0,1);             {置换}
List.Insert(0,'Strings3');      {插入}
i := List.IndexOf('Strings1'); {第一次出现的位置}
List.Sort;                      {排序}
List.Sorted := True; {指定排序}
List.Count;                     {总数}
List.Text;                      {文本集合}
List.Delete(0);                 {删除, 0是第一个数据}
List.LoadFromFile('c:\tmp.txt');{打开}
List.SaveToFile('c:\tmp.txt'); {保存}
List.Clear;                     {清空}
List.Free;                      {释放}
end;


//读入字符串
var
List: TStringList;
begin
List := TStringList.Create;
List.CommaText := 'aaa,bbb,ccc,ddd';
//相当于: List.Text := 'aaa' + #13#10 + 'bbb' + #13#10' + 'ccc' + '#13#10' + 'ddd';

ShowMessage(IntToStr(List.Count)); //4
ShowMessage(List[0]); //aaa

List.Free;
end;


//置换分隔符
var
List: TStringList;
begin
List := TStringList.Create;
List.Delimiter := '|';
List.DelimitedText := 'aaa|bbb|ccc|ddd';

ShowMessage(IntToStr(List.Count)); //4
ShowMessage(List[0]); //aaa

List.Free;
end;


//类似的哈希表操作法
var
List: TStringList;
begin
List := TStringList.Create;

List.Add('aaa=111');
List.Add('bbb=222');
List.Add('ccc=333');
List.Add('ddd=444');

ShowMessage(List.Names[1]); //bbb
ShowMessage(List.ValueFromIndex[1]); //222
ShowMessage(List.Values['bbb']); //222

//ValueFromIndex 可以赋值:
List.ValueFromIndex[1] := '2';
ShowMessage(List[1]); //bbb=2

//可以通过 Values 赋值:
List.Values['bbb'] := '22';
ShowMessage(List[1]); //bbb=22

List.Free;
end;


//避免重复值
var
List: TStringList;
begin
List := TStringList.Create;

List.Add('aaa');

List.Sorted := True; //需要先指定排序
List.Duplicates := dupIgnore; //如有重复值则放弃

List.Add('aaa');

ShowMessage(List.Text); //aaa

//Duplicates 有3个可选值:
//dupIgnore: 放弃;
//dupAccept: 结束;
//dupError: 提示错误.

List.Free;
end;


//排序与倒排序
{排序函数}
function DescCompareStrings(List: TStringList; Index1, Index2: Integer): Integer;
begin
Result := -AnsiCompareText(List[Index1], List[Index2]);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
List: TStringList;
begin
List := TStringList.Create;

List.Add('bbb');
List.Add('ccc');
List.Add('aaa');

//未排序
ShowMessage(List.Text); //bbb ccc aaa

//排序
List.Sort;
ShowMessage(List.Text); //aaa bbb ccc

//倒排序
List.CustomSort(DescCompareStrings); //调用排序函数
ShowMessage(List.Text); //ccc bbb aaa

//假如:
List.Sorted := True;
List.Add('999');
List.Add('000');
List.Add('zzz');
ShowMessage(List.Text); //000 999 aaa bbb ccc zzz
end;

posted @ 2012-03-10 16:09 为人民服务 阅读(21) 评论(0) 编辑
Delphi中的jpg、png、gif 图片及 gif 动画的显示 
unit Unit1;

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Button3: TButton;
    Button4: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
end;

var
Form1: TForm1;

implementation

{$R *.dfm}

uses jpeg, GIFImg, pngimage;

{显示 jpg 图片}
procedure TForm1.Button1Click(Sender: TObject);
var
jpg: TJPEGImage;
begin
jpg := TJPEGImage.Create;
jpg.LoadFromFile('C:\Temp\Test.jpg');
Canvas.Draw(0, 0, jpg);
jpg.Free;
end;

{显示 png 图片}
procedure TForm1.Button2Click(Sender: TObject);
var
png: TPngImage;
begin
png := TPngImage.Create;
png.LoadFromFile('C:\Temp\Test.png');
Canvas.Draw(0, 0, png);
png.Free;
end;

{显示 gif 图片}
procedure TForm1.Button3Click(Sender: TObject);
var
gif: TGIFImage;
begin
gif := TGIFImage.Create;
gif.LoadFromFile('C:\Temp\Test.gif');
Canvas.Draw(0, 0, gif);
gif.Free;
end;

{显示 gif 动画}
procedure TForm1.Button4Click(Sender: TObject);
var
gif: TGIFImage;
begin
gif := TGIFImage.Create;
gif.LoadFromFile('C:\Temp\Test.gif');
gif.Animate := True;

with TImage.Create(Self) do begin
    Parent := Self;
    Left := 0;
    Top := 0;
    Picture.Assign(gif);
end;

gif.Free;
end;

end.
posted @ 2012-03-10 16:03 为人民服务 阅读(48) 评论(0) 编辑
Delphi动态创建控件 
procedure   TForm1.BitBtn1Click(Sender:   TObject);   
  var   
      i,d,j:integer;   
      editm:tedit;   
  begin   
  d:=0;   
  j:=strtoint(num.text);   
  for   i:=1   to   j   do   
  begin   
      editm   :=tedit.Create(self);   
      with   editm   do   
      begin   
          editm.Parent:=ScrollBox1;   
          editm.Width:=120;   
          editm.Height:=20;   
          editm.Left:=0;   
          editm.Top:=0+d;   
          editm.Name:='edit'+inttostr(i);   
          editm.Text:='edit'+inttostr(i);   
          editm.Visible:=true;   
          d:=d+20;   
      end;   
  end;


 


给动态创建的Edit控件动态添加OnChange事件：


procedure   TForm1.EditChange(Sender:   TObject);   
  begin   
      showmessage(Tedit(Sender).text);   
  end;

procedure   TForm1.EditChange(Sender:   TObject);   
  begin   
      showmessage(Tedit(Sender).text);   
  end;   
    
  procedure   TForm1.Button1Click(Sender:   TObject);   
  var   NewEdit:Tedit;   
  begin   
        NewEdit:=Tedit.Create(nil);   
        NewEdit.Parent:=self;   
        NewEdit.SetBounds(10,20,50,21);   
        NewEdit.OnChange:=EditChange;   
  end;
posted @ 2012-03-10 15:59 为人民服务 阅读(57) 评论(0) 编辑
Delphi结束进程模块 
uses Tlhelp32; 

function KillTask(ExeFileName: string): integer;
const
  PROCESS_TERMINATE = $0001;
var
  ContinueLoop: BOOLean;
  FSnapshotHandle: THandle;
  FProcessEntry32: TProcessEntry32;
begin
  Result := 0;
  FSnapshotHandle := CreateToolhelp32Snapshot(TH32CS_SNAPPROCESS, 0);
  FProcessEntry32.dwSize := SizeOf(FProcessEntry32);
  ContinueLoop := Process32First(FSnapshotHandle, FProcessEntry32);
  while integer(ContinueLoop) <> 0 do
  begin
    if ((UpperCase(ExtractFileName(FProcessEntry32.szExeFile)) = UpperCase
          (ExeFileName)) or (UpperCase(FProcessEntry32.szExeFile) = UpperCase
          (ExeFileName))) then
      Result := integer(TerminateProcess(OpenProcess(PROCESS_TERMINATE, BOOL(0)
              , FProcessEntry32.th32ProcessID), 0));
    ContinueLoop := Process32Next(FSnapshotHandle, FProcessEntry32);
  end;
  CloseHandle(FSnapshotHandle);
end;

调用的时候只需要 
if KillTask('qq.exe') <> 0 then 
    showmessage('结束QQ成功') 
else 
    showmessage('无法结束QQ'); 

你在程序里面用一个计时器，每隔一秒钟检查一下，如果有就结束，也就实现了禁止运行的目的。 
procedure TForm1.Timer1Timer(Sender: TObject); 
begin 
    KillTask('qq.exe'); 
end;
posted @ 2012-03-10 15:55 为人民服务 阅读(19) 评论(0) 编辑
Delphi随机生成不重复的数 
procedure TForm1.Button1Click(Sender: TObject);
var
  b: array of integer;
  num: Integer;        //随机数的个数
  i, temp: integer;
begin
  num := 10;
  SetLength(b,num);
  for i := 1 to num DO
    b[i] := i;
  ListBox1.Clear;
  for i := 1 to num do
  begin
    temp := Random(num - i + 1) + 1;
    ListBox1.Items.Add(IntToStr(b[temp]));
    b[temp] := b[num - i + 1];
  end;
end;
posted @ 2012-03-10 15:49 为人民服务 阅读(19) 评论(0) 编辑
Delphi中建议使用的语句

No.1 利用MaxInt常量

1
2
3
4
5
 
begin
  Caption := Copy(Edit1.Text, 3, Length(Edit1.Text) - 3 + 1); //不建议
//----
  Caption := Copy(Edit1.Text, 3, MaxInt); //建议//嘻嘻，少计算一次
end;


No.2 临时SQL查询

1
2
3
4
5
6
7
8
9
10
11
 
begin
  QueryTemp.Close;
  QueryTemp.SQL.Text := 'Select SUM(金额) AS 合计 FROM 销售表';
  QueryTemp.Open; //不建议//数据没有关闭造成资源浪费
  ShowMessage(Query1.FieldByName('合计').AsString);
//---
  QueryTemp.SQL.Text := 'Select SUM(金额) AS 合计 FROM 销售表';
  QueryTemp.Open;
  ShowMessage(Query1.FieldByName('合计').AsString);
  QueryTemp.Close; //建议用//使用完就关闭
end;

No.3 获取记录数

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
 
var
  vRecordCount: Integer;
begin
  Query1.SQL.Text := 'Select * FROM Table1'; //不建议
//严重浪费资源，会取得很多不必要得信息
 Query1.Open;
  vRecordCount := Query1.RecordCount;
  Query1.Close;
//--
  Query1.SQL.Text := 'Select COUNT(*) AS 记录数 FROM Table1'; //建议
//快速有效、只处理一条记录
  Query1.Open;
  vRecordCount := Query1.FieldByName('记录数').AsInteger;
  Query1.Close;
 
  ShowMessage(IntToStr(vRecordCount));
end;

No.4 字段赋值

1
2
3
4
5
6
7
8
 
begin
  Table1.Edit;
  Table1.FieldByName('姓名').AsString := Edit1.Text; //不建议
  Table1.FieldByName('日期').AsDateTime := Date;
//---
  Table1['姓名'] := Edit1.Text; //建议//简短、扩充性好
  Table1['日期'] := Date;
end;

No.5 使用Self指针

1
2
3
4
5
6
 
begin
  Edit1.Parent := Form1; //不建议//Form1只是一个变量
//如果没有分配资源怎么办？
//---
  Edit1.Parent := Self; //建议
end;

No.6 遍历数据集

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
var
  I: Integer;
begin
  Query1.First;
  for I := 0 to Query1.RecordCount - 1 do begin //不建议
//容易被影响
    Query1.Next;
{};
  end;
//---
  Query1.First;
  while not Query1.Eof do begin //建议
{ }
    Query1.Next;
  end;
end;

No.7 利用Sender参数，使代码通用

1
2
3
4
5
6
7
8
 
procedure TForm1.Edit1Change(Sender: TObject);
  begin
    if Edit1.Text = '' then //不建议
      Edit1.Color := clRed;
//---
    if TEdit(Sender).Text = '' then //建议//复制到EditXChange中很方便
      TEdit(Sender).Color := clRed;
  end;

No.8 使用默认转换函数

1
2
3
4
5
6
7
8
 
var
  I: Integer;
begin
  I := StrToInt(Edit1.Text); //不建议
//---
  I := StrToIntDef(Edit1.Text, 0); //建议
//参考StrToFloatDef,StrToDateDef....不过这些只有Delphi6才有
end;

No.9 遍历数组

1
2
3
4
5
6
7
8
9
10
 
var
  I: Integer;
  A: array[0..9] of Integer;
begin
  for I := 0 to 9 do //不建议
    A[I] := I;
//---
  for I := Low(A) to High(A) do //建议//扩充性好
    A[I] := I;
end;

No.10 判断逻辑类型

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
 
var B: Boolean;
begin
  B := Boolean(2); //这样只是为了调试//B := True;
  if B = True then ShowMessage('B = True'); //不建议//不安全
//---
  if B then ShowMessage('B'); //建议//简短
end;
 
var B: Boolean;
begin
  if Edit1.Text = '是' then //不建议//烦琐
    B := True
  else B := False;
//---
  B := Edit1.Text = '是'; //建议//简短
end;

No.11 用FreeAndNil来释放对象

使用前不用判断对象是否为空
使用后,Assigned对象为空


posted @ 2012-03-10 15:46 为人民服务 阅读(7) 评论(0) 编辑
仅列出标题  下一页

Powered by: 博客园 模板提供：沪江博客 Copyright ©2012 为人民服务