fm_iopm1.pas

在Windows NT使用I/O端口,包括装载,开始,卸载驱动程序的函数.

unit fm_IOPM1;
{ PortTest program  IOPM form

Revisions
---------
98-06-01 GW Original

Copyright info: see main form unit
}
interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  Grids, ExtCtrls, StdCtrls,
  gwiopm;

type
  Tfm_IOPM = class(TForm)
    sg_Heads: TStringGrid;
    sg_IOPM: TStringGrid;
    lb_Scratch: TLabel;
    GroupBox3: TGroupBox;
    Image1: TImage;
    bt_Activate_KIOPM: TButton;
    bt_Query_KIOPM: TButton;
    bt_GetIOPM: TButton;
    bt_Clear: TButton;
    Label3: TLabel;
    Label1: TLabel;
    Label2: TLabel;
    bt_Deactivate_KIOPM: TButton;
    procedure FormCreate(Sender: TObject);
    procedure sg_IOPMSelectCell(Sender: TObject; Col, Row: Integer;
      var CanSelect: Boolean);
    procedure sg_IOPMEnter(Sender: TObject);
    procedure sg_IOPMExit(Sender: TObject);
    procedure bt_ClearClick(Sender: TObject);
    procedure bt_Activate_KIOPMClick(Sender: TObject);
    procedure bt_GetIOPMClick(Sender: TObject);
    procedure bt_Query_KIOPMClick(Sender: TObject);
    procedure bt_Deactivate_KIOPMClick(Sender: TObject);
  private
    { Private declarations }
    sg_IOPM_EditCol  : integer;
    sg_IOPM_EditRow  : integer;
    sg_IOPM_EditValue: string;

    procedure  sg_IOPM_Init;
    procedure  sg_Hex_Init(AIOPM: PIOPM);
    procedure  UpdateBinFromHex(RowNum: integer);
    procedure  UpdateHexFromBin(RowNum: integer);

    procedure  sg_IOPM_EditClear;
    procedure  sg_IOPM_Editing(NewCol, NewRow: integer);
    procedure  sg_IOPM_EditCommitCheck(NewCol, NewRow: integer);
    procedure  sg_IOPM_EditCommit; // OldCol, OldRow

    procedure EditValueChangeCheck;
    procedure EditValueChanged;

    function ByteFake: byte;
  public
    { Public declarations }
  end;

var
  fm_IOPM: Tfm_IOPM;

Const
  IOPM_AddrBase  = 0;
  IOPM_AddrCount = $1000;  { ie: do only the ISA bus for this demo }
  IOPM_WordCount = IOPM_AddrCount div 16; { rows in table }

//==========================================================
implementation
//==========================================================

uses fm_BaseCount1, gwutil_1, PortTestU1;

{$R *.DFM}

Type
  Tgcf1 = (gcf_Addr, gcf_IOPM);

  TColInfo = record
    Width: integer;
    Caption: string;
    Func: Tgcf1;
    Base:  shortint;   //0-7, 10=decimal, 16=hex, -1 = none
  end;

Const
  { grid col constants }
  gc_Begin  =  0;
  gc_AddHex =  0; gc_AddDec =  1;
  gc_Hex    =  2;
  gc_15 =  3; gc_14 =  4; gc_13 =  5; gc_12 =  6;
  gc_11 =  7; gc_10 =  8; gc_09 =  9; gc_08 = 10;
  gc_07 = 11; gc_06 = 12; gc_05 = 13; gc_04 = 14;
  gc_03 = 15; gc_02 = 16; gc_01 = 17; gc_00 = 18;
  gc_End    = gc_00;
  gc_Count = gc_End-gc_Begin+1;

  gcb_Dec   = -10;
  gcb_Hex   = -16;

  MainColInfo : array[gc_Begin..gc_End] of TColInfo = (
    (Width: 40; Caption: 'Hex' ; Func: gcf_Addr ;  Base: gcb_Hex ),
    (Width: 40; Caption: 'Dec' ; Func: gcf_Addr ;  Base: gcb_Dec ),

    (Width: 40; Caption: 'Hex' ; Func: gcf_IOPM ;  Base: gcb_Hex ),

    (Width: 16; Caption: 'F'   ; Func: gcf_IOPM ;  Base: 15 ),
    (Width: 16; Caption: 'E'   ; Func: gcf_IOPM ;  Base: 14 ),
    (Width: 16; Caption: 'D'   ; Func: gcf_IOPM ;  Base: 13 ),
    (Width: 16; Caption: 'C'   ; Func: gcf_IOPM ;  Base: 12 ),
    (Width: 16; Caption: 'B'   ; Func: gcf_IOPM ;  Base: 11 ),
    (Width: 16; Caption: 'A'   ; Func: gcf_IOPM ;  Base: 10 ),
    (Width: 16; Caption: '9'   ; Func: gcf_IOPM ;  Base:  9 ),
    (Width: 16; Caption: '8'   ; Func: gcf_IOPM ;  Base:  8 ),

    (Width: 16; Caption: '7'   ; Func: gcf_IOPM ;  Base:  7 ),
    (Width: 16; Caption: '6'   ; Func: gcf_IOPM ;  Base:  6 ),
    (Width: 16; Caption: '5'   ; Func: gcf_IOPM ;  Base:  5 ),
    (Width: 16; Caption: '4'   ; Func: gcf_IOPM ;  Base:  4 ),
    (Width: 16; Caption: '3'   ; Func: gcf_IOPM ;  Base:  3 ),
    (Width: 16; Caption: '2'   ; Func: gcf_IOPM ;  Base:  2 ),
    (Width: 16; Caption: '1'   ; Func: gcf_IOPM ;  Base:  1 ),
    (Width: 16; Caption: '0'   ; Func: gcf_IOPM ;  Base:  0 )
  );

  gch_Begin  =  0;
  gch_Add    =  0;
  gch_BitVal =  1;
  gch_Dummy  =  2;
  gch_End    =  2;

  gch_Count = gch_End-gch_Begin+1;

  HeadColInfo : array[gch_Begin..gch_End] of TColInfo = (
    (Width: 80+1;      Caption: 'IOPM Word' ),
    (Width: 40+ 16*17;  Caption: 'Bit/Value'    ),
    (Width: 0;         Caption: ''             )
  );

//----------------------------------------------
function Tfm_IOPM.ByteFake: byte;
//----------------------------------------------
Begin
  result := Random(255);
end;

//----------------------------------------------
procedure Tfm_IOPM.UpdateBinFromHex(RowNum: integer);
//----------------------------------------------
Var
  HexVal, B, N: integer;
  BitChar: char;
Label the_end;
Begin
  HexVal := HexToIntDef(sg_IOPM.Cells[gc_Hex,RowNum], -1);

  For N := 0 to 15 do
  Begin
    BitChar := '1';
    B := 1 shl N;
    If (B and HexVal) = 0 then BitChar := '0';
    sg_IOPM.Cells[gc_00-N,RowNum] := BitChar;
  end;
the_end:
end;

//----------------------------------------------
procedure Tfm_IOPM.UpdateHexFromBin(RowNum: integer);
//----------------------------------------------
Var
  HexVal, B, N: integer;
  BitChar: char;
Label the_end;
Begin
  HexVal := 0;
  For N := 0 to 15 do
  Begin
    BitChar := (sg_IOPM.Cells[gc_00-N,RowNum] + '1')[1];
    If BitChar = '1' then
    Begin
      B := 1 shl N;
      HexVal := HexVal or B;
    end;
  end;
  sg_IOPM.Cells[gc_Hex,RowNum] := IntToHex(HexVal, 4);
the_end:
end;

//----------------------------------------------
procedure Tfm_IOPM.sg_IOPM_Init;
//----------------------------------------------
Var
  AddrIx, RowNum: integer;
Begin
  sg_IOPM.RowCount := 1 + IOPM_WordCount;

  For AddrIx := 0 to IOPM_WordCount-1 do
  Begin
    RowNum := AddrIx + 1;
    sg_IOPM.Cells[gc_AddHex , RowNum] := '0'+IntToHex(IOPM_AddrBase+AddrIx,2)+'x';
    sg_IOPM.Cells[gc_AddDec , RowNum] := IntToStr(IOPM_AddrBase+AddrIx * 16)+'+';
  end;
end;

//----------------------------------------------
procedure Tfm_IOPM.sg_Hex_Init(AIOPM: PIOPM);
//----------------------------------------------
Var
  AddrIx, RowNum, ByteNum: integer;
   SW: string;
   Save_Cursor:TCursor;

