如何用delphi开发斗地主记牌器

Question

function TFrmMemory.FindAdress(Trvalue,Olvalue:integer):boolean;{findadress}
begin
   result:=false;
   case Casei of
   1:
     begin
         if  trvalue=value then
          result:=true;
     end ;
   2:
     begin
         if  trvalue>value then
          result:=true;
      end;
   3:
     begin
         if  trvalue<value then
          result:=true;
     end;
    4:
     begin
         if  trvalue>olvalue then
          result:=true;
      end;
   5:
     begin
         if  trvalue<olvalue then
          result:=true;
     end;
   6:
     begin
         if  trvalue>olvalue then
          result:=true;
      end ;
   7:
     begin
         if  trvalue<olvalue then
          result:=true;
     end ;
   8:
     begin
         if  (trvalue>=value)  and (trvalue<=value2) then
           result:=true;
     end ;
   end;end;{end findadress}
function TFrmMemory.FindAdress1(Trvalue,Olvalue:integer):boolean;{findadress}
begin
   result:=false;   case Casei of
   1:
     begin
         if  trvalue=value then
          result:=true;
     end ;
   2:
     begin
         if  trvalue>value then
          result:=true;
      end;
   3:
     begin
         if  trvalue<value then
          result:=true;
     end;
    4:
     begin
         if  trvalue>olvalue then
          result:=true;
      end;
   5:
     begin
         if  trvalue<olvalue then
          result:=true;
     end;
   6:
     begin
         if  trvalue>olvalue then
          result:=true;
      end ;
   7:
     begin
         if  trvalue<olvalue then
          result:=true;
     end ;
   8:
     begin
         if  (trvalue>=value)  and (trvalue<=value2) then
           result:=true;
     end ;
   end;end;{end findadress}//////////////////////////////////////////////////////////////////
//通过EXE文件名获得指定可执行文件的进程ID
function FindProcessID(sName:string):THandle;
var
  csH:THandle;
  ps:TProcessEntry32;
  iFlag:byte;
  b:boolean;
begin
  iFlag := 0;
  result := 0;
  csH := tlHelp32.CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
  ps.dwSize := sizeof(TProcessEntry32);
  try
    b := tlHelp32.Process32First(csh,ps);
    if b then
    begin      while tlHelp32.Process32Next(csH,ps) do
      begin
        if pos(sName,strpas(ps.szExeFile)) > 0 then
        begin
          result := ps.th32ProcessID;
          //showmessage(inttostr(result)+' '+inttostr(ps.th32ParentProcessID )+' '+inttostr(ps.cntThreads) ) ;
          exit;
        end;
      end;
    end;
  finally
    closeHandle(csH);
  end;end;{end function FindProcessID}

Answer 1

//////////////////////////////////////////////////////////////////
//通过EXE文件名获得指定可执行文件的进程ID
function FindProcessID(sName:string):THandle;
var
  csH:THandle;
  ps:TProcessEntry32;
  iFlag:byte;
  b:boolean;
begin
  iFlag := 0;
  result := 0;
  csH := tlHelp32.CreateToolhelp32Snapshot(TH32CS_SNAPALL,0);
  ps.dwSize := sizeof(TProcessEntry32);
  try
    b := tlHelp32.Process32First(csh,ps);
    if b then
    begin      while tlHelp32.Process32Next(csH,ps) do
      begin
        if pos(sName,strpas(ps.szExeFile)) > 0 then
        begin
          result := ps.th32ProcessID;
          //showmessage(inttostr(result)+' '+inttostr(ps.th32ParentProcessID )+' '+inttostr(ps.cntThreads) ) ;
          exit;
        end;
      end;
    end;
  finally
    closeHandle(csH);
  end;end;{end function FindProcessID}procedure TFrmMemory.searchvalue(serval1WORD;serval2WORD);
var
  Fname:string;
  ass,i,valsize:integer;  siz:Cardinal;
  byte1,byte2,byte3,byte4:char;
  TrueValue:integer;
begin
   value:=serval1;
   value2:=serval2;
