⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 unit1.pas

📁 DirectDisk for Win2000/NT allow you to directly access physical sectors from floppy, hard disks, l
💻 PAS
字号:
unit Unit1;
interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, Menus, hexeditor, Grids, ExtCtrls;

Const IOCTL_DISK_GET_DRIVE_LAYOUT = 475148;
      IOCTL_Disk_Get_Partition_Info = 475140;
type
  TForm1 = class(TForm)
    HexEditor1: THexEditor;
    Panel1: TPanel;
    Label1: TLabel;
    Label2: TLabel;
    Edit1: TEdit;
    Button1: TButton;
    Button2: TButton;
    ComboBox1: TComboBox;
    StatusBar1: TStatusBar;
    MainMenu1: TMainMenu;
    File1: TMenuItem;
    Edit2: TMenuItem;
    Undo1: TMenuItem;
    SaveEditorToFile1: TMenuItem;
    Openfromfile1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    OpenDialog1: TOpenDialog;
    SaveDialog1: TSaveDialog;
    Fillselection1: TMenuItem;
    Selectall1: TMenuItem;
    Help1: TMenuItem;
    About1: TMenuItem;
    Safetylock1: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure ShowData;
    procedure Button1Click(Sender: TObject);
    procedure ComboBox1Change(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Button2Click(Sender: TObject);
    procedure SetEditorData;    
    procedure HexEditor1StateChanged(Sender: TObject);
    procedure ReadSector(Device:string; SectorNum:integer);
    procedure WriteSector(device:string; SectorNum:integer);
    procedure Undo1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure SaveEditorToFile1Click(Sender: TObject);
    procedure Openfromfile1Click(Sender: TObject);
    procedure Fillselection1Click(Sender: TObject);
    procedure Selectall1Click(Sender: TObject);
    procedure HexEditor1Exit(Sender: TObject);
    procedure About1Click(Sender: TObject);
    procedure Safetylock1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;





var
  Form1: TForm1;
  Sector: TMemoryStream;  // this is the sector currently shown
  CurrentDevice:string;

implementation

uses DateUtils, Unit2;

{$R *.dfm}


// returns the text associated to a Windows error code
function GetErrorString(ErrorID:Integer):String;
var P:PChar;
begin
 if FormatMessage(Format_Message_Allocate_Buffer+Format_Message_From_System,Nil,
               ErrorId,0,@P,0,Nil)<>0 then
 begin
  Result:=P;
  LocalFree(Integer(P));
 end
 else Result:=Format('Error in GetErrorString(%d) : %d',[ErrorID,GetLastError]);
end;


// this is self explaining i guess :)
function GetLastErrorString:String;
begin
 Result:=GetErrorString(GetLastError);
end;

// here is where we read physical 512-byte sector from a device
procedure TForm1.ReadSector(device:string; SectorNum:integer);
var r:THANDLE;
    e:cardinal;
    s:string;
    p:pointer;
begin
getmem(p,512);
s:='\\.\'+Device+#0;   // this is the format required by Windows API
r:=CreateFile(@s[1],GENERIC_READ, FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if r=INVALID_HANDLE_VALUE then
 begin
  showmessage('Error opening device: '+GetLastErrorString);
  exit;
 end;
SetFilePointer(r, (SectorNum*512), Nil, FILE_BEGIN);   // go to the right position
if not ReadFile(r,p^,512,e,nil) then
 begin
  showmessage('Error reading device: '+GetLastErrorString);
  exit;
 end;
if e<>512 then
 begin
  showmessage('Error reading device: read less than 512 bytes');
  exit;
 end;

sector.Seek(0,soFromBeginning);
sector.Write(p^,512); // let's load the buffer in the "sector" work space
CloseHandle(r);
freemem(p);
ShowData;  // update hexeditor
end;


procedure TForm1.WriteSector(device:string; SectorNum:integer);
var r:THANDLE;
    e:cardinal;
    s:string;
begin
if Safetylock1.Checked then
 begin
  showmessage('Safety lock is active. Please deactivate it before writing.');
  exit;
 end;
if sectornum=0 then
 if MessageDlg('You are going to overwrite the boot sector of the disk! Are you sure?',mtWarning,mbOKCancel,0)<>mrOk then exit;
s:='\\.\'+Device+#0;
r:=CreateFile(@s[1],GENERIC_WRITE, FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
if r=INVALID_HANDLE_VALUE then
 begin
  showmessage('Error opening device: '+GetLastErrorString);
  exit;
 end;
sector.Seek(0,soFromBeginning);
HexEditor1.SaveToStream(sector);
sector.Seek(0,soFromBeginning);

SetFilePointer(r, (SectorNum*512), Nil, FILE_BEGIN);
if not WriteFile(r,sector.memory^,512,e,nil) then
 begin
  showmessage('Error writing device: '+GetLastErrorString);
  exit;
 end;
if e<>512 then
 begin
  showmessage('Error writing device: wrote less than 512 bytes'); // this should never happend..
  exit;
 end;

CloseHandle(r);
HexEditor1.Modified:=false;
end;



procedure TForm1.FormCreate(Sender: TObject);
var a:cardinal;
    i:integer;
    s:string;
    r:THandle;
begin
sector:=TMemoryStream.Create;   // let's create our working buffer
sector.SetSize(512);
FillMemory(sector.memory,512,0);  // empty it
a:=GetLogicalDrives;  // windows api: put a bit for each valid drive
for i:=0 to 31 do
begin
 if (a and 1)=1 then
  begin
   ComboBox1.Items.Add(char(ord('A')+i)+':'); // add the drive to the ComboBox
  end;
 a:= a shr 1;
end;


// now let's check physical disks:
i:=0;
while true do
begin
 s:='\\.\PHYSICALDRIVE'+inttostr(i)+#0;
 r:=CreateFile(@s[1],GENERIC_READ, FILE_SHARE_WRITE or FILE_SHARE_READ, nil, OPEN_EXISTING, 0, 0);
 if r=INVALID_HANDLE_VALUE then
  begin
   if GetLastError=ERROR_FILE_NOT_FOUND then break;
   showmessage('Error checking drives: '+GetLastErrorString);
   break; // no more disks!
  end;
 ComboBox1.Items.Add('PHYSICALDRIVE'+inttostr(i));  // add it!
 CloseHandle(r);
 inc(i);
end;
ComboBox1.ItemIndex:=0;
CurrentDevice:='A:';
ShowData;
end;


// loads the shown editor data in the "sector" buffer
procedure TForm1.SetEditorData;
begin
sector.Seek(0,soFromBeginning);
HexEditor1.SaveToStream(sector);
end;

// put the sector buffer on the editor
procedure TForm1.ShowData;
begin
sector.Seek(0,soFromBeginning);
HexEditor1.LoadFromStream(sector);
end;


// perform a read
procedure TForm1.Button1Click(Sender: TObject);
begin
ReadSector(CurrentDevice,Strtoint(edit1.text));
end;

// change the current device
procedure TForm1.ComboBox1Change(Sender: TObject);
begin
CurrentDevice:=combobox1.Items[combobox1.itemindex];
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
sector.Free;
end;

// perform write
procedure TForm1.Button2Click(Sender: TObject);
begin
WriteSector(currentdevice,Strtoint(edit1.text));
end;

// user made a change in the editor
procedure TForm1.HexEditor1StateChanged(Sender: TObject);
begin
// check the behaviour of the Undo menu item
undo1.Enabled:=HexEditor1.CanUndo;
if HexEditor1.CanUndo then undo1.Caption:='&Undo: '+HexEditor1.UndoDescription
                      else undo1.Caption:='&Undo';
end;

procedure TForm1.Undo1Click(Sender: TObject);
begin
HexEditor1.Undo;
end;

procedure TForm1.Exit1Click(Sender: TObject);
begin
close;
end;


// this simply save the current sector in a binary file
procedure TForm1.SaveEditorToFile1Click(Sender: TObject);
var s:TFileStream;
begin
SetEditorData;
if SaveDialog1.Execute then
 begin
  s:=TFileStream.create(SaveDialog1.FileName,fmCreate);
  sector.Seek(0,soFromBeginning);
  s.CopyFrom(sector,512);
  s.Free;
  HexEditor1.Modified:=false;
 end;
end;

// this simply load the current sector from a binary file
procedure TForm1.Openfromfile1Click(Sender: TObject);
var s:TFileStream;
begin
if OpenDialog1.Execute then
 begin
  s:=TFileStream.create(OpenDialog1.FileName,fmOpenRead);
  if s.Size>512 then
   begin
    showmessage('File too big! Max=512');
    s.Free;
    exit;
   end;
  sector.Seek(0,soFromBeginning);
  sector.CopyFrom(s,s.size);
  ShowData;
  s.Free;
 end;
end;


// this is for filling the space in the editor (just a useful shortcut)
procedure TForm1.Fillselection1Click(Sender: TObject);
var s:string;
    i:integer;
    p:pointer;
begin
s:='00';
if not InputQuery('Fill selection','Enter a number between 0-255:',s) then exit;

try
 i:=strtoint(s);
except
 ShowMessage('Invalid input.');
 exit;
end;
if (i>255) or (i<0) then
 begin
  ShowMessage('Invalid input.');
  exit;
 end;
getmem(p,HexEditor1.SelCount);
fillmemory(p,HexEditor1.SelCount,i);
HexEditor1.ReplaceSelection(p,HexEditor1.SelCount);
freemem(p);
end;

procedure TForm1.Selectall1Click(Sender: TObject);
begin
HexEditor1.SelStart:=0;
HexEditor1.SelEnd:=HexEditor1.DataSize-1;
end;

procedure TForm1.HexEditor1Exit(Sender: TObject);
begin
SetEditorData;
end;

procedure TForm1.About1Click(Sender: TObject);
begin
aboutbox.showmodal;
end;

procedure TForm1.Safetylock1Click(Sender: TObject);
begin
if Safetylock1.Checked then
 showmessage('Warning: disks now are overwriteable! Pay attention, you may loose data! Use at your own risk.'#13#10'The autor is not responsible for any damage you may get using this program.');
Safetylock1.Checked:=not Safetylock1.Checked;
end;

end.


⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -