unit2.pas

在delphi中实现windows核心编程.原书光盘代码核心编程.原书光盘代码

unit Unit2;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    Edit3: TEdit;
    Label4: TLabel;
    Edit2: TEdit;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    pp:array of char;
  end;

var
  Form1: TForm1;
  pFuncRead,pFuncWrite,pFuncSetSeg: Pointer;
  
implementation

{$R *.DFM}

function ReadPhysMemory(Buffer:pchar;count:word):boolean;
var
   asd1,asd2:pointer;
   BufCount:dword;
begin
  result:=false;
  if pFuncRead=nil then exit;
  BufCount:=count;
  asd1:=GlobalAllocPtr16(GPTR,BufCount);
  asd2:=Ptr16To32(asd1);
  asm  //以下汇编代码中，只有第一参数、第二参数、pFunc的值是需要改变的，其余都是固定的写法
      pushad
      push ebp            //#2，保存ebp
      sub esp,$12c         //#1，预留2c字节的栈空间
      push asd1           //第一参数，如果没有参数，则不用push
      push BufCount       //第二参数，如果没有参数，则不用push
      mov edx, pFuncRead  //函数地址
      mov ebp,esp         //
      add ebp,$12c         //ebp校正，是作者分析QT_Thunk时发现的
      call  QT_Thunk
      add esp,$12c         //#1，释放上面预留的2c字节的栈空间
      pop ebp             //#2，恢复ebp
      mov byte ptr @result,al
      popad
  end;
  {释放16位指针}
  GlobalFreePtr16(asd1);
  {拷贝数据}
  move(asd2^,buffer[0],BufCount);
end;

function WritePhysMemory(Buffer:pchar;count:word):boolean;
var
   asd1,asd2:pointer;
   BufCount:dword;
begin
  result:=false;
  if pFuncRead=nil then exit;
  BufCount:=count;
  asd1:=GlobalAllocPtr16(GPTR,BufCount);
  asd2:=Ptr16To32(asd1);
  move(buffer[0],asd2^,BufCount);
  asm  //以下汇编代码中，只有第一参数、第二参数、pFunc的值是需要改变的，其余都是固定的写法
      pushad
      push ebp            //#2，保存ebp
      sub esp,$12c         //#1，预留2c字节的栈空间
      push asd1           //第一参数，如果没有参数，则不用push
      push BufCount       //第二参数，如果没有参数，则不用push
      mov edx, pFuncWrite //函数地址
      mov ebp,esp         //
      add ebp,$12c         //ebp校正，是作者分析QT_Thunk时发现的
      call  QT_Thunk
      add esp,$12c         //#1，释放上面预留的2c字节的栈空间
      pop ebp             //#2，恢复ebp
      mov byte ptr @result,al
      popad
  end;
  {释放16位指针}
  GlobalFreePtr16(asd1);
  {拷贝数据}
end;

function MySetSegment(DSegment,DOffset:word):boolean;
var
  BufSegment,BufOffset:dword;
begin
  result:=false;
  BufSegment:=DSegment;
  BufOffset:=DOffset;
  if pFuncSetSeg=nil then exit;
  asm  //以下汇编代码中，只有第一参数、第二参数、pFunc的值是需要改变的，其余都是固定的写法
      pushad
      push ebp            //#2，保存ebp
      sub esp,$2c         //#1，预留2c字节的栈空间
      push BufSegment        //第一参数，如果没有参数，则不用push
      push BufOffset         //第二参数，如果没有参数，则不用push
      mov edx, pFuncSetSeg//函数地址
      mov ebp,esp         //
      add ebp,$2c         //ebp校正，是作者分析QT_Thunk时发现的
      call  QT_Thunk
      add esp,$2c         //#1，释放上面预留的2c字节的栈空间
      pop ebp             //#2，恢复ebp
      mov byte ptr @result,al
      popad
  end;
end;

function ReadPhyMem(Segment,offset,size:word;buffer:pchar):boolean;
var
  DLLHandle: THandle16;