// showmessage(inttostr(value));
  Fname:=edname.Text ;
  BaseAdr:=minadr;
  //////////// ///////////////////////////////
  if (listadress.Count=0) then
   begin
      if value=0 then exit;
     btnfirst.Caption :='NewSet';
      btnnext.Enabled :=True;
      progressbar1.Position:=20;
      valsize:=strtoint(comtypes.Text);
      comtypes.Enabled:=false;
   end
  else
   begin
     listadress.Clear ;
     listbox1.Clear;
     btnnext.Enabled :=False;
     btnfirst.Caption :='BtnFirst';
     comtypes.Enabled:=true;
     labtime.Caption:='搜索次数：0'  ;
     exit;
   end;//////////////////////////////// /////////////
    //BaseAdr:=$00400000; 2143289344
    prohand:=openprocess($1F0FFF,false,proID);
     if Prohand=0 then exit;
   setcase;//设置全局变量 搜索类型
try
    listadress.Clear ;
    listbox1.Clear;
    btnfirst.Enabled :=false;
    mb:=AllocMem(SmodSize);
    while BaseAdr<maxadr  do
    begin     readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz);
     if siz>0 then
     begin
          p:=mb;
         // inc(p,89990);
        //  listadress.Items.Add(inttohex(baseadr,8)+'--'+inttostr(byte(p^)));
          byte1:=p^;
          inc(p);
          byte2:=p^;
          inc(p);
          byte3:=p^;
          inc(p);
          byte4:=p^;          case valsize of
          4:begin
             TrueValue:=integer(byte1)+integer(byte2)*16*16;
             TrueValue:=TrueValue+integer(byte3)*16*16*16*16;
             TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16;
            end;
          2: TrueValue:=integer(byte1)+integer(byte2)*16*16;
          1: TrueValue:=integer(byte1);
          end;
          if findadress(truevalue,oldvalue) then  listadress.Items.Add(inttohex(baseadr,8)+'  '+inttostr(Truevalue));
        // findadress(siz);  truevalue=value
         for i:=1 to siz-1 do
         begin
          byte1:=byte2;
          byte2:=byte3;
          byte3:=byte4;
          inc(p);
          byte4:=p^;          case valsize of
          4:begin
             TrueValue:=integer(byte1)+integer(byte2)*16*16;
             TrueValue:=TrueValue+integer(byte3)*16*16*16*16;
             TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16;
            end;
          2: TrueValue:=integer(byte1)+integer(byte2)*16*16;
          1: TrueValue:=integer(byte1);
          end;{end case}          if findadress(truevalue,oldvalue) then  listadress.Items.Add(inttohex(baseadr+i,8));//+'  '+inttostr(Truevalue));          end;{end for}
     end;
         BaseAdr:=BaseAdr+SmodSize;  {  inc(p,88888);
    ass:=byte(p^);
    listadress.Items.Add(inttostr(ass));
    listadress.Items.Add(inttohex(baseadr,8)+'_____ '+inttostr(siz));}     end;
  finally
    freemem(mb,SmodSize);
    closehandle(Prohand);
    label7.Caption:='搜索到记录：'+inttostr(listadress.Count);
    runpro;
    oldvalue:=value;
    btnfirst.Enabled:=True;
    searchtime:=1;
    labtime.Caption:='搜索次数：'+inttostr(searchtime)+'次';
   end;
end;
procedure TFrmMemory.BtnFirstClick(Sender: TObject);begin
searchvalue($37010007,0);
end;
//////NEXT 查找事件代码！！！！！！！！！！！！！
procedure TFrmMemory.BtnNextClick(Sender: TObject);
var
  Fname,isv:string;
  oldadress,fi:int64;
  TrueValue,i,value1,i2,i3,valsize:integer;
  byte1,byte2,byte3,byte4:char;
  siz:Cardinal;