Begin
  Save_Cursor := Screen.Cursor;
  Screen.Cursor := crHourglass;    { Show hourglass cursor }

  try
    For AddrIx := 0 to IOPM_SIZE-1 do
    Begin

      ByteNum := AddrIx and 1; { get lowest bit }
      Case ByteNum of
        0: Begin
          if AIOPM = nil then SW := 'FF'
          else SW := IntToHex(AIOPM^[AddrIx],2);
        end;
        1: Begin
          if AIOPM = nil then SW := 'FF' + SW
          else SW := IntToHex(AIOPM^[AddrIx],2) + SW;

          RowNum := 1 + (AddrIx shr 1);
          sg_IOPM.Cells[gc_Hex , RowNum] := SW;
          UpdateBinFromHex(RowNum);
        end;
      end; { case }
    end; { for }
  finally
    Screen.Cursor := Save_Cursor;  { Always restore to normal }
  end;
end;

//----------------------------------------------
procedure Tfm_IOPM.FormCreate(Sender: TObject);
//----------------------------------------------
Var
  ColNum: integer;

begin
  // Set up string grids
  sg_IOPM.ColCount := gc_Count;
  For ColNum := gc_Begin to gc_End do
  Begin
    sg_IOPM.ColWidths[ColNum] := MainColInfo[ColNum].Width;
    sg_IOPM.Cells[ColNum,0]   := MainColInfo[ColNum].Caption;
  end;

  sg_Heads.ColCount := gch_Count;
  For ColNum := gch_Begin to gch_End do
  Begin
    sg_Heads.ColWidths[ColNum] := HeadColInfo[ColNum].Width;
    sg_Heads.Cells[ColNum,0]   := HeadColInfo[ColNum].Caption;
  end;

  sg_IOPM_Init;
  sg_Hex_Init(nil);
  sg_IOPM_EditClear;
end;

//--------------------------------------------------
procedure Tfm_IOPM.sg_IOPMSelectCell(Sender: TObject; Col, Row: Integer;
  var CanSelect: Boolean);
//--------------------------------------------------
Var
  CellRect: TRect;
begin
  CanSelect := (
    (MainColInfo[Col].Func = gcf_IOPM) and
      ((MainColInfo[Col].Base >= 0) or (MainColInfo[Col].Base = gcb_Hex))
    );

  sg_IOPM_EditCommitCheck(Col, Row);
  sg_IOPM_Editing(Col, Row);
end;

//------------------------------------------------
procedure Tfm_IOPM.sg_IOPMEnter(Sender: TObject);
//------------------------------------------------
begin  // Don't insert code in this proc
  sg_IOPM_Editing(sg_IOPM.Selection.Left, sg_IOPM.Selection.Top);
end;

//------------------------------------------------
procedure Tfm_IOPM.sg_IOPMExit(Sender: TObject);
//------------------------------------------------
begin // Don't insert code in this proc
  sg_IOPM_EditCommitCheck(-1,-1);
end;

//------------------------------------------------
procedure Tfm_IOPM.sg_IOPM_EditCommitCheck(NewCol, NewRow: integer);
//------------------------------------------------
Label the_end;
Begin // Don't insert code in this proc
  If (NewCol = sg_IOPM_EditCol) and (NewRow = sg_IOPM_EditRow) then
    goto the_end;  // already done

  If (sg_IOPM_EditCol <> -1) or (sg_IOPM_EditRow <> -1 ) then
  Begin
    sg_IOPM_EditCommit;
    sg_IOPM_EditClear;
  end;
the_end:
end;

//------------------------------------------------
procedure Tfm_IOPM.sg_IOPM_EditClear;
//------------------------------------------------
Begin // Don't insert code in this proc
  sg_IOPM_EditCol   := -1;
  sg_IOPM_EditRow   := -1;
  sg_IOPM_EditValue := '';
end;

//------------------------------------------------
procedure  Tfm_IOPM.sg_IOPM_Editing(NewCol, NewRow: integer);
//------------------------------------------------
Begin
  sg_IOPM_EditCol   := NewCol;
  sg_IOPM_EditRow   := NewRow;
  sg_IOPM_EditValue := sg_IOPM.Cells[NewCol, NewRow];
end;

//------------------------------------------------
procedure  Tfm_IOPM.sg_IOPM_EditCommit;
//------------------------------------------------
// Get here ONLY from EditCommitCheck !!!
Var
  S: string;
  L: integer;
