udisk.pas

在Windows 2000/XP中读写硬盘分区,源码及运行程序

unit UDisk;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Grids, ExtCtrls;
Const GENERIC_READ  = $80000000;
      GENERIC_WRITE = $40000000;

      FILE_SHARE_READ  = $1;
      FILE_SHARE_WRITE = $2;
      OPEN_EXISTING    = $3;

      INVALID_HANDLE_VALUE = -1;

      FILE_BEGIN = 0;
      FILE_CURRENT = 1;
      FILE_END = 2;

      ERROR_SUCCESS = 0;

      IOCTL_DISK_GET_DRIVE_GEOMETRY      = $70000;//458752
      IOCTL_STORAGE_GET_MEDIA_TYPES_EX   = $2D0C04;
      IOCTL_DISK_FORMAT_TRACKS           = $7C018;
      FSCTL_LOCK_VOLUME                  = $90018;
      FSCTL_UNLOCK_VOLUME                = $9001C;
      FSCTL_DISMOUNT_VOLUME              = $90020;
      FSCTL_GET_VOLUME_BITMAP            = $9006F;


Type MEDIA_TYPE=(
  Unknown,
  F5_1Pt2_512, 
  F3_1Pt44_512, 
  F3_2Pt88_512, 
  F3_20Pt8_512, 
  F3_720_512, 
  F5_360_512, 
  F5_320_512, 
  F5_320_1024, 
  F5_180_512, 
  F5_160_512, 
  RemovableMedia, 
  FixedMedia, 
  F3_120M_512, 
  F3_640_512, 
  F5_640_512, 
  F5_720_512, 
  F3_1Pt2_512, 
  F3_1Pt23_1024, 
  F5_1Pt23_1024, 
  F3_128Mb_512, 
  F3_230Mb_512, 
  F8_256_128, 
  F3_200Mb_512, 
  F3_240M_512, 
  F3_32M_512);


Type LARGE_INTEGER=Packed Record
    lowpart :DWord;
    highpart:DWord;
End;

Type
DISK_GEOMETRY=Packed Record
    Cylinders       : LARGE_INTEGER;
    MediaType       : MEDIA_TYPE;
TracksPerCylinder   : DWord;
    SectorsPerTrack : DWord;
    BytesPerSector  : DWord;