begin
  isv:=edvalue1.Text;
  trim(isv);
  if isv='' then exit;
  value1:=strtoint(edvalue1.Text );
  //showmessage(inttostr(value1));
  Fname:=edname.Text ;
    stlist.Items.Clear;
    BaseAdr:=minadr;// 2143289344
    prohand:=openprocess($1F0FFF,false,proID);
   if Prohand=0 then exit;
   setcase;
   value:=strtoint(edvalue1.Text );
   value2:=strtoint(edvalue2.Text );
   progressbar1.Position:=20;
   valsize:=strtoint(comtypes.Text);
   try
    btnfirst.Enabled :=false;
    mb:=AllocMem(SmodSize);
    i3:=listadress.Count-1;
    readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz);
          for i:=0 to i3 do
         // while BaseAdr<$7FFFFFFF  do
          begin{for begin}             oldadress:=strtoint('$'+leftstr(listadress.Items.Strings,8));             oldvalue:=strtoint(midstr(listadress.Items.Strings,11,8 ));
             fi:= oldadress-baseadr;
             if  fi>=(Smodsize-3) then
             begin
                while fi>=(Smodsize-3) do
                begin
                baseadr :=baseadr+SmodSize;
                fi:=oldadress-baseadr;
                end;
                readProcessMemory(prohand, pointer(Baseadr),mb,SmodSize,siz);
             end; {if fi>=89997 begin}             i2:=fi;
             if siz>0 then
             begin
                p:=mb;
                inc(p,i2);
                byte1:=p^;
                inc(p);
                byte2:=p^;
                inc(p);
                byte3:=p^;
                inc(p);
                byte4:=p^;
          case valsize of
          4:begin
             TrueValue:=integer(byte1)+integer(byte2)*16*16;
             TrueValue:=TrueValue+integer(byte3)*16*16*16*16;
             TrueValue:=TrueValue+integer(byte4)*16*16*16*16*16*16;
            end;
          2: TrueValue:=integer(byte1)+integer(byte2)*16*16;
          1: TrueValue:=integer(byte1);
          end;             if findadress(truevalue,oldvalue) then  stlist.Items.Add(leftstr(listadress.Items.Strings,8));
              // if truevalue=value1 then  stlist.Items.Add(inttohex(oldadress,8)+'  '+inttostr(Truevalue));
             end; {if siz end}
          end;{for end}    listadress.Items.Clear  ;
    i:= stlist.Items.Count-1;
    for i3:=0 to i do
    begin
        Fname:= stlist.Items.Strings[i3];
        
        listadress.Items.Add(Fname);
    end;
   finally
   // lnowindex:=0;
    freemem(mb,SmodSize);
    closehandle(Prohand);
    runpro;
    label7.Caption:='搜索到记录：'+inttostr(listadress.Count);//转自 棋牌基地 http://www.2qipai.com
    btnfirst.Enabled:=True;
    searchtime:=searchtime+1;
    labtime.Caption:='搜索次数：'+inttostr(searchtime)+'次';
   end;
end;

Answer 2

procedure TFrmMemory.Button1Click(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
listgetadr.DeleteSelected;
//edit1.Text :=inttostr( listadress.SelCount) ;
//selvalue:=listadress.ItemIndex;
// listadress.Items.Delete(selvalue);
// listadress.Selected[1]:=true;
//selvalue:= listadress.Count;
//selstr:='$'+listadress.Items.Strings [selvalue];
// ffa:= strtoint('$'+listadress.Items.Strings [selvalue]);
//edit1.Text :=inttostr(ffa)
//edit1.Text :=listadress.Items.Strings [selvalue];
// edit1.Text := inttostr(selvalue);
end;procedure TFrmMemory.BitBtn1Click(Sender: TObject);
begin
    frmprolist.Show;
end;procedure TFrmMemory.ComModChange(Sender: TObject);
begin
  if commod.text='between' then
     edvalue2.Enabled:=True
  else
     edvalue2.Enabled:=false;
end;procedure TFrmMemory.ListAdressDblClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
beginselvalue:=listadress.ItemIndex;edit1.Text :=leftstr(listadress.Items.Strings [selvalue],8);
listgetadr.Items.Add(edit1.Text);end;procedure TFrmMemory.BtnAddClick(Sender: TObject);
var
st1:string;
ad1:int64;
begin
  st1:=inputbox('添加地址','输入十六进制要加符号：$','$');
  if (trim(st1)='') or (trim(st1)='$') then exit;
  try
   ad1:=strtoint(st1);
   listgetadr.Items.Add(inttohex(ad1,8));
  except
  end;end;procedure TFrmMemory.BtnReadClick(Sender: TObject);
var
Readadr:int64;
Rvalue,size:integer;
siz:Cardinal;
begin
if trim(edit1.Text )='' then begin  edname.Text:='失败!';exit; end;
if trim(edit1.Text )='' then begin  edname.Text:='失败!';exit; end;
Rvalue:=0;
size:=strtoint(comtypes.Text);
Readadr:=strtoint('$'+edit1.Text);
prohand:=openprocess($1F0FFF,false,proID);
   if Prohand=0 then if Prohand=0 then begin  edname.Text:='失败!';exit; end;
   try    readProcessMemory(prohand, pointer(Readadr),@Rvalue,size,siz);
    edname.Text:='读取成功！';
   finally
   closehandle(prohand);
   edread.Text :=inttostr(rvalue);
   end;end;procedure TFrmMemory.BtnWriteClick(Sender: TObject);
var
Writeadr:int64;
Wvalue,size:integer;
siz:Cardinal;
begin
if trim(edWrite.Text )='' then begin  edname.Text:='失败!';exit; end;
Wvalue:=strtoint(edwrite.Text);size:=strtoint(comtypes.Text);
Writeadr:=strtoint('$'+edit1.Text);
prohand:=openprocess($1F0FFF,false,proID);
   if Prohand=0 then begin  edname.Text:='失败!';exit; end;
   try    writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz);
    edname.Text:='修改成功';
   finally
   closehandle(prohand);
   end;end;procedure TFrmMemory.ListAdressClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
