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

📄 main.pas

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

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, Menus, ImgList, StdCtrls, ComCtrls, ToolWin,Grids,
  ExtCtrls, Buttons, DirOutln, Spin, FileCtrl;

type
  P32Regs=^T32Regs;//32位寄存器结构
  T32Regs=record
    EBX:Longint;
    EDX:Longint;
    ECX:Longint;
    EAX:Longint;
    EDI:Longint;
    ESI:Longint;
    Flags:Longint;
   end;
  TSecInfo=record
     Cylin:longword;
     Head:integer;
     Sector:integer;
     Data:array[0..512-1]of char;
  end;
  TFmain = class(TForm)
    MainMenu1: TMainMenu;
    MItemWrite: TMenuItem;
    MItemDISK: TMenuItem;
    MItemHELP: TMenuItem;
    MItemReadMBR: TMenuItem;
    MItemWriteMBR: TMenuItem;
    MItemMBRCode: TMenuItem;
    MItemReadBoot: TMenuItem;
    MItemHardDiskInfo: TMenuItem;
    MItemFormat: TMenuItem;
    MItemQuit: TMenuItem;
    MItemHelp1: TMenuItem;
    MItemShutDown: TMenuItem;
    ImageList1: TImageList;
    MItemAbout: TMenuItem;
    ToolBar1: TToolBar;
    TBtnMBR: TToolButton;
    TBtnAbout: TToolButton;
    ToolButton4: TToolButton;
    TBtnDPT: TToolButton;
    TBtnBoot: TToolButton;
    ToolButton8: TToolButton;
    TBtnCheckSys: TToolButton;
    StaBarShow: TStatusBar;
    TBtnWrite: TToolButton;
    PnlCHS: TPanel;
    HexScrollBar: TScrollBar;
    MItemLoad: TMenuItem;
    MItemSave: TMenuItem;
    MItemEdit: TMenuItem;
    N3: TMenuItem;
    MItemHDInfo: TMenuItem;
    N1: TMenuItem;
    Panel2: TPanel;
    TitleGrid: TStringGrid;
    HexGrid: TStringGrid;
    PnlSelLog: TPanel;
    GroupBox2: TGroupBox;
    GroupBox1: TGroupBox;
    GroupBox3: TGroupBox;
    BBtnYes: TBitBtn;
    BBtnNo: TBitBtn;
    ToolButton1: TToolButton;
    Panel1: TPanel;
    DrvCBox: TDriveComboBox;
    DreLBox: TDirectoryListBox;
    Panel4: TPanel;
    Label1: TLabel;
    SEditStartSec: TSpinEdit;
    Label2: TLabel;
    SEditSecCount: TSpinEdit;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    Label14: TLabel;
    Label15: TLabel;
    Label16: TLabel;
    Label17: TLabel;
    Label18: TLabel;
    Label19: TLabel;
    Label20: TLabel;
    LabOEMId: TLabel;
    LabBytesPerSec: TLabel;
    LabSecsPerClu: TLabel;
    LabResSecs: TLabel;
    LabFATCopies: TLabel;
    LabRootDir: TLabel;
    LabTotSecs: TLabel;
    LabMedia: TLabel;
    LabSecsPerFAT: TLabel;
    LabSecsPerTrack: TLabel;
    LabSides: TLabel;
    LabHideSec: TLabel;
    LabTotalSec: TLabel;
    LabPdriveNum: TLabel;
    LabEBRSign: TLabel;
    LabVolID: TLabel;
    LabVolLab: TLabel;
    LabFileSystem: TLabel;
    SaveDialog1: TSaveDialog;
    Label21: TLabel;
    LabSecsPerFAT1: TLabel;
    Label23: TLabel;
    Label22: TLabel;
    Label24: TLabel;
    Label25: TLabel;
    Label26: TLabel;
    LabExSign: TLabel;
    LabFSysVer: TLabel;
    LabRootDirClus: TLabel;
    LabFSysInfoSecs: TLabel;
    LabBootSecs: TLabel;
    GroupBox4: TGroupBox;
    Label28: TLabel;
    SEditCylins: TSpinEdit;
    Label29: TLabel;
    SEditHeads: TSpinEdit;
    Label30: TLabel;
    SEditSectors: TSpinEdit;
    Panel5: TPanel;
    GroupBox5: TGroupBox;
    GroupBox6: TGroupBox;
    Label27: TLabel;
    Label31: TLabel;
    Label32: TLabel;
    Label33: TLabel;
    PopupMenu1: TPopupMenu;
    NWrite: TMenuItem;
    NOpen: TMenuItem;
    NSave: TMenuItem;
    N6: TMenuItem;
    LabDiskTotalSecs: TLabel;
    LabDiskTotalSize: TLabel;
    Label36: TLabel;
    MItemBPB: TMenuItem;
    Edit1: TEdit;
    ToolButton5: TToolButton;
    ToolButton6: TToolButton;
    TBtnSave: TToolButton;
    TBtnOpen: TToolButton;
    MItemSaveMBR: TMenuItem;
    MItemLoadMBR: TMenuItem;
    MItemSaveBoot: TMenuItem;
    MItemLoadBoot: TMenuItem;
    OpenDialog1: TOpenDialog;
    BBtnPrint: TBitBtn;
    MItemSaveFile: TMenuItem;
    N7: TMenuItem;
    MItemAbsRead: TMenuItem;
    procedure FormCreate(Sender: TObject);
    procedure MItemReadMBRClick(Sender: TObject);
    procedure MItemHardDiskInfoClick(Sender: TObject);
    procedure StringGrid1DrawCell(Sender: TObject; ACol, ARow: Integer;
      Rect: TRect; State: TGridDrawState);
    procedure HexGridMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure HexGridMouseUp(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure HexScrollBarScroll(Sender: TObject; ScrollCode: TScrollCode;
      var ScrollPos: Integer);
    procedure FormResize(Sender: TObject);
    procedure HexGridSelectCell(Sender: TObject; ACol, ARow: Integer;
      var CanSelect: Boolean);
//    procedure HexGridDrawCell(Sender: TObject; ACol, ARow: Integer;
//      Rect: TRect; State: TGridDrawState);
    procedure HexGridKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure FormShow(Sender: TObject);
    procedure HexGridDblClick(Sender: TObject);
    procedure MItemReadCMOSClick(Sender: TObject);
    procedure MItemReadBootClick(Sender: TObject);
    procedure DrvCBoxChange(Sender: TObject);
    procedure BBtnNoClick(Sender: TObject);
    procedure BBtnYesClick(Sender: TObject);
    procedure ToolButton3Click(Sender: TObject);
    procedure LoadFileIntoHexViewer;
    procedure ShowBPBInfo;
    procedure SEditStartSecChange(Sender: TObject);
    procedure SEditCylinsChange(Sender: TObject);
    procedure MItemHDInfoClick(Sender: TObject);
    procedure MItemShutDownClick(Sender: TObject);
    procedure MItemWriteClick(Sender: TObject);
    procedure TBtnSaveClick(Sender: TObject);
    procedure MItemSaveMBRClick(Sender: TObject);
    procedure MItemSaveBootClick(Sender: TObject);
    procedure TBtnOpenClick(Sender: TObject);
    procedure MItemLoadMBRClick(Sender: TObject);
    procedure MItemLoadBootClick(Sender: TObject);
    procedure MItemFormatClick(Sender: TObject);
    procedure MItemAboutClick(Sender: TObject);
    procedure BBtnPrintClick(Sender: TObject);
    procedure MItemSaveFileClick(Sender: TObject);
    procedure MItemQuitClick(Sender: TObject);
    procedure MItemWriteMBRClick(Sender: TObject);
    procedure MItemMBRCodeClick(Sender: TObject);
    procedure MItemAbsReadClick(Sender: TObject);
    procedure MItemHelp1Click(Sender: TObject);
  private
    { Private declarations }
    FDownCoord: TGridCoord;
    FMouseDown: Boolean;
    FHexPosition: Int64;
    FBufSize:Int64;
    FCurrPosition: Int64;
    FBufferStart: Int64;
    FPositionVisible: Boolean;
    FBuffer: array of Char;  //用于显示的临时缓冲区

    procedure SetHexPosition(const Value: Int64);
    procedure SetCurrPosition(const Value: Int64);

    property HexPosition: Int64 read FHexPosition write SetHexPosition;
    property CurrPosition: Int64 read FCurrPosition write SetCurrPosition;

    procedure RepositionSelection(Coord: TGridCoord);
    procedure FillBuffer(Position: Int64);
    procedure ClearGrid;
    procedure DrawHexText(ACol, ARow: Integer; Rect: TRect);
    procedure setchange(tmpgrid: Tstringgrid; value: integer = -1);
    procedure setunselect(tmpgrid: TstringGrid);
    function HexToInt(const str:string):integer;
  public
    { Public declarations }
    procedure MouseWheelHandler(var Message: TMessage); override;
  end;
const
 MaxDrv=8;
var
  Fmain: TFmain;
  hDeviceHandle:Thandle;
  str:string;
  reg:T32Regs;
  fresult:boolean;
  cb:DWord;
  FSec:array[0..512-1] of Char;     //扇区内容存放区 ,编辑时用SetChange对本数组直接更改
   {DiskTotalSecs:longword;
   maxtracks:longword;
   mhead,msector:array[0..MaxDrv-1]of integer;
   mtrack:array[0..MaxDrv-1]of integer;
   bhead,ehead,bsector,esector:array[0..MaxDrv-1]of integer;
   btrack,etrack:array[0..MaxDrv-1]of integer;
   totalSec:array[0..MaxDrv-1]of longword;
   Sector_No,End_Sector_No,Extend_Start_No:longword;
   PartType:array[0..MaxDrv-1]of integer;
   maxParts:integer;
   }
implementation

uses Unit2, Myfunction, UnitPT, UnitShutDown, UnitFormat, UnitAbout,
  UnitPrint, UnitSaveAs, UnitAbsRead, UnitHelp;

{$R *.dfm}
procedure TFmain.DrawHexText(ACol, ARow: Integer; Rect: TRect);
begin
  {在最后一列画Ascii字符}
  with HexGrid.Canvas do begin
    Font.Color := clBlack;
    {在规定的四边形中显示字符用红色}
    TextRect(Rect, Rect.Left + 5, Rect.Top + 2, HexGrid.Cells[ACol, Arow]);  //Rect为参数
   {以相反的颜色画选中的字符}
    if (HexGrid.Selection.Left > 0) and (HexGrid.Selection.Left <=
      Length(HexGrid.Cells[ACol, ARow])) and (HexGrid.Selection.Top = ARow) and FPositionVisible then
    begin
      Brush.Color := clRed;
      Font.Color := clWhite;
      Rect.Left := Rect.Left + 5 + (HexGrid.Selection.Left - 1) * TextWidth('A'); //观察所选位置//左边有多少个(Hex表示的)字符
      Rect.Right := Rect.Left + TextWidth('A');
      Rect.Top := Rect.Top + 2;
      TextRect(Rect, Rect.Left, Rect.Top, HexGrid.Cells[ACol, ARow][HexGrid.Selection.Left]); //ACol,ARow为传入参数
    end;
  end;
end;

procedure TFmain.SetCurrPosition(const Value: Int64);
var
  ARect: TGridRect;
  ACoord: TGridCoord;
begin
  {设置当前16进制的位置}
  FCurrPosition := Value;
  {位置是否可见?}
  FPositionVisible := (FCurrPosition >= FHexPosition) and
    (FCurrPosition < FHexPosition + HexGrid.RowCount * 16);
  {如果位置可见则在Cell选中}
  if FPositionVisible then begin
    ACoord.X := (FCurrPosition - FHexPosition) mod 16 + 1;  //字符在该行中的位置
    ACoord.Y := (FCurrPosition - FHexPosition) div 16;      //字符所在行
    ARect.TopLeft := ACoord;
    ARect.BottomRight := ACoord;
    HexGrid.Selection := ARect;
  end;
end;

procedure TFmain.ClearGrid;
var
  i, j: Integer;
begin
  {清Cell中值}
  with HexGrid do
    for i := 0 to RowCount - 1 do
      for j := 0 to 17 do
        Cells[j, i] := '' {16列,其中第一列}
end;

procedure TFmain.RepositionSelection(Coord: TGridCoord);
begin
  {重新配置选中位置}
  CurrPosition := HexPosition + Coord.Y * 16 + Coord.X - 1;
  HexGrid.Repaint;
  {设置滚动条的位置}
  HexScrollBar.Position := HexPosition div 16;
end;

procedure TFmain.LoadFileIntoHexViewer;
begin
  {调整大小大小}
  FormResize(Self);
  {重设数据}
  FBufSize:=0;
  HexScrollBar.Position := 0;
  HexScrollBar.Enabled := False;
  ClearGrid;
   {头64k载入缓冲区}
    FillBuffer(0);
    if FBufSize div 16 > HexGrid.RowCount then
    begin
      {设置滚动条}
      HexScrollBar.Max := FBufSize div 16 - HexGrid.RowCount;
      if FBufSize mod 16 <> 0 then
        HexScrollBar.Max := HexScrollBar.Max + 1;
      HexScrollBar.Enabled := True;
    end;
    HexPosition := 0;
    {设置选中的位置为开始点}
    CurrPosition := 0;
    HexScrollBar.Position := 0;
end;

procedure TFmain.MouseWheelHandler(var Message: TMessage);
var
  ControlOver: TControl;
  MousePos: TPoint;
  WScrollCode: Word;
  ScrollPos: Integer;
begin
  {鼠标经过哪里?}
  MousePos.X := Message.LParamLo;
  MousePos.Y := Message.LParamHi;
  ControlOver := FindVCLWindow(MousePos);
  if Assigned(ControlOver) then begin
    with TWMMouseWheel(Message) do begin
      ScrollPos := Trunc(Abs(WheelDelta / 120));
      if WheelDelta < 0 then
        WScrollCode := SB_LINEDOWN
      else
        WScrollCode := SB_LINEUP;
      {转换wheel messages 为滚动消息}
      if (ControlOver <> HexGrid) then
        ControlOver.Perform(WM_VSCROLL, MakeLong(WScrollCode, ScrollPos), 0)
      else
        if WheelDelta < 0 then
          HexScrollBarScroll(Self, scLineDown, ScrollPos)
        else
          HexScrollBarScroll(Self, scLineUp, ScrollPos);
      Result := 1;
    end;
  end
  else
    inherited MouseWheelHandler(Message);
end;

//填充扇区临时缓冲区
procedure TFmain.FillBuffer(Position: Int64);
var
  i:integer;
begin
    if FBufSize = 0 then
        FBufSize:=Length(FSec);
    SetLength(FBuffer, Length(FSec));
    FillChar(FBuffer[0],Length(FSec)-1, #0);
    if Position < 0 then
      Position := 0;
    for i:=0 to Length(FSec)-1 do
      FBuffer[i]:=FSec[i];
    FBufferStart := Position;
end;

procedure TFmain.SetHexPosition(const Value: Int64);
var
  ByteNum: Integer;        //记录当前行的字节数
  i, j: Integer;
  CellText: string;        //用来记录那些Hex对应的ASCII字符
begin
  FHexPosition := Value;   //FHexPosition为每行字符的首地址
  if FBufSize = 0 then
    exit;
  with HexGrid do begin
   // if (FHexPosition < FBufferStart) or (FHexPosition + RowCount * 16 > FBufferStart + 256) then
   //   FillBuffer(FHexPosition - 128);
    ByteNum := FHexPosition - FBufferStart;
      {以当前的数据填充Grid}
    for i := 0 to RowCount - 1 do begin
      Cells[0, i] := IntToHex(FHexPosition + i * 16, 8);
      CellText := '';
      for j := 1 to 16 do begin
        if FBufferStart + ByteNum < FBufSize then begin
          Cells[j, i] := IntToHex(Ord(FBuffer[ByteNum]), 2);  //fBuffer 为一个字符数组
          CellText := CellText + IsChar(Ord(FBuffer[ByteNum]));
        end
        else
          Cells[j, i] := '';
        Inc(ByteNum);
      end;
      Cells[17, i] := CellText;           //在每行的第17列输出16个对应的ASCII字符
    end;
  end;
end;

{改变StringGrid中输入的值}
procedure TFmain.setchange(tmpgrid: Tstringgrid; value: integer = -1);
var
  lcol, lrow: integer;
  CValue,ShowStr: string;
  iValue: integer;
  i, j: integer;
begin
  //初始化变量
  for i := tmpgrid.Selection.left to tmpgrid.Selection.right do
    for j := tmpgrid.Selection.top to tmpgrid.Selection.bottom do
    begin
      lcol := i; //tmpgrid.col;
      lrow := j; //tmpgrid.row;
      CValue := tmpgrid.cells[lcol, lrow];
     // showmessage('['+inttostr(lcol)+','+inttostr(lrow)+']:='+CValue);
      iValue:=HexToInt(CValue);
    //  showmessage(inttostr(iValue));
      FSec[lrow*16+lcol-1]:=chr(iValue);
    end;
   // showStr:='';
   { for i:=1 to FBufSize do
      begin
        if i mod 16 =0 then showStr:=showStr+#13;
        showStr:=showStr+FSec[i];
      end;
   }
  //  showmessage(showStr);
  setunselect(tmpgrid);

end;

procedure TFmain.setunselect(tmpgrid: TstringGrid);
begin
  tmpgrid.Refresh;

⌨️ 快捷键说明

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