unitmain.pas

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

unit UnitMain;

interface

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

const
  FILE_DEVICE_UNKNOWN = $00000022;
  METHOD_NEITHER = 3;
  FILE_ANY_ACCESS = 0;
  {命令码消息}
  DIOC_MY1 = FILE_DEVICE_UNKNOWN shl 16 +
    1 shl 2 +
    METHOD_NEITHER +
    FILE_ANY_ACCESS shl 14;
type
  TForm1 = class(TForm)
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    Button3: TButton;
    Edit2: TEdit;
    Edit3: TEdit;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  vxd: longword;
  filename: string;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  if button1.Caption = '开始' then
  begin
      {应用程序用CreateFile打开VxD}
    vxd := createfile(pchar('\\.\' + edit1.text), 0, 0, nil, Create_new, File_Flag_Delete_On_Close, 0);
    if vxd = invalid_handle_value then
    begin
      filename := extractfilename(edit1.text);
      copyfile(pchar(edit1.text), pchar(filename), false);
      vxd := createfile(pchar('\\.\' + filename), 0, 0, nil, Create_new, File_Flag_Delete_On_Close, 0);
      if vxd = invalid_handle_value then deletefile(filename);
    end
    else filename := '';
    if vxd <> invalid_handle_value then button1.Caption := '结束'
    else showmessage('打开文件错误');
  end
  else begin
    closehandle(vxd); {关闭或动态卸下VxD}
    if filename <> '' then deletefile(filename);
    button1.Caption := '开始';
  end;
end;

procedure TForm1.FormShow(Sender: TObject);
begin
  SetCurrentDirectory(PChar(extractfilepath(paramstr(0))));
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  OpenDialog1.FileName := edit1.text;
  if OpenDialog1.Execute then
    edit1.text := OpenDialog1.FileName;
end;

procedure TForm1.Button3Click(Sender: TObject);
type
  TInBuffer = record
    ReadOrNot: BOOL; {True:Read, False:Write}
    Disk: integer; { $80硬盘}
    StartSecLo, StartSecHi: longword; {开如扇区，结束扇区}
    SecCount: longword; {扇区数}
  end;
var
  RecBytes: Cardinal;
  InBuffer: TInBuffer;
  OutBuffer: pchar;
  SEC, i, j: integer;
  s: string;
  StartSec:int64;
begin
  SEC := strtoint(edit3.text);
  getmem(OutBuffer, SEC * 512);
  InBuffer.ReadOrNot := True;
  InBuffer.Disk := $80;
  StartSec:=strtoint64(edit2.text);
  InBuffer.StartSecHi := StartSec shr 32;
  InBuffer.StartSecLo := StartSec and $FFFFFFFF;
  InBuffer.SecCount := SEC;
  if DeviceIoControl(vxd, DIOC_MY1, @InBuffer, sizeof(InBuffer), @OutBuffer[0], SEC * 512, RecBytes, nil) and
     (RecBytes = SEC * 512) then
  begin
    for j := 0 to SEC - 1 do
    begin
      s := '';
      for i := 0 to 512 - 1 do
      begin
        s := s + format('%.2x ', [ord(outbuffer[j * 512 + i])]);
        if i mod 16=15 then s:=s+#13;
      end;
      showmessage(s);
    end;
     InBuffer.ReadOrNot:=False;
     InBuffer.Disk:=$80;
     InBuffer.StartSecHi:= StartSec shr 32;
     InBuffer.StartSecLo:= StartSec and $FFFFFFFF;
     InBuffer.SecCount:=SEC;
     if DeviceIoControl(vxd,DIOC_MY1,@InBuffer,sizeof(InBuffer),@OutBuffer[0],SEC *512,RecBytes,nil) and
        (RecBytes<>SEC *512) then showmessage('写扇区错误');
  end;
  freemem(OutBuffer, SEC * 512);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  if Button1.Caption = '结束' then Button1Click(Sender);
end;

end.