www.pudn.com > RD_HD.rar > UDisk.pas
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.