begin
  DllHandle:=0;
  try
      result:=false;
      DLLHandle := LoadLib16('ReadM16.DLL');
      if DllHandle<32 then exit;
      pFuncRead:=GetProcAddress16(DLLHandle, 'ReadPhysMemory');
      pFuncWrite:=GetProcAddress16(DLLHandle, 'WritePhysMemory');
      pFuncSetseg:=GetProcAddress16(DLLHandle, 'SetSegment');
      if (pFuncRead=nil)or(pFuncSetSeg=nil) then
      begin
         FreeLibrary16(DllHandle);
      end;

      MySetSegment(segment,offset);
      if not ReadPhysMemory(buffer,size) then
         exit
      else result:=true;
  finally
     if DllHandle>=32 then
        FreeLibrary16(DllHandle);
  end;
end;

function WritePhyMem(Segment,offset,size:word;buffer:pchar):boolean;
var
  DLLHandle: THandle16;
begin
  DllHandle:=0;
  try
      result:=false;
      DLLHandle := LoadLib16('ReadM16.DLL');
      if DllHandle<32 then exit;
      pFuncRead:=GetProcAddress16(DLLHandle, 'ReadPhysMemory');
      pFuncWrite:=GetProcAddress16(DLLHandle, 'WritePhysMemory');
      pFuncSetseg:=GetProcAddress16(DLLHandle, 'SetSegment');
      if (pFuncRead=nil)or(pFuncSetSeg=nil) then
      begin
         FreeLibrary16(DllHandle);
      end;

      MySetSegment(segment,offset);
      if not WritePhysMemory(buffer,size) then
         exit
      else result:=true;
  finally
     if DllHandle>=32 then
        FreeLibrary16(DllHandle);
  end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 s:string;
 i:integer;
 Segment,Offset,Size:word;
begin
  if strtoint('$'+edit1.text)>$FFFF then
  begin
    messagedlg('段地址不能超过$FFFF',mtwarning,[mbok],0);
    exit;
  end;
  Segment:=strtoint('$'+edit1.text);
  if strtoint('$'+edit2.text)>$FFFF then
  begin
    messagedlg('偏移量不能超过$FFFF',mtwarning,[mbok],0);
    exit;
  end;
  Offset:=strtoint('$'+edit2.text);
  if strtoint('$'+edit3.text)>$FFFF then
  begin
    messagedlg('不能读取超过$FFFF的数据',mtwarning,[mbok],0);
    exit;
  end;
  Size:=min(strtoint('$'+edit3.text),$10000-Offset);
  if Size=0 then exit;
  SetLength(pp,size);
  if ReadPhyMem(Segment,offset,size,@pp[0]) then
  begin
     s:='';
     for i:=0 to size-1 do
     begin
       s:=s+format('%.2x ',[ord(pp[i])]);
       if (i mod 16=15)or(i=size-1) then
          s:=s+#$D#$A;
     end;
     showmessage(s);
  end;
{  if WritePhyMem(Segment,offset,size,@pp[0]) then
  else showmessage('写内存出错，可能指定的内存不允行写.');}
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  Segment,Offset,Size:word;
  i:integer;
begin
   Segment:=$F;
   Offset:=$FFF5;
   size:=$B;
   SetLength(pp,size);
   if ReadPhyMem(Segment,offset,size,@pp[0]) then
   begin
     Listbox1.Items.Add('BIOS日期：'+string(pp));
   end;

   //串口
   Segment:=$0;
   Offset:=$400;
   size:=$E;
   SetLength(pp,size);
   if ReadPhyMem(Segment,offset,size,@pp[0]) then
   begin
      for i:=0 to 3 do
      begin
         listbox1.Items.add(format('串口%d输入/输出范围: %X',[i+1,pword(@pp[i*2])^]));
      end;
      for i:=0 to 2 do
      begin
         listbox1.Items.add(format('并口%d输入/输出范围: %X',[i+1,pword(@pp[8+i*2])^]));
      end;
   end;
end;

end.