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

📄 main.pas

📁 界面精美
💻 PAS
📖 第 1 页 / 共 3 页
字号:
end;

function TFmain.HexToInt(const str:string):integer;
var
  temp,mi,i,j:integer;
begin
   temp:=0;
   for i:=1 to length(str) do
     begin
       mi:=1;
      // showmessage(str[i]);
       for j:=1 to (length(str)-i) do
         mi:=mi*16;
       case str[i]of
       '0'..'9':
         temp:=temp+StrToInt(str[i]) mod 10 * mi;
       'a'..'f':
         temp:=temp+(Ord(str[i])-Ord('a')+10) * mi;
       'A'..'F':
         temp:=temp+(Ord(str[i])-Ord('A')+10) * mi;
       end;  //end of case
     end;  //end of for
   result:=temp;
end;

//--------对物理磁盘加锁,解锁
function LockDisk(VMM32Handle:cardinal;disk:byte;LockOrNot:boolean):boolean;
var
  R:T32Regs;
  cb:DWord;
begin
{对物理磁盘加锁,解锁,第一参数是VMM32的文件句柄,第二参数是磁盘编号,
软盘从0开始,硬盘从$80开始 }
  if(VMM32Handle=INVALID_HANDLE_VALUE)then
  begin
    result:=false;
    exit;
  end;
  fillchar(r,sizeof(r),0);
  if LockOrNot=true then
   begin
     R.ECX:=$084b;
     R.EBX:=$100+disk;
     R.EDX:=1;   //1允许写,0允许格式化
   end
  else
   begin
     R.ECX:=$086b;
     R.EBX:=disk;
   end;
   R.EAX:=$440d;
   DeviceIOControl(VMM32Handle,VWIN32_DIOC_DOS_IOCTL,@R,SizeOf(R),@R,
       SizeOf(R),cb,nil);
   Result:=(R.Flags and 1 =0);
end;

//-----------对逻辑磁盘加锁,解锁
function LockDrive(VMM32Handle:cardinal;drive:byte;LockOrNot:boolean):boolean;
var
  R:T32Regs;
  cb:DWord;
begin
{对逻辑磁盘加锁,解锁,第一参数是VMM32的文件句柄,第二参数是磁盘编号,
1:A, 2: B, 3: C, 4: D ……}
  if(VMM32Handle=INVALID_HANDLE_VALUE)then
   begin
     result:=false;
     exit;
   end;
  fillchar(r,sizeof(r),0);
  if LockOrNot=true then
   begin
     R.ECX:=$084a;
     R.EBX:=$100+drive;
     R.EDX:=1;    //1允许写, 0允许格式化
   end
  else
   begin
     R.ECX:=$086a;
     R.EBX:=drive;
   end;
  R.EAX:=$440d;
  DeviceIoControl(VMM32Handle,VWIN32_DIOC_DOS_IOCTL,@R,SizeOf(R),@R,
         SizeOf(R),cb,nil);
  Result:=(R.Flags and 1=0);
end;


procedure TFmain.FormCreate(Sender: TObject);
begin
//  SearchDrivers();
  //初始化
  OpenDialog1.FileName:='';
  OpenDialog1.InitialDir:=ExtractFileDir(Application.ExeName);
  SaveDialog1.FileName:='';
  SaveDialog1.InitialDir:=ExtractFileDir(Application.ExeName);
  MItemSaveMBR.Enabled:=false;
  MItemSaveBoot.Enabled:=false;
  MItemWrite.Enabled:=false;
  TBtnSave.Enabled:=false;
  TBtnWrite.Enabled:=false;
  PnlCHS.Visible:=false;
  StaBarShow.Panels.Items[0].Text:='当前系统:'+GetOSName(GetOSVersion());
end;

procedure TFmain.MItemReadMBRClick(Sender: TObject);
var
  buf:array[0..512-1] of char;
  i:integer;
begin
   ReadAnyPSec(0,buf);
   for i:=0 to 512-1 do
     FSec[i]:=buf[i];
   SEditCylins.Value:=0;
   SEditHeads.Value:=0;
   SEditSectors.Value:=1;
   PnlCHS.Visible:=true;
   LoadFileIntoHexViewer; {把文件以16进制读入StringGrid中}
   MItemSaveMBR.Enabled:=true;
   MItemSaveBoot.Enabled:=true;
   MItemWrite.Enabled:=true;
   NWrite.Enabled:=true;
   NSave.Enabled:=true;
   TBtnSave.Enabled:=true;
   TBtnWrite.Enabled:=true;