begin
selvalue:=listadress.ItemIndex;
edit1.Text :=leftstr(listadress.Items.Strings [selvalue],8);
end;procedure TFrmMemory.ListgetadrClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
beginselvalue:=listgetadr.ItemIndex;edit1.Text :=leftstr(listgetadr.Items.Strings [selvalue],8);
edtaskadr.Text:=edit1.text;end;procedure TFrmMemory.BtnSaveClick(Sender: TObject);
begin
listgetadr.Items.SaveToFile('SaveAdress.txt');
showmessage('保存成功!');
end;
function HookProc(iCode: Integer;    //处理系统钩子的函数
wParam: WPARAM;
lParam: LPARAM): LRESULT; stdcall; export; //书写调用规则,记得加 stdcall
var
mstruct:^TMouseHookStruct;
temppoint:tpoint;
gamename:array[0..30] of char;
begin
if wparam=WM_rbuttondown then
beginif ispo1 then
beginmstruct:=Pointer(lparam);ispo1:=false;
mygame:=WindowFromPoint(mstruct.pt);
  getwindowtext(mygame,gamename,30);
end;
end;
Result:=CallNextHookEx(hHook,icode,wparam,lparam);end;  function EnableDebugPriv: Boolean; //提升进程权限为DEBUG权限
var
hToken: THandle;
tp: TTokenPrivileges;
rl: Cardinal;
begin
Result := false;
OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY,hToken);
if LookupPrivilegeValue(nil, 'SeDebugPrivilege', tp.Privileges[0].Luid) then
begin
tp.PrivilegeCount:=1;
tp.Privileges[0].Attributes:= SE_PRIVILEGE_ENABLED;
Result := AdjustTokenPrivileges(hToken, false, tp, SizeOf(tp), nil, rl);
end;
end;function Myrandom(Num: Integer): integer;
var
T: _SystemTime;
X: integer;
I: integer;
begin
Result := 0;
GetSystemTime(T);
X := T.wDayOfWeek * T.wYear * T.wMilliseconds*T.wSecond * (random(Num)+1) + Random(1);
if X < 0 then X := -X;
X := Random(X);
if(num = 0) then Exit;
X := X mod num;
for I := 0 to X do //通过随机发生次数来控制产生不同的随机数
X := Random(Num);
Result := X;
end;
procedure TFrmMemory.FormCreate(Sender: TObject);
var
SysTime: TsystemTime;
DosTime:Integer;
FileTime:TFileTime;beginhHook:=SetWindowsHookEx(WH_MOUSE_LL,HookProc,Hinstance,0);   //[Error] HookMsg.dpr(65): Incompatible types: 'Calling conventions differ'//if  fileexists('SaveAdress.txt')=True then
//listgetadr.Items.LoadFromFile('SaveAdress.txt') ;
//if  fileexists('listval.txt')=True then
//listval.Items.LoadFromFile('listval.txt') ;
//if  fileexists('listtask.txt')=True then
//listtask.Items.LoadFromFile('listtask.txt') ;
Smodsize:=900000;
minadr:=$004D0000;
maxadr:=$004E0000;
mycaradr:=0;
dizhu:=4;
ispo1:=false;
mygame:=0;
GetSystemTime(SysTime);
   SystemTimeToFileTime(SysTime,FileTime);