End;

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    StrG1: TStringGrid;
    Panel2: TPanel;
    Label2: TLabel;
    EdName: TEdit;
    Label3: TLabel;
    CBox1: TComboBox;
    Label4: TLabel;
    CBox2: TComboBox;
    ChB1: TCheckBox;
    ChB2: TCheckBox;
    Label1: TLabel;
    EdSt: TEdit;
    B2: TButton;
    B1: TButton;
    B3: TButton;
    B4: TButton;
    OpenDlg: TOpenDialog;
    SaveDlg: TSaveDialog;
    ChB3: TCheckBox;
    EdFull: TEdit;
    B5: TButton;
    procedure B1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure B2Click(Sender: TObject);
    procedure StrG1KeyPress(Sender: TObject; var Key: Char);
    procedure StrG1SetEditText(Sender: TObject; ACol, ARow: Integer;
      const Value: String);
    procedure StrG1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure CBox2Change(Sender: TObject);
    procedure CBox1Change(Sender: TObject);
    procedure EdStKeyPress(Sender: TObject; var Key: Char);
    procedure ChB1Click(Sender: TObject);
    procedure ChB2Click(Sender: TObject);
    procedure B3Click(Sender: TObject);
    procedure EdNameChange(Sender: TObject);
    procedure B4Click(Sender: TObject);
    procedure EdFullKeyPress(Sender: TObject; var Key: Char);
    procedure ChB3Click(Sender: TObject);
    procedure EdFullChange(Sender: TObject);
    procedure B5Click(Sender: TObject);
    procedure EdStChange(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;


lpGeometry  :DISK_GEOMETRY; //disk info
lBufferSize :DWord;     //the buffer size of read/write

Dbuf:Array[0..4095] of Byte;

implementation

{$R *.dfm}
Function OpenDisk(FileName:String):THandle;
// 打开磁盘
Begin
Result:= CreateFile(PChar(FileName),
                        GENERIC_READ Or GENERIC_WRITE,
                        FILE_SHARE_READ Or FILE_SHARE_WRITE,
                        nil,OPEN_EXISTING,0,0);
End;

Function CloseDisk(hDisk:THandle):Boolean;
//关闭磁盘
Begin
 Result:= CloseHandle(hDisk);
End;

Function GetDiskGeometry:Boolean;
//获取磁盘参数
Var
hDisk:THandle;
  dwOutBytes:DWord;
Begin
hDisk:=CreateFile('\\.\PhysicalDrive0',  // drive to open
                    0,                // no access to the drive
                    FILE_SHARE_READ or // share mode
                    FILE_SHARE_WRITE,
                    nil,             // default security attributes
                    OPEN_EXISTING,    // disposition
                    0,                // file attributes
                    0);            // do not copy file attributes

    Result := DeviceIoControl(hDisk,IOCTL_DISK_GET_DRIVE_GEOMETRY,
                                nil, 0,@lpGeometry,Sizeof(lpGeometry),
                                dwOutBytes,nil);


    If Result Then lBufferSize := lpGeometry.BytesPerSector * lpGeometry.SectorsPerTrack;
  CloseHandle(hDisk);

End;


Function SeekAbsolute(hDisk:THandle;Pos:Integer):Boolean;
Var I:Integer;
Begin
I:=SetFilePointer(hDisk, Pos,nil, FILE_BEGIN);
    If I = -1 Then
        Result:=False
    Else
        Result:= True;
End;

Function ReadBytes(hDisk:THandle;ByteCount:DWord;DataBytes:PByte;ActuallyReadByte:DWord):Boolean;
Begin
  Result:= ReadFile(hDisk, DataBytes, ByteCount, ActuallyReadByte, nil);
End;

Function WriteBytes(hDisk:THandle;ByteCount:DWord;DataBytes:PByte):Boolean;
Var
  BytesWritten :DWord;
Begin
    Result:= WriteFile(hDisk, DataBytes, ByteCount, BytesWritten, nil)
End;

Function ReadDisk(hDisk:THandle;Cylinders:DWord;Tracks:DWord;db:PByte):Integer;
//按柱面和磁道来读取磁盘数据
Var
 iPos  :DWord;
 lRead :DWord;
Begin
lRead:=0;
    iPos := Cylinders * Tracks * lBufferSize;
    If SeekAbsolute(hDisk,iPos) Then  ReadBytes(hDisk,lBufferSize, db, lRead);
Result:=lRead;
End;

Function WriteDisk(hDisk:THandle;Cylinders:DWord;Tracks:DWord;db:PByte):Boolean;
//按柱面和磁道来写磁盘数据
Var
 iPos  :DWord;
Begin
    iPos := Cylinders * Tracks * lBufferSize;
Result:=False;
    If SeekAbsolute(hDisk,iPos) Then
        Result := WriteBytes(hDisk,lBufferSize, db);
End;

Function WriteSectors(hDev:THandle;dwStartSector:DWORD;wSectors:WORD;Var WriteCnt:DWord):Boolean;
// 对磁盘扇区数据的写入
Var
   dwCB:DWord;
Begin
  SetFilePointer(hDev,512 * dwStartSector, nil, FILE_BEGIN);
  Result:= WriteFile(hDev,dBuf, 512 * wSectors, dwCB, nil);
WriteCnt:=dwCB;
End;

Function ReadSectors(hDev:THandle;dwStartSector:DWORD;wSectors:WORD;Var ReadCnt:DWord):Boolean;
  // 对磁盘扇区数据的读取
Var
   dwCB:DWord;
Begin
  SetFilePointer(hDev, 512*dwStartSector, nil, FILE_BEGIN);
  Result:= ReadFile(hDev, dBuf, 512 * wSectors, dwCB, nil);
ReadCnt:=dwCB;
End;

procedure TForm1.FormCreate(Sender: TObject);
Var I:Integer;
begin
StrG1.ColWidths[0]:=40;
 StrG1.Cells[0,0]:='偏移';
 StrG1.Cells[17,0]:='ASCII';
 StrG1.ColWidths[17]:=115;
For I:=0 To 31 do
Begin
if I<16 Then StrG1.Cells[I+1,0]:=IntToHex(I,2);
 StrG1.Cells[0,I+1]:=IntToHex(I*16,4);
End;
end;

procedure TForm1.B1Click(Sender: TObject);
Var
    hDev:THandle;
    RCnt,St:DWord;
    R,C,N:Integer;
    S:String;
begin
R:=0;C:=0;
hDev:=OpenDisk('\\.\'+EdName.Text);

St:=StrToIntDef(EdSt.Text,0);
 ReadSectors(hDev,St,1,RCnt);
if RCnt=0 Then
Begin
  ShowMessage('读取磁盘 '+EdName.Text+' 失败');
CloseDisk(hDev);
  Exit;
End;

For N:=0 To 511 do
Begin
 if C mod 16=0 Then
  Begin
   Inc(R);
   C:=0;
   S:='';
  End;
  Inc(C);
  StrG1.Cells[C,R]:=IntToHex(dBuf[N],2);
  Case dBuf[N] of
  $0,$9,$A,$D:S:=S+'.';
  $FF:S:=S+' ';
  ELse S:=S+Chr(dBuf[N]);
  End;
  StrG1.Cells[17,R]:=S;
End;

CloseDisk(hDev);
end;

procedure TForm1.B2Click(Sender: TObject);
Var I:DWord;
    R,C,St:Integer;
    hDev:THandle;
begin
R:=0;C:=0;
 For I:=0 To 511 do
 Begin
 if C mod 16=0 Then
  Begin
   Inc(R);
   C:=0;
  End;
  Inc(C);
  dBuf[I]:=StrToInt('$'+StrG1.Cells[C,R]);
 End;
hDev:=OpenDisk('\\.\'+EdName.Text);
St:=StrToIntDef(EdSt.Text,0);
if WriteSectors(hDev,St,1,I) Then
Begin
ShowMessage('写入了 '+IntToStr(I)+'个字节');
End;

end;

procedure TForm1.StrG1KeyPress(Sender: TObject; var Key: Char);
begin
if Key=#8 Then Exit;
if Key in ['0'..'9','A'..'F','a'..'f'] Then Exit;
 Key:=#0;
end;

procedure TForm1.StrG1SetEditText(Sender: TObject; ACol, ARow: Integer;
  const Value: String);
Var B,I:Byte;
    S:String;
begin
  S:=Value;
  if Length(S)>2 Then
  Begin
   S:=Copy(S,1,2);
   StrG1.Cells[ACol,ARow]:=S;
  End;
  S:='';
For I:=1 To 16 do
 Begin
   B:=StrToIntDef('$'+StrG1.Cells[I,ARow],0);
  Case B of
  $0,$9,$A,$D:S:=S+'.';
  $FF:S:=S+' ';
  ELse S:=S+Chr(B);
  End;

 End;
StrG1.Cells[17,ARow]:=S;
end;

procedure TForm1.StrG1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
Var S:String;
    H:Integer;
    R:TRect;
    C,Fc:TColor;
    AJ:Word;
Begin
 inherited;
R:=Rect;
S:=UpperCase(StrG1.Cells[ACol,ARow]);
H:=StrG1.Canvas.TextHeight(S);
C:=StrG1.Canvas.Brush.Color;
Fc:=StrG1.Font.Color;

 R.Top:=R.Top+((Rect.Bottom-Rect.Top)-H) div 2;
 R.Bottom:=R.Top+H;

if (ACol=17)and(ARow>0) Then AJ:=DT_LEFT Else AJ:=DT_CENTER;
  StrG1.Canvas.FillRect(Rect);
  DrawText(StrG1.Canvas.Handle,PChar(s),Length(s),R,AJ or DT_Word_EllIPSIS or DT_NOPREFIX);

StrG1.Canvas.Brush.Color:=C;
StrG1.Canvas.Font.Style:=StrG1.Canvas.Font.Style-[fsBold];
StrG1.Canvas.Font.Color:=Fc;

End;

procedure TForm1.CBox2Change(Sender: TObject);
begin
EdName.Text:='';
if CBox2.ItemIndex<0 Then Exit;
EdName.Text:='PhysicalDrive'+IntToStr(CBox2.ItemIndex);
end;

procedure TForm1.CBox1Change(Sender: TObject);
begin
EdName.Text:='';
if CBox1.ItemIndex<0 Then Exit;
EdName.Text:=CBox1.Text;
end;

procedure TForm1.EdStKeyPress(Sender: TObject; var Key: Char);
begin
if Key=#8 Then Exit;
if (Key<'0')or(Key>'9') Then Key:=#0;
end;

procedure TForm1.ChB1Click(Sender: TObject);
begin
if ChB1.Checked Then
StrG1.Options:=StrG1.Options+[goEditing] Else
StrG1.Options:=StrG1.Options-[goEditing];
end;

procedure TForm1.ChB2Click(Sender: TObject);
begin
B2.Enabled:=ChB2.Checked and (StrToIntDef(EdSt.Text,0)<>0) and B1.Enabled;
end;

procedure TForm1.B3Click(Sender: TObject);
Var FP:File of Byte;
    Fn:String;
    I,FL,R,C:Integer;
    S:String;
begin
 if OpenDlg.Execute Then
 Begin
  Fn:=OpenDlg.FileName;
  AssignFile(FP,Fn);
  Reset(FP);
  FL:=FileSize(FP);

  if FL<512 Then
  Begin
   CloseFile(FP);
   ShowMessage('文件长度不够');
   Exit;
  End;
  R:=0;C:=0;
 For I:=0 To 511 do
 Begin
  Read(FP,dBuf[I]);
 if C mod 16=0 Then
  Begin
   Inc(R);
   C:=0;
   S:='';
  End;
  Inc(C);
  StrG1.Cells[C,R]:=IntToHex(dBuf[I],2);
  if dBuf[I] in [$0,$9,$A,$D]  Then S:=S+'.' Else S:=S+Chr(dBuf[I]);
  StrG1.Cells[17,R]:=S;
 End;
  CloseFile(FP);
 End;
end;

procedure TForm1.EdNameChange(Sender: TObject);
begin
B1.Enabled:=EdName.Text<>'';
B2.Enabled:=B1.Enabled and ChB2.Checked;
end;

procedure TForm1.B4Click(Sender: TObject);
Var I:DWord;
    R,C:Integer;
    FP:File of Byte;
begin
if SaveDlg.Execute Then
Begin
R:=0;C:=0;
 For I:=0 To 511 do
 Begin
 if C mod 16=0 Then
  Begin
   Inc(R);
   C:=0;
  End;
  Inc(C);
  dBuf[I]:=StrToIntDef('$'+StrG1.Cells[C,R],0);
 End;
if FileExists(SaveDlg.FileName) Then
  if MessageBox(Handle,PChar('文件:'+SaveDlg.FileName+' 已存在,你要覆盖吗?'),'覆盖提示',33)=2 Then Exit;
 AssignFile(FP,SaveDlg.FileName);
 ReWrite(FP);
 BlockWrite(FP,dBuf,512);
 CloseFile(FP);

End;
end;

procedure TForm1.EdFullKeyPress(Sender: TObject; var Key: Char);
Var S:String;
begin
if Key=#8 Then Exit;
S:=EdFull.Text;
if S='' Then
     if Key in ['$','0'..'9'] Then Exit Else Begin Key:=#0;Exit;End;

if (S[1]<>'$')Then
Begin
 if Key='$' Then Exit;
 if Key in ['0'..'9'] Then Exit Else Key:=#0;
End Else
Begin
 if Key in ['0'..'9','a'..'f','A'..'F'] Then Exit Else Key:=#0;
End;

end;

procedure TForm1.ChB3Click(Sender: TObject);
begin
EdFull.Enabled:=ChB3.Checked;
B5.Enabled:=(EdFull.Text<>'')and EdFull.Enabled;
end;

procedure TForm1.EdFullChange(Sender: TObject);
begin
B5.Enabled:=(EdFull.Text<>'')and EdFull.Enabled;
end;

procedure TForm1.B5Click(Sender: TObject);
Var N,R,C:Integer;
    B:Byte;
    S:String;
begin
R:=0;C:=0;
For N:=0 To 511 do
Begin
 if C mod 16=0 Then
  Begin
   Inc(R);
   C:=0;
   S:='';
  End;
  Inc(C);
  B:=StrToInt(EdFull.Text);
  StrG1.Cells[C,R]:=IntToHex(B,2);
  if B in [$0,$9,$A,$D]  Then S:=S+'.' Else S:=S+Chr(B);
  StrG1.Cells[17,R]:=S;
End;

end;

procedure TForm1.EdStChange(Sender: TObject);
begin
B2.Enabled:=ChB2.Checked and (StrToIntDef(EdSt.Text,0)<>0) and B1.Enabled;
end;

end.