delphi,用delphi制作类似按键精灵的功能

//以前用XP，使用按键精灵还是不错的，但至从换成64位的win7平台后，按键精灵9在不开启神盾的情况下无法启动脚本。

//为了能在64位的win7下继续使用类似按键精灵的功能，现改用delphi来制作，最大的好处是灵活，而且不收费

//以下内容为网络上摘抄，暂时还未验证，如有同类爱好的朋友可以共同探讨

unit kbKernel;

interface
uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls;
type
  pRGBTripleArray = ^TRGBTripleArray;
  TRGBTripleArray = ARRAY[0..32767] OF TRGBTriple;
  TRGBTriple = 
  PACKED RECORD
    rgbtBlue : BYTE;
    rgbtGreen: BYTE;
    rgbtRed : BYTE;
  END;

  procedure CloseWindows;
  procedure LeftClick(x, y: integer);
  procedure RightClick(x, y: integer);
  procedure DoubleClick(x, y: integer);
  procedure MoveTo(x, y: integer);
  procedure Presskey(vk: integer);
  procedure PressTwoKey(key1, key2: integer);
  function GetPixelColor(x, y: integer): integer;
  function Findcolor(iLeft, iTop, iRight, iBottom, Acolor: integer;
    var iX, iY: integer):boolean;
  function Findpicture(iLeft, iTop, iRight, iBottom: integer;
    strPic: string; var iX, iY: integer):boolean;
  procedure inputNum(num:integer);
  function GetXY(var x, y: integer): boolean;

implementation

procedure CloseWindows();
var
 hdlProcessHandle : Cardinal;
 hdlTokenHandle : Cardinal;
 tmpLuid : Int64;
 //tkpPrivilegeCount : Int64;
 tkp : TOKEN_PRIVILEGES;
 tkpNewButIgnored : TOKEN_PRIVILEGES;
 lBufferNeeded : Cardinal;
 Privilege : array[0..0] of _LUID_AND_ATTRIBUTES;
begin
  hdlProcessHandle := GetCurrentProcess;
  OpenProcessToken(hdlProcessHandle,
                 (TOKEN_ADJUST_PRIVILEGES Or TOKEN_QUERY),
                  hdlTokenHandle);

  // Get the LUID for shutdown privilege.
  LookupPrivilegeValue('', 'SeShutdownPrivilege', tmpLuid);
  Privilege[0].Luid := tmpLuid;
  Privilege[0].Attributes := SE_PRIVILEGE_ENABLED;
  tkp.PrivilegeCount := 1;   // One privilege to set
  tkp.Privileges[0] := Privilege[0];
  // Enable the shutdown privilege in the access token of this
  // process.
  AdjustTokenPrivileges(hdlTokenHandle,
                       False,
                       tkp,
                       Sizeof(tkpNewButIgnored),
                       tkpNewButIgnored,
                       lBufferNeeded);
  ExitWindowsEx((EWX_SHUTDOWN Or EWX_FORCE), $FFFF);
end;

 //点击鼠标左键
procedure LeftClick(x,y:integer);
begin
  mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTDOWN,round(x*65535/1024),round(y*65535/768),0,0);
  sleep(20);
  mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_LEFTUP,round(x*65535/1024),round(y*65535/768),0,0);
end;

//点击鼠标右键
procedure RightClick(x,y:integer);
begin
  mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTDOWN,round(x*65535/1024),round(y*65535/768),0,0);
  sleep(20);
  mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_RIGHTUP,round(x*65535/1024),round(y*65535/768),0,0);
end;

//双击鼠标左键
procedure DoubleClick(x,y:integer);
begin
  LeftClick(x,y);
  sleep(50);
  LeftClick(x,y);
end;

//移动鼠标到指定位置
procedure MoveTo(x,y:integer);
begin
  mouse_event(MOUSEEVENTF_ABSOLUTE or MOUSEEVENTF_MOVE,round(x*65535/1024),round(y*65535/768),0,0);
end;

//按下一个键
procedure Presskey(vk:integer);
begin
  keybd_event(vk,MapVirtualKey(vk, 0),0,0);
  sleep(20);
  keybd_event(vk,MapVirtualKey(vk, 0),KEYEVENTF_KEYUP,0);
end;

Procedure PressTwoKey(key1,key2:integer);
begin
  keybd_event(key1,MapVirtualKey(key1, 0),0,0);
  sleep(50);
  PressKey(key2);
  sleep(50);
  keybd_event(key1,MapVirtualKey(key1, 0),KEYEVENTF_KEYUP,0);