end;

procedure TFmain.MItemHardDiskInfoClick(Sender: TObject);
begin
   form2.Show;
end;

procedure TFmain.StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
var
  lRow, lCol: Longint;

begin
  lRow := ARow;
  lCol := ACol;
  with Sender as TStringGrid, Canvas do
  begin
    if (gdSelected in State) then
      Brush.Color :=$00EFD2C2 //clHighlight; //选中颜色
    else
    begin
      if (gdFixed in State) then //Fixcolor的颜色
        Brush.Color := FixedColor
    end;
    Font.Color := clblack;

    FillRect(Rect);
    SetBkMode(Handle, TRANSPARENT);
    SetTextAlign(Handle, TA_RIGHT);
    TextOut(Rect.Right - 2, Rect.Top + 2, Cells[lCol, lRow]);
  end;

end;

procedure TFmain.HexGridMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  CurrRect: TRect;
begin
  {处理鼠标按下消息,避免改变选中的位置}
  if Sender = HexGrid then
    with TStringGrid(Sender) do begin
      FMouseDown := True;
      FDownCoord := MouseCoord(X, Y);
      if FDownCoord.X = 17 then begin
        CurrRect := CellRect(FDownCoord.X, FDownCoord.Y);
        FDownCoord.X := (X - CurrRect.Left - 5) div Canvas.TextWidth('0') + 1;
      end;
      if FDownCoord.X > 0 then
        RepositionSelection(FDownCoord);
    end;
end;


