delphi 获取指定进程中的~内存数据


readmem.pas
unit ReadMem;

interface

uses
TLHelp32,Windows;

function GetMems(PID:longword;baseaddress:string='';len:integer=0):string;//获取指定进程中的~内存数据

implementation

function UpperCase(const S: string): string;
var
  Ch:Char;
  L:Integer;
  Source,Dest: PChar;
begin
  L := Length(S);
  SetLength(Result, L);
  Source := Pointer(S);
  Dest := Pointer(Result);
  while L <> 0 do
  begin
   Ch := Source^;
   if (Ch >= 'a') and (Ch <= 'z') then Dec(Ch, 32);
   Dest^ := Ch;
   Inc(Source);
   Inc(Dest);
   Dec(L);
  end;
end;

function HexToInt(HexStr: string): Int64;
var
  RetVar:Int64;
  i:byte;
begin
  HexStr:=UpperCase(HexStr);
  if HexStr[length(HexStr)] = 'H' then Delete(HexStr, length(HexStr), 1);
  RetVar := 0;
  for i := 1 to length(HexStr) do
  begin
   RetVar := RetVar shl 4;
   if HexStr[i] in ['0'..'9'] then
   RetVar := RetVar + (byte(HexStr[i]) - 48)
   else if HexStr[i] in ['A'..'F'] then
   RetVar := RetVar + (byte(HexStr[i]) - 55)
   else
   begin
   Retvar := 0;
   break;
   end;
  end;
  Result := RetVar;
end;

function AllocMem(Size: Cardinal): Pointer;
begin
  GetMem(Result, Size);
  FillChar(Result^, Size, 0);
end;

function StrLen(Str: PChar): Cardinal; assembler;
asm
  MOV    EDX,EDI
  MOV    EDI,EAX
  MOV    ECX,0FFFFFFFFH
  XOR    AL,AL
  REPNE   SCASB
  MOV    EAX,0FFFFFFFEH
  SUB    EAX,ECX
  MOV    EDI,EDX
end;

function Format( const fmt: string; params: array of const ): String;
asm
  PUSH    ESI
  PUSH    EDI
  PUSH    EBX
  MOV    EBX, ESP
  ADD    ESP, -2048
  MOV    ESI, ESP
  INC    ECX
  JZ    @@2
@@1:
  MOV    EDI, [EDX + ECX*8 - 8]
  PUSH    EDI
  LOOP    @@1
@@2:
  PUSH    ESP
  PUSH    EAX
  PUSH    ESI

  CALL    wvsprintf

  MOV    EDX, ESI
  MOV    EAX, @Result
  CALL    System.@LStrFromPChar

  MOV    ESP, EBX
  POP    EBX
  POP    EDI
  POP    ESI
end;

Const SE_DEBUG_NAME = 'SeDebugPrivilege' ;

procedure GetDebugPrivs;
var
  hToken: THandle;
  tkp: TTokenPrivileges;
  retval: dword;
begin
  If (OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken)) then
  begin
   LookupPrivilegeValue(nil, SE_DEBUG_NAME  , tkp.Privileges[0].Luid);
   tkp.PrivilegeCount := 1;
   tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED;
   AdjustTokenPrivileges(hToken, False, tkp, 0, nil, retval);
  end;
end;

function GetMems(PID:longword;baseaddress:string='';len:integer=0):string;
const
  FindCount=10;
var
  hProcId:DWORD;
  nOK    :THANDLE;
  addr:dword;
  buf1:array[0..FindCount] of pchar ;
  OK  :BOOL;
  nSize: DWORD;
  lpNumberOfBytesRead:cardinal;
  res,tmp:string;
  s:array[0..FindCount] of string;
  i:integer;
begin
  hProcId:= PID;
  if (hProcId =0) then exit;
  GetDebugPrivs;
  nOK :=OpenProcess(PROCESS_VM_READ,FALSE,hProcId);
  if(nOK =0) then exit;

  if len<>0 then
  begin
   addr:=HexToInt(baseaddress);
   nSize:=len ;
   buf1[0]:=AllocMem(nSize);
   OK :=ReadProcessMemory(nOK,Pointer(addr),buf1[0],nSize,lpNumberOfBytesRead);
   if(OK or (nSize<>lpNumberOfBytesRead)) then
   begin
   s[0]:='';
   for i :=0  to nSize-1 do
   begin
   s[0] := s[0] + format('%.2X',[ord(buf1[0][i])]);
   end;
   end;
   FreeMem(buf1[0], nSize);
   CloseHandle(nOK);
   tmp:=s[0];
   i:=1;
   res:='';
   while i<length(tmp) do
   begin
   res:=res+chr(HexToInt(copy(tmp,i,2)));
   inc(i,2);
   end;
   result:=res;
   exit;
  end;
end;


end.


联系电话:
020-00000000
联系电话:
020-00000000
联系电话:
020-12345678