end;

//得到屏幕上的某点的颜色
function GetPixelColor(x,y:integer):integer;
var
  aDc:HDC;
begin
  aDc:=getdc(0);
  result:=getpixel(aDc,x,y);
  releasedc(0,aDc);
end;

//在指定范围内查找一个点，找到返回TRUE，失败为FALSE
function findcolor(iLeft,iTop,iRight,iBottom,Acolor:integer;var iX,iY:integer):boolean;
var
  aDc:HDC;
  i,j:integer;
  bitmap:Tbitmap;
  row,row1 : pRGBTripleArray;
  ScanlineBytes: INTEGER;
begin
  iX := -1;
  iY := -1;

  bitmap:= Tbitmap.Create;
  bitmap.PixelFormat := pf24bit;
  bitmap.Width := iRight-iLeft+1;
  bitmap.Height := iBottom-iTop+1;
  aDc:= getdc(0);
 bitblt(bitmap.Canvas.Handle,0,0,bitmap.Width-1,bitmap.Height-1,aDc,iLeft,iTop,srccopy);
  releasedc(0,aDc);
  row := Bitmap.Scanline[0];
  row1 := Bitmap.Scanline[1];
  ScanlineBytes := Integer(row1) - Integer(row);
  for j := 0 to Bitmap.Height-1 do
  begin
    for i := 0 to Bitmap.Width-1 do
    begin
     if (row[i].rgbtRed=getRvalue(Acolor))and(row[i].rgbtGreen=getGvalue(Acolor))and(row[i].rgbtBlue=getBvalue(Acolor))then
     begin
       iX:= i;
       iY:= j;
       break;
     end;
    end;
    if iX<>-1 then break;
   inc(Integer(Row), ScanlineBytes);
  end;
  result := iX<>-1;
  bitmap.Free;
end;

function findpicture(iLeft,iTop,iRight,iBottom:integer;strPic:string;var iX,iY:integer):boolean;
var
  aDc:HDc;
  bitmap,bitmap1:Tbitmap;
  arrPoint:array[1..20] of Tpoint;
  iColors:array[1..20] of integer;
  i,j,k,x,y:integer;
  finded:boolean;

  row,row1 : pRGBTripleArray;
  ScanlineBytes: INTEGER;
begin
  iX := -1;
  iY := -1;
  result:=false;
  if not fileexists(strPic) then exit;//文件不存在，则退出；
  bitmap1 := Tbitmap.Create;
  bitmap1.LoadFromFile(strPic);
  for i:= 1 to 20 do
  begin
    repeat
     x := random(bitmap1.Width);
     y := random(bitmap1.Height);
     while bitmap1.Canvas.Pixels[x,y]= 16777215 do
     begin
       x := random(bitmap1.Width);
       y := random(bitmap1.Height);
     end;

     finded:= false;
     for j:= i-1 downto 1 do
     begin
       if (arrPoint[j].X = x) and (arrPoint[j].Y = y) then
       begin
         finded := true;
         break;
       end;
     end;
    until not finded;
   arrPoint[i].X := x;
   arrPoint[i].Y := y;
    iColors[i] := bitmap1.Canvas.Pixels[arrPoint[i].X,arrPoint[i].Y];
  end;

  bitmap:= Tbitmap.Create;
  bitmap.PixelFormat := pf24bit;
  bitmap.Width := iRight-iLeft+1;
  bitmap.Height := iBottom-iTop+1;
  aDc:= getdc(0);
 bitblt(bitmap.Canvas.Handle,0,0,bitmap.Width-1,bitmap.Height-1,aDc,iLeft,iTop,srccopy);
  releasedc(0,aDc);
  row := Bitmap.Scanline[0];
  row1 := Bitmap.Scanline[1];
  ScanlineBytes := Integer(row1) - Integer(row);

  for j := 0 to Bitmap.Height-bitmap1.Height do
  begin
    for i := 0 to Bitmap.Width-bitmap1.Width do
    begin
     finded := true;
     for k:= 1 to 20 do
     begin
       integer(row1):= integer(row)+ arrPoint[k].Y*ScanlineBytes;
       if (abs(row1[i+arrPoint[k].X].rgbtRed-getRvalue(iColors[k]))>255*(1-0.9))or(abs(row1[i+arrPoint[k].X].rgbtGreen-getGvalue(iColors[k]))>255*(1-0.9))or(abs(row1[i+arrPoint[k].X].rgbtBlue-getBvalue(iColors[k]))>255*(1-0.9))then
       begin
         finded := false;
         break;
       end;
     end;
     if finded then
     begin
       iX := iLeft+i+round(bitmap1.Width/2);
       iY := iTop+j+round(bitmap1.Height/2);
       break;
     end;
    end;
    if iX<>-1 then break;
   inc(Integer(Row), ScanlineBytes);
  end;
  result:=iX<>-1;
  bitmap.Free;
  bitmap1.Free;