procedure TFmain.HexGridMouseUp(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
var
  UpCoord: TGridCoord;
  CurrRect: TRect;
begin
  FMouseDown := False;
  if Sender = HexGrid then
    with TStringGrid(Sender) do begin
      UpCoord := MouseCoord(X, Y);
      if UpCoord.X = 17 then begin
        CurrRect := CellRect(UpCoord.X, UpCoord.Y);
        UpCoord.X := (X - CurrRect.Left - 5) div Canvas.TextWidth('0') + 1;
      end;
      if (UpCoord.X > 0) and ((UpCoord.X <> FDownCoord.X) or (UPCoord.Y <> FDownCoord.Y)) then
        RepositionSelection(UpCoord);
    end;
end;

procedure TFmain.HexScrollBarScroll(Sender: TObject;
  ScrollCode: TScrollCode; var ScrollPos: Integer);
begin
  {处理滚动消息}
  case ScrollCode of
    scLineUp: if HexPosition >= 16 then
        HexPosition := HexPosition - 16;
    scLineDown: if (HexPosition + HexGrid.VisibleRowCount * 16 < FBufSize) then
        HexPosition := HexPosition + 16;
    scPageUp: if HexPosition > HexGrid.VisibleRowCount * 16 then
        HexPosition := HexPosition - HexGrid.VisibleRowCount * 16
      else
        HexPosition := 0;
    scPageDown: if (HexPosition + (HexGrid.VisibleRowCount + 1) * 32 < FBufSize {FFileSize}) then
        HexPosition := HexPosition + HexGrid.VisibleRowCount * 16;
    scTrack,
      scPosition: if ((ScrollPos + HexGrid.VisibleRowCount) * 16 < FBufSize{FFileSize}) then
        HexPosition := ScrollPos * 16
      else
        HexPosition := ((FBufSize{FFileSize} - HexGrid.VisibleRowCount * 16) div 16 + 1) * 16;
  end;
  CurrPosition := FCurrPosition;
  ScrollPos := HexPosition div 16;
  HexGrid.SetFocus;
end;

procedure TFmain.FormResize(Sender: TObject);
var
  RowCount: Integer;
  MaxScroll: Integer;
begin
  {获取新一行}
  RowCount := HexGrid.Parent.ClientHeight div HexGrid.RowHeights[0];
  if RowCount = 0 then
    RowCount := 1;
  HexGrid.RowCount := RowCount;
  {设置滚动条的最大值}
  if FBufSize > 0 then begin
    MaxScroll := FBufSize div 16 - HexGrid.RowCount;
    if FBufSize mod 16 > 0 then
      Inc(MaxScroll);
    if MaxScroll <= 0 then
      //HexScrollBar.Enabled := False
      MaxScroll := FBufSize div 16
    else
      HexScrollBar.Max := MaxScroll;
  end;
  SetHexPosition(FHexPosition);
end;

procedure TFmain.HexGridSelectCell(Sender: TObject; ACol, ARow: Integer;
  var CanSelect: Boolean);
begin
  CanSelect := (ACol <> 17) and (not FMouseDown) and (FBufSize{FFileSize} > 0) and FPositionVisible;
  if CanSelect then
    CanSelect := (HexPosition + ARow * 16 + ACol <= FBufSize{FFileSize});
end;

{procedure TFmain.HexGridDrawCell(Sender: TObject; ACol, ARow: Integer;
  Rect: TRect; State: TGridDrawState);
begin
  //当Cell重画时调用此函数
  if ACol = 17 then
    DrawHexText(ACol, ARow, Rect)
  else if (gdSelected in State) then begin
    //如果位置为可见区,则画选中的的字符
    if FPositionVisible then begin
      HexGrid.Canvas.Brush.Color := clHighlight;
      HexGrid.Canvas.Font.Color := clWhite;
    end;
    HexGrid.Canvas.TextRect(Rect, Rect.Left + 2, Rect.Top + 2, HexGrid.Cells[ACol, Arow]);
  end;
end;
}
procedure TFmain.HexGridKeyDown(Sender: TObject; var Key: Word;
  Shift: TShiftState);
var
  OldPosition: Int64;
begin
  //处理按键}
  OldPosition := CurrPosition;
  case Key of
    VK_Up: if CurrPosition >= 16 then
        CurrPosition := CurrPosition - 16;
    VK_Prior: if CurrPosition > HexGrid.VisibleRowCount * 16 then
        CurrPosition := CurrPosition - HexGrid.VisibleRowCount * 16
      else
        CurrPosition := 0;
    VK_Down: if (CurrPosition + 16 < FBufSize) then
        CurrPosition := CurrPosition + 16;
    VK_Next: if (CurrPosition + HexGrid.VisibleRowCount * 16 < FBufSize) then
        CurrPosition := CurrPosition + HexGrid.VisibleRowCount * 16;
    VK_Home: if Shift = [ssCtrl] then
        CurrPosition := 0
      else
        CurrPosition := CurrPosition div 16 * 16;
    VK_End: if Shift = [ssCtrl] then
        CurrPosition := FBufSize - 1
      else
        CurrPosition := ((CurrPosition div 16) + 1) * 16 - 1;
    VK_Left: if CurrPosition > 0 then
        CurrPosition := CurrPosition - 1;
    VK_Right: if CurrPosition < FBufSize - 1 then
        CurrPosition := CurrPosition + 1;
  end;
  Key := 0;
  if OldPosition <> CurrPosition then begin
    //如果非可见的,则设当前的位置为视图区
    if not FPositionVisible then
      if OldPosition > CurrPosition then
        HexPosition := CurrPosition div 16 * 16 
      else
        HexPosition := ((CurrPosition div 16) +1) * 16 - HexGrid.RowCount* 16;
    CurrPosition := FCurrPosition;
    HexGrid.Repaint;
  end;
  //设置新的Grid初始位置
  HexScrollBar.Position := HexPosition div 16;
end;


procedure TFmain.FormShow(Sender: TObject);
var
  i:integer;
  Mybuf:array[0..512-1] of char;
  DiskTotalSecs:Int64;
  DiskTotalSize:double;
//  MItemEDPT:TMenuItem;
begin
//  MItemEDPT:=TMItemEDPT.Create(application);
//  MItemEDPT.Caption:='DPT of D';
//  MItemExtendDPT.Insert(0,MItemEDPT);
  //初始化列表框的表头
  for i:=0 to 17 do
    case i of
    0:
           TitleGrid.Cells[i,0]:='LBA\EA :';
    1..16:
           TitleGrid.Cells[i,0]:=IntToHex(i-1,2);
    17:
             TitleGrid.Cells[i,0]:='0123456789ABCDEF';
    end;  //end of case

  //标准的256个ASCII字符输入
  for i:=0 to 255 do
     FSec[i]:=chr(i);
  try
    ReadAnyPSec(0,Mybuf);
    DiskTotalSecs:=(integer(Mybuf[$1cd])+integer(Mybuf[$1dd]))*16777216
                  +(integer(Mybuf[$1cc])+integer(Mybuf[$1dc]))*65536
                  +(integer(Mybuf[$1cb])+integer(Mybuf[$1db]))*256
                  +(integer(Mybuf[$1ca])+integer(Mybuf[$1da]))+63; //63为MBR引导磁道的扇区数
     SEditCylins.MaxValue:=DiskTotalSecs div(63*255);
     LabDiskTotalSecs.Caption:=IntToStr(DiskTotalSecs);
     DiskTotalSize:=DiskTotalSecs*512/(1000*1000*1000);
     LabDiskTotalSize.Caption:=format('%.2f GB',[DiskTotalSize]);
     LoadFileIntoHexViewer; {把文件以16进制读入StringGrid中}
   except
     showmessage('不能读MBR');
   end;  // end of try  
end;

procedure TFmain.HexGridDblClick(Sender: TObject);
begin
  setchange(Sender as TstringGrid);  {改变StringGrid中输入的值}
  LoadFileIntoHexViewer; {把文件以16进制读入StringGrid中}
end;

procedure TFmain.MItemReadCMOSClick(Sender: TObject);
begin
  showmessage(GetBios(4));
end;

procedure TFmain.MItemReadBootClick(Sender: TObject);
var
  BPBbuf:array[0..512-1] of char;
  i:integer;
  str:string;
begin
   ShowBPBInfo;
   TBtnSave.Enabled:=false;
   TBtnWrite.Enabled:=false;
   TBtnOpen.Enabled:=false;
   fmain.PopupMenu1.AutoPopup:=false;
   PnlSelLog.Visible:=True;
   HexScrollBar.Visible:=false;
   PnlCHS.Visible:=false;
   PnlCHS.Align:=alNone;
end;

procedure TFmain.DrvCBoxChange(Sender: TObject);
begin
   DreLBox.Drive:=DrvCBox.Drive;
   showBPBInfo;
end;

procedure TFmain.BBtnNoClick(Sender: TObject);
begin
  PnlCHS.Align:=alBottom;
  PnlCHS.Visible:=true;
  HexScrollBar.Visible:=true;
  PnlSelLog.Visible:=false;

end;

procedure TFmain.BBtnYesClick(Sender: TObject);
var
  buf:array[0..512-1] of char;
  i,DrvOrd,bHead1,bSector1:integer;
  bCylin:longword;
  SectorStart,Temp:Longword;
begin
      // SearchDrivers();
    TBtnWrite.Enabled:=false;
    MItemWrite.Enabled:=false;
    SEditCylins.Enabled:=false;
    SEditHeads.Enabled:=false;
    SEditSectors.Enabled:=false;
//    SEditCylins.Value:=bTrack[DrvOrd];
//    SEditHeads.Value:=bHead[DrvOrd];
//    SEditSectors.Value:=bSector[DrvOrd];
    SEditCylins.Enabled:=true;
    SEditHeads.Enabled:=true;
    SEditSectors.Enabled:=true;

    SectorStart:=longword(SEditStartSec.Value);
    ReadAnyLSec(DrvCBox.Drive,SectorStart,buf);  //读取所选逻辑盘的0号扇区
    for i:=0 to 512-1 do
       FSec[i]:=buf[i];
    LoadFileIntoHexViewer; {把文件以16进制读入StringGrid中}
    DrvOrd:=ord(DrvCBox.Drive)-ord('c');


  //下面为显示设置
  fmain.PopupMenu1.AutoPopup:=true;
  PnlCHS.Align:=alBottom;
  PnlCHS.Visible:=false;
  HexScrollBar.Visible:=true;
  PnlSelLog.Visible:=false;

   MItemSaveMBR.Enabled:=true;
   MItemSaveBoot.Enabled:=true;
  // MItemWrite.Enabled:=true;
  // NWrite.Enabled:=true;
   NSave.Enabled:=true;   
   TBtnSave.Enabled:=true;
   //TBtnWrite.Enabled:=true;
   TBtnOpen.Enabled:=true;
end;

procedure TFmain.ToolButton3Click(Sender: TObject);
const
  disk=0;//0表示A盘
var
  boot:array[0..512-1]of byte; //一个扇区的大小
  str:string;
  i:integer;
begin
  hDeviceHandle:=CreateFile('\\.\VWIN32',GENERIC_READ or GENERIC_WRITE,
  FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,
  FILE_FLAG_DELETE_ON_CLOSE,0);
    if(hDeviceHandle<>INVALID_HANDLE_VALUE)then
     begin
       reg.EAX:=$0201;{ah=02 表示读,al=01 表示1个扇区}
       reg.EBX:=Integer(@boot);{缓冲区}
       reg.ECX:=0001;
       reg.EDX:=disk;{只能读软盘,0:A, 1: B}
       reg.Flags:=0;
      fresult:=DeviceIoControl(hDeviceHandle,VWIN32_DIOC_DOS_INT13,@reg,
      sizeof(reg),@reg,sizeof(reg),cb,nil);

⌨️ 快捷键说明

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