ioboardtestunit.~pas

在Windows 2000或者XP系统下的ISA接口卡测试程序的完整代码

unit IOBoardTestUnit;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, Spin, IOTalk;

type
TConvertType = (ctByte,ctWord,ctLongword);
TRandomType = (rtByte,rtWord,rtLongword);
TAutoTestMode = (atmOff,atmCounter,atmRandom,atmScanMove,atmCycleMove,atmPointMove,
                 atmBit1,atmBit2,atmBit3,atmBit4);
TCodeEditPos = (cepNull,cepBin,cepHex,cepDec);

type
  TForm1 = class(TForm)
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    BitBtnExit: TBitBtn;
    GroupBox1: TGroupBox;
    EditOut1a: TEdit;
    LabelOut1a: TLabel;
    EditIn1a: TEdit;
    LabelIn1a: TLabel;
    BitBtnOut1: TBitBtn;
    CheckBoxGroup1: TCheckBox;
    BitBtnIn1: TBitBtn;
    EditIOBase: TEdit;
    LabelIOBase: TLabel;
    GroupBox2: TGroupBox;
    LabelOut2a: TLabel;
    LabelIn2a: TLabel;
    EditOut2a: TEdit;
    EditIn2a: TEdit;
    BitBtnOut2: TBitBtn;
    CheckBoxGroup2: TCheckBox;
    BitBtnIn2: TBitBtn;
    GroupBox3: TGroupBox;
    LabelOut3a: TLabel;
    LabelIn3a: TLabel;
    EditOut3a: TEdit;
    EditIn3a: TEdit;
    BitBtnOut3: TBitBtn;
    CheckBoxGroup3: TCheckBox;
    BitBtnIn3: TBitBtn;
    GroupBox4: TGroupBox;
    LabelOut4a: TLabel;
    LabelIn4a: TLabel;
    EditOut4a: TEdit;
    EditIn4a: TEdit;
    BitBtnOut4: TBitBtn;
    CheckBoxGroup4: TCheckBox;
    BitBtnIn4: TBitBtn;
    GroupBox5: TGroupBox;
    LabelOut5a: TLabel;
    LabelIn5a: TLabel;
    EditOut5a: TEdit;
    EditIn5a: TEdit;
    BitBtnOut5: TBitBtn;
    CheckBoxGroup5: TCheckBox;
    BitBtnIn5: TBitBtn;
    GroupBox6: TGroupBox;
    LabelOut6a: TLabel;
    LabelIn6a: TLabel;
    EditOut6a: TEdit;
    EditIn6a: TEdit;
    BitBtnOut6: TBitBtn;
    CheckBoxGroup6: TCheckBox;
    BitBtnIn6: TBitBtn;
    GroupBox7: TGroupBox;
    LabelOut7a: TLabel;
    LabelIn7a: TLabel;
    EditOut7a: TEdit;
    EditIn7a: TEdit;
    BitBtnOut7: TBitBtn;
    CheckBoxGroup7: TCheckBox;
    BitBtnIn7: TBitBtn;
    GroupBox8: TGroupBox;
    EditCount: TEdit;
    LabelCount: TLabel;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    Timer1: TTimer;
    LabelOut1b: TLabel;
    LabelIn1b: TLabel;
    LabelIn2b: TLabel;
    LabelOut2b: TLabel;
    LabelIn3b: TLabel;
    LabelOut3b: TLabel;
    LabelIn4b: TLabel;
    LabelOut4b: TLabel;
    LabelIn6b: TLabel;
    LabelOut6b: TLabel;
    LabelIn7b: TLabel;
    LabelOut7b: TLabel;
    LabelIn5b: TLabel;
    EditOut1b: TEdit;
    LabelOut5c: TLabel;
    EditOut5b: TEdit;
    EditOut2b: TEdit;
    EditOut3b: TEdit;
    EditOut4b: TEdit;
    EditOut6b: TEdit;
    LabelOut6c: TLabel;
    EditOut7b: TEdit;
    LabelOut7c: TLabel;
    BitBtnReset: TBitBtn;
    SpinEdit1: TSpinEdit;
    LabelInterval: TLabel;
    SpeedButton9: TSpeedButton;
    SpeedButton10: TSpeedButton;
    EditMoveMap: TEdit;
    LabelPointMap: TLabel;
    SpeedButton11: TSpeedButton;
    SpeedButton12: TSpeedButton;
    EditOut5c: TEdit;
    LabelIn5c: TLabel;
    LabelOut5b: TLabel;
    EditOut1c: TEdit;
    EditIn1b: TEdit;
    LabelIn1c: TLabel;
    EditIn1c: TEdit;
    EditIn2b: TEdit;
    EditIn2c: TEdit;
    LabelIn2c: TLabel;
    EditIn3b: TEdit;
    EditIn3c: TEdit;
    LabelIn3c: TLabel;
    EditIn4b: TEdit;
    EditIn4c: TEdit;
    LabelIn4c: TLabel;
    EditIn6b: TEdit;
    EditIn6c: TEdit;
    LabelIn6c: TLabel;
    EditIn7b: TEdit;
    EditIn7c: TEdit;
    LabelIn7c: TLabel;
    EditOut2c: TEdit;
    EditOut3c: TEdit;
    EditOut4c: TEdit;
    EditOut6c: TEdit;
    EditOut7c: TEdit;
    EditIn5b: TEdit;
    EditIn5c: TEdit;
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BitBtnExitClick(Sender: TObject);
    procedure Timer1Timer(Sender: TObject);
    procedure EditOut1aKeyPress(Sender: TObject; var Key: Char);
    procedure EditOut1bKeyPress(Sender: TObject; var Key: Char);
    procedure EditOut1aChange(Sender: TObject);
    procedure EditOut1bChange(Sender: TObject);
    procedure BitBtnResetClick(Sender: TObject);
    procedure SpinEdit1Change(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure EditIOBaseChange(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure EditMoveMapChange(Sender: TObject);
    procedure SpeedButton11Click(Sender: TObject);
    procedure SpeedButton12Click(Sender: TObject);
    procedure BitBtnOut1Click(Sender: TObject);
    procedure BitBtnIn1Click(Sender: TObject);
    procedure EditOut1cChange(Sender: TObject);
    procedure EditOut1cKeyPress(Sender: TObject; var Key: Char);
    procedure EditOut5cKeyPress(Sender: TObject; var Key: Char);
    procedure EditOut1cMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditOut1bMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
    procedure EditOut1aMouseDown(Sender: TObject; Button: TMouseButton;
      Shift: TShiftState; X, Y: Integer);
  private
    IOBaseAddr : word;
    TestCount : Longint;
    CodeEditPos : TCodeEditPos;
    PointAddCount : integer;
    ByteCounter : byte;
    WordCounter : word;
    MoveByte : byte;
    MoveWord : word;
    MoveMap  : ShortString;
    MoveMapLen : integer;
    ByteMoveToLeft : boolean;
    WordMoveToLeft : boolean;
    ATBool : boolean;
    MToLeft : boolean;
    AutoTestMode : TAutoTestMode;
    procedure BinConvertHexDec(BinEdit,HexEdit,DecEdit: TEdit; ConvertType: TConvertType);
    procedure HexConvertBinDec(HexEdit,BinEdit,DecEdit: TEdit; ConvertType: TConvertType);
    procedure DecConvertBinHex(DecEdit,BinEdit,HexEdit: TEdit; ConvertType: TConvertType);
    function GetRandomWord(RandomType: TRandomType): word;
    procedure WriteTestCodeToPorts(ByteValue: byte; WordValue: word);
    procedure ResetTestCode;
    procedure AutoTest;
  public
    { Public declarations }
  end;

const
CByteBit1 : byte = $aa;
CWordBit1 : word = $aaaa;
CByteBit2 : byte = $cc;
CWordBit2 : word = $cccc;
CByteBit3 : byte = $f0;
CWordBit3 : word = $f0f0;
CByteBit4 : byte = $ff;
CWordBit4 : word = $ffff;

var
  Form1: TForm1;

implementation

{$R *.dfm}

// ------------------------ I/O Function ---------------------------

procedure WriteByteToPort(IOAddr: word; Value: byte);
begin
 asm
  mov dx,IOAddr
  mov al,Value
  out dx,al
 end;
end;

procedure WriteWordToPort(IOAddr: word; Value: word);
begin
 asm
  mov dx,IOAddr
  mov ax,Value
  out dx,ax
 end;
end;

function ReadByteFromPort(IOAddr: word): byte;
begin
 asm
  mov dx,IOAddr
  in  al,dx
  mov result,al
 end;
end;

function ReadWordFromPort(IOAddr: word): word;
begin
 asm
  mov dx,IOAddr
  in  ax,dx
  mov result,ax
 end;
end;

// ---------------------- Event function --------------------------------

procedure TForm1.FormCreate(Sender: TObject);
begin
 if not OpenIOPM then begin
  ShowMessage('无法为当前程序打开 I/O 访问权！');
  Halt;
 end;
 IOBaseAddr := $390;
 TestCount := 0;
 MoveMap := '110';
 MoveMapLen := 3;
 MToLeft := true;
 EditMoveMap.Text := MoveMap;
 CodeEditPos := cepBin;
 ResetTestCode;
 AutoTestMode := atmOff;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
{}
end;

procedure TForm1.FormShow(Sender: TObject);
begin
{}
end;

procedure TForm1.BitBtnExitClick(Sender: TObject);
begin
 Timer1.Enabled := false;
 Close;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
 AutoTest;
end;

procedure TForm1.EditOut1aKeyPress(Sender: TObject; var Key: Char);
begin
 if (Key <> '0') and (Key <> '1') and (Key <> Char($08)) then Key := Char($00);
end;

procedure TForm1.EditOut1bKeyPress(Sender: TObject; var Key: Char);
begin
 if (not (Key in ['0'..'9'])) and
    (not (UpCase(Key) in ['A'..'F'])) and
    (Key <> Char($08)) then Key := Char($00);
end;

procedure TForm1.EditOut1cKeyPress(Sender: TObject; var Key: Char);
begin
 if (not (Key in ['0'..'9'])) and
    (Key <> Char($08)) then Key := Char($00) else begin
  if (Key <> Char($08)) and (StrToInt(TEdit(Sender).Text + key) > 255) then Key := Char($00);
 end;
end;

procedure TForm1.EditOut5cKeyPress(Sender: TObject; var Key: Char);
begin
 if (not (Key in ['0'..'9'])) and
    (Key <> Char($08)) then Key := Char($00) else begin
  if (Key <> Char($08)) and (StrToInt(TEdit(Sender).Text + key) > 65535) then Key := Char($00);
 end;
end;

procedure TForm1.EditOut1aMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 CodeEditPos := cepBin;
end;

procedure TForm1.EditOut1bMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 CodeEditPos := cepHex;
end;

procedure TForm1.EditOut1cMouseDown(Sender: TObject; Button: TMouseButton;
  Shift: TShiftState; X, Y: Integer);
begin
 CodeEditPos := cepDec;
end;

procedure TForm1.BinConvertHexDec(BinEdit,HexEdit,DecEdit: TEdit; ConvertType: TConvertType);
begin
 case ConvertType of
  ctByte: if Length(BinEdit.Text) >= 8 then begin
           HexEdit.Text := ByteBinToHex(BinEdit.Text);
           DecEdit.Text := FillNumber0(IntToStr(BinToByte(BinEdit.Text)),3);
          end;
  ctWord: if Length(BinEdit.Text) >= 16 then begin
           HexEdit.Text := WordBinToHex(BinEdit.Text);
           DecEdit.Text := FillNumber0(IntToStr(BinToWord(BinEdit.Text)),5);
          end;
 end;
end;

procedure TForm1.EditOut1aChange(Sender: TObject);
begin
 if CodeEditPos = cepBin then begin
  if Sender = EditOut1a then BinConvertHexDec(EditOut1a,EditOut1b,EditOut1c,ctByte) else
  if Sender = EditOut2a then BinConvertHexDec(EditOut2a,EditOut2b,EditOut2c,ctByte) else
  if Sender = EditOut3a then BinConvertHexDec(EditOut3a,EditOut3b,EditOut3c,ctByte) else
  if Sender = EditOut4a then BinConvertHexDec(EditOut4a,EditOut4b,EditOut4c,ctByte) else
  if Sender = EditOut5a then BinConvertHexDec(EditOut5a,EditOut5b,EditOut5c,ctWord) else
  if Sender = EditOut6a then BinConvertHexDec(EditOut6a,EditOut6b,EditOut6c,ctByte) else
  if Sender = EditOut7a then BinConvertHexDec(EditOut7a,EditOut7b,EditOut7c,ctByte);
 end;
end;

procedure TForm1.HexConvertBinDec(HexEdit,BinEdit,DecEdit: TEdit; ConvertType: TConvertType);
begin
 case ConvertType of
  ctByte: begin
           if Length(HexEdit.Text) >= 1 then begin
            BinEdit.Text := ByteHexToBin(HexEdit.Text);
            DecEdit.Text := FillNumber0(IntToStr(HexToByte(HexEdit.Text)),3);
           end else begin
            BinEdit.Text := '00000000';
            DecEdit.Text := '000';
           end;
          end;
  ctWord: begin
           if Length(HexEdit.Text) >= 1 then begin
            BinEdit.Text := WordHexToBin(HexEdit.Text);
            DecEdit.Text := FillNumber0(IntToStr(HexToWord(HexEdit.Text)),5);
           end else begin
            BinEdit.Text := '0000000000000000';
            DecEdit.Text := '00000';
           end;
          end;
 end;
end;

procedure TForm1.EditOut1bChange(Sender: TObject);
begin
 if CodeEditPos = cepHex then begin