end;

procedure inputNum(num:integer);
var
  i:integer;
  aStr:string;
begin
  aStr:= inttostr(num);
  for i:=1 to length(aStr) do
  begin
   PressKey(ord(aStr[i]));
   sleep(50);
  end;
  PressKey(VK_RETURN);
  sleep(50);
end;

//读取当前游戏坐标
function GetXY(var x, y: integer): boolean;
var
 aDc:HDC;
 i,j,newX,TZCount:integer;
 PXCount:integer;//象素数量
 EmptyLine,EmptyContent,negtiveX,negtiveY,XorY:boolean;

 bitmap:Tbitmap;
 row,row1 : pRGBTripleArray;
 ScanlineBytes: INTEGER;
begin
  bitmap:= Tbitmap.Create;
  bitmap.PixelFormat := pf24bit;
  bitmap.Width := 950-870+1;
  bitmap.Height := 34-22+1;
  aDc:= getdc(0);
 bitblt(bitmap.Canvas.Handle,0,0,bitmap.Width-1,bitmap.Height-1,aDc,870,22,srccopy);
  releasedc(0,aDc);
  row := Bitmap.Scanline[0];
  row1 := Bitmap.Scanline[1];
  ScanlineBytes := Integer(row1) - Integer(row);

 EmptyContent:=true;
  EmptyLine:=true;
  TZCount:=0;//累加一个数字的所有想素的坐标总和
  PXCount:= 0;
  negtiveX:=false;//x坐标负数标记
  negtiveY:=false;//y坐标负数标记
  XorY:=false;//表示扫描X还是Y,先扫描X
  newX:=0;//该语句多余，仅仅为了不产生警告错误而已
  result:=false;
  x:=0;
  y:=0;

  for i:=0 to bitmap.Width-1 do
  begin
    if (not EmptyContent)and(EmptyLine) then
    begin
     case TZCount of
       111:;//     [ 125
       127: result:=true;//     ] 141
       11: XorY:=true;//     . 12  开始扫描 Y
       45: if XorY then negtiveY:=true else negtiveX:=true;//     - 50
       171:if XorY then y:=y*10 else x:=x*10;//     0 189
       97:if XorY then y:=y*10+1 else x:=x*10+1;//     1 108
       153:if XorY then y:=y*10+2 else x:=x*10+2;//     2 169
       149:if XorY then y:=y*10+3 else x:=x*10+3;//     3 164
       163:if PXCount = 16 then
             if XorY then y:=y*10+4 else x:=x*10+4//     4 179
           else
             if XorY then y:=y*10+5 else x:=x*10+5;//     5 181
       176:if XorY then y:=y*10+6 else x:=x*10+6;//     6 195
       107:if XorY then y:=y*10+7 else x:=x*10+7;//     7 120
       180:if XorY then y:=y*10+8 else x:=x*10+8;//     8 199
       185:if XorY then y:=y*10+9 else x:=x*10+9;//     9 204
     end;

     EmptyContent:=true;
     TZCount:=0;
     PXCount:= 0;
    end;
   EmptyLine:=true;
    for j:=0 to bitmap.Height-1 do
    begin
     integer(row1) :=integer(row)+j*ScanlineBytes;
     if (abs(row1[i].rgbtRed-getRvalue(198))<20)and(abs(row1[i].rgbtGreen-getGvalue(198))<20)and(abs(row1[i].rgbtBlue-getBvalue(198))<20)then
     begin
       if EmptyContent then newX := i; //保存新数字的开始横坐标
       TZCount:=TZCount+i-newX+1+j+1; //把像素点的横纵坐标累加
       inc(PXCount);
       EmptyContent:=false;
       EmptyLine:=false;
     end;
    end;
  end;
  if negtiveX then x:=0-x;
  if negtiveY then y:=0-y;
  bitmap.Free;
end;

end.