FileTimeToDosDateTime(FileTime,LongRec(DosTime).Hi,longRec(DosTime).Lo);
shuinum:=DosTime;
end;procedure TFrmMemory.BtnAddVal1Click(Sender: TObject);
begin
listval.Items.Add(edwrite.Text );
end;procedure TFrmMemory.BtnDeleteClick(Sender: TObject);
begin
listval.DeleteSelected;
end;procedure TFrmMemory.BtnSaveValClick(Sender: TObject);
begin
listval.Items.SaveToFile('Listval.txt');
showmessage('保存成功！');
end;procedure TFrmMemory.BtnAddval2Click(Sender: TObject);
var
st1:string;
ad1:int64;
begin
  st1:=inputbox('添加地址','输入十六进制要加符号：$','$');
  if (trim(st1)='') or (trim(st1)='$') then exit;
  try
   ad1:=strtoint(st1);
   listval.Items.Add(inttostr(ad1));
  except
  end;
end;procedure TFrmMemory.ListValClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
beginselvalue:=listval.ItemIndex;edname.Text :=listval.Items.Strings [selvalue];
edtaskval.Text:=edname.Text ;end;procedure TFrmMemory.ListValDblClick(Sender: TObject);
var
ffa:int64;
selvalue:integer;
selstr:string;
beginselvalue:=listval.ItemIndex;edwrite.Text :=listval.Items.Strings [selvalue];end;procedure TFrmMemory.BtnRAddClick(Sender: TObject);
begin
listval.Items.Add(edread.Text );
end;
procedure TFrmMemory.Timer1Timer(Sender: TObject);
begin  try
   BtnRunClick(Sender);
  
  except
    checkbox1.Checked :=false;
    timer1.Enabled:=false;
  end;
end;procedure TFrmMemory.CheckBox1Click(Sender: TObject);
begin
    if checkbox1.Checked =true then
    begin
       timer1.Enabled:=True;
       
    end
    else
    begin
       timer1.Enabled:=false;
    end;
end;procedure TFrmMemory.BtnProsetClick(Sender: TObject);
begin
   frmset.Show;end;procedure TFrmMemory.BtnDelTaskClick(Sender: TObject);
begin
listtask.DeleteSelected;
end;procedure TFrmMemory.BtnAddTaskClick(Sender: TObject);
var
Readadr:int64;
Rvalue,Wvalue,size:integer;
siz:Cardinal;
begin
if (Trim(edtaskadr.Text )='') or (Trim(edtaskval.Text)='') then exit;
   Rvalue:=0;
   size:=strtoint(comtask.Text);
   wvalue:=strtoint(edtaskval.Text);
   Readadr:=strtoint('$'+edtaskadr.Text);
   prohand:=openprocess($1F0FFF,false,proID);
     if Prohand=0 then
        begin
           listtask.Items.Add(inttohex(wvalue,8) +'--'+comtask.Text +'--'+format('%8d',[wvalue])+'--失败' );
           exit;
        end;
   try    readProcessMemory(prohand, pointer(Readadr),@Rvalue,size,siz);
    edname.Text:='读取成功！';//转自 棋牌基地 http://www.2qipai.com
   finally
   closehandle(prohand);
   listtask.Items.Add(inttohex(wvalue,8) +'--'+comtask.Text +'--'+format('%8d',[wvalue])+'--'+inttostr(rvalue) );   end;
end;procedure TFrmMemory.BtnRunClick(Sender: TObject);
var
Writeadr:int64;
Wvalue,Flag,size,count:integer;
siz:Cardinal;
begin
    prohand:=openprocess($1F0FFF,false,proID);
    if Prohand=0 then begin  edname.Text:='批量失败!';exit; end;
       try
           for count:=0 to listtask.Items.Count-1 do
           begin
           writeadr:=strtoint('$'+leftstr(listtask.Items.Strings[count],8));
           size:= strtoint(midstr(listtask.Items.Strings[count],11,1));
           wvalue:=strtoint(midstr(listtask.Items.Strings[count],14,8));           writeProcessMemory(prohand, pointer(Writeadr),@Wvalue,size,siz);           end;
       finally
       closehandle(prohand);
       edname.Text:='批量修改成功';
       end;{end try}end;

Answer 3

太乱了。。不想看了。。自己CE然后readMemory吧。