Begin
  S := sg_IOPM.Cells[sg_IOPM_EditCol, sg_IOPM_EditRow];

  Case sg_IOPM_EditCol of
    gc_Hex: Begin
      S := '0000' + S;
      L := Length(S);
      S := Copy(S,L-3,4);
      S := IntToHex(HexToIntDef(S,$FFFF),4);
      sg_IOPM.Cells[sg_IOPM_EditCol, sg_IOPM_EditRow] := S;

      UpdateBinFromHex(sg_IOPM_EditRow);
      EditValueChangeCheck;
    end;
    gc_15..gc_00: Begin
      If (S+'1')[1] = '0' then S := '0' else S := '1';
      sg_IOPM.Cells[sg_IOPM_EditCol, sg_IOPM_EditRow] := S;
      UpdateHexFromBin(sg_IOPM_EditRow);
      EditValueChangeCheck;
    end;
  end; {case}
end;

//------------------------------------------------------------
procedure Tfm_IOPM.EditValueChangeCheck;
//------------------------------------------------------------
Var
  S: string;
Begin
  S := sg_IOPM.Cells[sg_IOPM_EditCol, sg_IOPM_EditRow];
  If S <> sg_IOPM_EditValue then EditValueChanged;
end;

//------------------------------------------------------------
procedure Tfm_IOPM.EditValueChanged;
//------------------------------------------------------------
Var
  S, SCaption: string;
  WordNew: word;
  NewByte: byte;
  Ix, IxOS: integer;
  Status: DWORD;

Begin
  SCaption := '';
  S       := sg_IOPM.Cells[gc_AddHex, sg_IOPM_EditRow];
  S       := Copy(S,2,2);
  Ix      := HexToIntDef(S,0);
  Ix      := Ix shl 1;
  WordNew := HexToIntDef(sg_IOPM.Cells[gc_Hex, sg_IOPM_EditRow],$FFFF);

  For IxOS := 0 to 1 do
  Begin
    Case IxOS of
      0: NewByte := Lo(WordNew);
      1: NewByte := Hi(WordNew);
    end; { case }

    Status := GWIOPM_Driver.IOCTL_IOPMD_SET_LIOPM(Ix+IxOS, NewByte);

    SCaption := SCaption
              + ' Ix: '   + IntToHex(Ix+IxOS,4)
              + ' Byte: ' + IntToHex(NewByte,2)
              + ' Status: ' + IntToHex(Status, 6)+'   ';
  end;

  lb_Scratch.Caption :=SCaption;

end;
//============================================================
// IOCTL IOPM functions
//============================================================

//------------------------------------------------------------
procedure Tfm_IOPM.bt_ClearClick(Sender: TObject);
//------------------------------------------------------------
Var
  Status: DWORD;
begin
  Status := GWIOPM_Driver.IOCTL_IOPMD_CLEAR_LIOPM;
  fm_Main.DriverStatusMessage(Sender, Status);
  sg_Hex_Init(nil);
end;

//------------------------------------------------------------
procedure Tfm_IOPM.bt_GetIOPMClick(Sender: TObject);
//------------------------------------------------------------
Var
  LIOPM: TIOPM;
  RowIx, MapIx, IxOS: integer;
  Status: DWORD;
begin
  Status := GWIOPM_Driver.IOCTL_IOPMD_GET_LIOPMA(LIOPM);
  sg_Hex_Init(@LIOPM);
end;

//------------------------------------------------------------
procedure Tfm_IOPM.bt_Activate_KIOPMClick(Sender: TObject);
//------------------------------------------------------------
Var
  Status: DWORD;
begin
  Status := GWIOPM_Driver.IOCTL_IOPMD_ACTIVATE_KIOPM;
  fm_Main.DriverStatusMessage(Sender, Status);
end;

//------------------------------------------------------------
procedure Tfm_IOPM.bt_Deactivate_KIOPMClick(Sender: TObject);
//------------------------------------------------------------
Var
  Status: DWORD;
begin
  Status := GWIOPM_Driver.IOCTL_IOPMD_DEACTIVATE_KIOPM;
  fm_Main.DriverStatusMessage(Sender, Status);
end;

//------------------------------------------------------------
procedure Tfm_IOPM.bt_Query_KIOPMClick(Sender: TObject);
//------------------------------------------------------------
Var
  Status: DWORD;
begin
  Status := GWIOPM_Driver.IOCTL_IOPMD_QUERY_KIOPM;
  fm_Main.DriverStatusMessage(Sender, Status);
end;

end.