io.pas

众所周知

{*********************************************************************}
{  Component IO Read and Write                                        }
{  Copyright (C) 2004 by                                              }
{  Xi'an Electronic Engineering Research Institute(XEERI)             }
{  Version 1.0                                                        }
{  Write By Qixh                                                      }
{*********************************************************************}
unit IO;

interface
uses SysUtils,forms, Classes,windows,messages,windrvr;

var
    Port_ErrorString : String;        { this STRING is set to an error message, if one occurs }

{ internal data structures }
type Port_MODE = INTEGER;
const
    Port_MODE_BYTE = 0; Port_MODE_WORD   = 1; Port_MODE_DWORD  = 2;

type Port_ADDR = INTEGER;
const
    Port_Port = 0;
    Port_ITEMS = 1;

type Port_STRUCT = record
    hWD : HANDLE;
    cardReg : WD_CARD_REGISTER;
end;

type Port_HANDLE = ^Port_STRUCT;
type PPort_HANDLE = ^Port_HANDLE;

type PBYTE  = ^BYTE;
type PWORD  = ^WORD;
type PDWORD = ^DWORD;

type
  TIO = class(TComponent)
  private
    IoHandle:Port_HANDLE;
    SFBaseAddr:string;
    FBaseAddr,
    FOffsetLen     : Word;

    procedure SetBaseAddr(Value:word);
    procedure SetOffsetLen(Value:word);
    procedure ReadWriteBlock(dwOffset : DWORD; fRead : BOOLEAN; buf : POINTER; dwBytes : DWORD; mode : Port_MODE);
    procedure Port_RegisterWinDriver;


    procedure Port_SetCardElements(hPort : Port_HANDLE);
//    procedure PortmWndProc( var msg: TMessage );
    { Private declarations }
  protected

  public
    constructor Create(AnOwner: TComponent); override;
    destructor Destroy;override;
    function PortOpen:boolean;
    procedure PortClose;
    function ReadByte(dwOffset : DWORD) : BYTE;
    function ReadWord(dwOffset : DWORD) : WORD;
    function ReadDword(dwOffset : DWORD) : DWORD;
    procedure WriteByte(dwOffset : DWORD; data : BYTE);
    procedure WriteWord(dwOffset : DWORD; data : WORD);
    procedure WriteDword(dwOffset : DWORD; data : DWORD);
  published
      Property BaseAddr:word read FBaseAddr write SetBaseAddr;
      Property OffsetLen:word read FOffsetLen write SetOffsetLen;
    { Published declarations }
  end;

function StringToInt (str : STRING) : INTEGER;
function HexToInt(hex : STRING) : INTEGER;
procedure Register;

implementation
function StringToInt(str : STRING) : INTEGER;
var
    i : INTEGER;
    res : INTEGER;
begin
    res := 0;
    for i:=1 to Length(str) do
    if (str[i]>='0') and (str[i]<='9')
    then
        res := res * 10 + Ord(str[i]) - Ord('0')
    else
    begin
        Writeln('Illegal number value');
        StringToInt := 0;
        Exit;
    end;
    StringToInt := res;
end;

function HexToInt(hex : STRING) : INTEGER;
var
    i : INTEGER;
    res : INTEGER;

begin
    hex := UpperCase(hex);
    res := 0;
    for i:=1 to Length(hex) do
    begin
        if (hex[i]>='0') and (hex[i]<='9')
        then
            res := res * 16 + Ord(hex[i]) - Ord('0')
        else
            if (hex[i]>='A') and (hex[i]<='F')
            then
                res := res * 16 + Ord(hex[i]) - Ord('A') + 10
            else
                begin
                    Writeln('Illegal Hex value');
                    HexToInt := 0;
                    Exit;
                end;
    end;
    HexToInt := res;
end;

procedure TIO.Port_RegisterWinDriver;
var
    hWD : HANDLE;
    lic : SWD_LICENSE;

begin
    hWD := WD_Open();
    if hWD <> INVALID_HANDLE_VALUE
    then
    begin
         { TO DO - When you get your registration STRING enter it in the following line. }
         {         To check the current license, run 'Driver Wizard', and choose 'File / Register', }
         {         leave the license STRING empty, and click 'Check License'.                       }
         {         In the text box will appear the current valid licenses.                          }
         lic.cLicense :=  '68C9BECCEDE89D5060EF8FC5BD1BA552.Warlock//SSG';
        WD_License(hWD, lic);
        WD_Close(hWD);
    end;
end;

{TIO}
constructor TIO.Create(AnOwner: TComponent);
begin
  FBaseAddr:=$00;
  FOffsetLen:=$08;
  inherited Create(AnOwner);
end;

destructor TIO.Destroy;
begin
  inherited Destroy;
end;

procedure TIO.Port_SetCardElements(hPort : Port_HANDLE);
begin
    hPort^.cardReg.Card.dwItems := Port_ITEMS;
    {  }
    hPort^.cardReg.Card.Item[Port_Port].item := ITEM_IO;
    hPort^.cardReg.Card.Item[Port_Port].fNotSharable := 1;
    hPort^.cardReg.Card.Item[Port_Port].IO.dwAddr := FBaseAddr;
    hPort^.cardReg.Card.Item[Port_Port].IO.dwBytes := FOffsetLen;

end;

procedure TIO.ReadWriteBlock(dwOffset : DWORD; fRead : BOOLEAN; buf : POINTER; dwBytes : DWORD; mode : Port_MODE);
var
    trans : SWD_TRANSFER;
    fMem : BOOLEAN;
begin
    fMem := (IoHandle^.cardReg.Card.Item[0].item = ITEM_MEMORY);
    FillChar(trans, SizeOf(trans), 0);
    if fRead
    then
    case mode of
        Port_MODE_BYTE :
            if fMem
            then
                trans.cmdTrans := RM_SBYTE
            else
                trans.cmdTrans := RP_SBYTE;
        Port_MODE_WORD :
            if (fMem)
            then
                trans.cmdTrans := RM_SWORD
            else
                trans.cmdTrans := RP_SWORD;
        Port_MODE_DWORD :
            if (fMem)
            then
                trans.cmdTrans := RM_SDWORD
            else
                trans.cmdTrans := RP_SDWORD;
    end
    else
    case mode of
        Port_MODE_BYTE :
            if (fMem)
            then
                trans.cmdTrans := WM_SBYTE
            else
                trans.cmdTrans := WP_SBYTE;
        Port_MODE_WORD :
            if (fMem)
            then
                trans.cmdTrans := WM_SWORD
            else
                trans.cmdTrans := WP_SWORD;
        Port_MODE_DWORD :
            if (fMem)
            then
                trans.cmdTrans := WM_SDWORD
            else
                trans.cmdTrans := WP_SDWORD;
    end;
    if (fMem)
    then
        trans.dwPort := IoHandle^.cardReg.Card.Item[0].Memory.dwTransAddr
    else
        trans.dwPort := IoHandle^.cardReg.Card.Item[0].IO.dwAddr;
    trans.dwPort := trans.dwPort + dwOffset;

    trans.fAutoinc := 1;
    trans.dwBytes := dwBytes;
    trans.dwOptions := 0;
    trans.pBuffer := buf;
    WD_Transfer (IoHandle^.hWD, trans);
end;

function TIO.ReadByte(dwOffset : DWORD) : BYTE;
var
    data : BYTE;
    pData : PBYTE;

begin
    if IoHandle^.cardReg.Card.Item[0].item = ITEM_MEMORY
    then
    begin
        pData := PBYTE(IoHandle^.cardReg.Card.Item[0].Memory.dwUserDirectAddr + dwOffset);
        data := pData^;             { read from the memory mapped range directly }
    end
    else
        ReadWriteBlock(dwOffset, True, @data, SizeOf(BYTE), Port_MODE_BYTE);
    ReadByte := data;
end;


function TIO.ReadWord(dwOffset : DWORD) : WORD;
var
    data : WORD;
    pData : PWORD;
begin
    if IoHandle^.cardReg.Card.Item[0].item = ITEM_MEMORY
    then
    begin
        pData := PWORD(IoHandle^.cardReg.Card.Item[0].Memory.dwUserDirectAddr + dwOffset);
        data := pData^;             { read from the memory mapped range directly }
    end
    else
        ReadWriteBlock(dwOffset, True, @data, SizeOf(WORD), Port_MODE_WORD);
    ReadWord := data;
end;


function TIO.ReadDword(dwOffset : DWORD) : DWORD;
var
    data : DWORD;
    pData : PDWORD;

begin
    if IoHandle^.cardReg.Card.Item[0].item = ITEM_MEMORY
    then
    begin
        pData := PDWORD(IoHandle^.cardReg.Card.Item[0].Memory.dwUserDirectAddr + dwOffset);
        data := pData^;             { read from the memory mapped range directly }
    end
    else
        ReadWriteBlock(dwOffset, True, @data, SizeOf(DWORD), Port_MODE_DWORD);
    ReadDword := data;
end;


procedure TIO.WriteByte(dwOffset : DWORD; data : BYTE);
var
    pData : PBYTE;

begin
    if IoHandle^.cardReg.Card.Item[0].item = ITEM_MEMORY
    then
    begin
        pData := PBYTE(IoHandle^.cardReg.Card.Item[0].Memory.dwUserDirectAddr + dwOffset);
        pData^ := data;             { write to the memory mapped range directly }
    end
    else
        ReadWriteBlock(dwOffset, False, @data, SizeOf(BYTE), Port_MODE_BYTE);
end;


procedure TIO.WriteWord(dwOffset : DWORD; data : WORD);
var
    pData : PWORD;

begin
    if IoHandle^.cardReg.Card.Item[0].item = ITEM_MEMORY
    then
    begin
        pData := PWORD(IoHandle^.cardReg.Card.Item[0].Memory.dwUserDirectAddr + dwOffset);
        pData^ := data;             { write to the memory mapped range directly }
    end
    else
        ReadWriteBlock(dwOffset, False, @data, SizeOf(WORD), Port_MODE_WORD);
end;


procedure TIO.WriteDword(dwOffset : DWORD; data : DWORD);
var
    pData : PDWORD;

begin
    if IoHandle^.cardReg.Card.Item[0].item = ITEM_MEMORY
    then
    begin
        pData := PDWORD(IoHandle^.cardReg.Card.Item[0].Memory.dwUserDirectAddr + dwOffset);
        pData^ := data;             { write to the memory mapped range directly }
    end
    else
        ReadWriteBlock(dwOffset, False, @data, SizeOf(DWORD), Port_MODE_DWORD);
end;

function TIO.PortOpen:boolean;
var
    hPort : Port_HANDLE;
    ver : SWD_VERSION;
label Finish;
begin
    GetMem (POINTER(hPort), sizeof (Port_STRUCT));
    IoHandle := nil;
    Port_ErrorString := '';
    FillChar(hPort^, SizeOf(hPort^), 0);

    Port_RegisterWinDriver();

    hPort^.cardReg.hCard := 0;
    hPort^.hWD := WD_Open();

    { check if handle valid & version OK }
    if hPort^.hWD = INVALID_HANDLE_VALUE
    then
    begin
        Port_ErrorString := 'Failed opening WinDriver device';
        goto Finish;
    end;

    FillChar(ver, SizeOf(ver), 0);
    WD_Version(hPort^.hWD,ver);
    if (ver.dwVer < WD_VER)
    then
    begin
        Port_ErrorString := 'Incorrect WinDriver version';
        goto Finish;
    end;

    Port_SetCardElements(hPort);
    hPort^.cardReg.fCheckLockOnly := 0;
    WD_CardRegister(hPort^.hWD, hPort^.cardReg);
    if hPort^.cardReg.hCard = 0
    then
    begin
        Port_ErrorString := 'Failed locking device';
        goto Finish;
    end;

    { Open finished OK }
    IoHandle := hPort;
    PortOpen := True;
    Exit;

Finish:    { Error during Open }
    if hPort^.cardReg.hCard <> 0
    then
        WD_CardUnregister(hPort^.hWD, hPort^.cardReg);
    if (hPort^.hWD <> INVALID_HANDLE_VALUE)
    then
        WD_Close(hPort^.hWD);
    FreeMem(hPort);
    PortOpen := False;
end;


procedure TIO.PortClose;
begin
    { unregister card }
    if IoHandle^.cardReg.hCard <> 0
    then
        WD_CardUnregister(IoHandle^.hWD, IoHandle^.cardReg);

    { close WinDriver }
    WD_Close(IoHandle^.hWD);

    FreeMem(IoHandle);
end;

procedure TIO.SetBaseAddr(Value:word);
begin
  FBaseAddr:=Value;
  UpDated;
end;

procedure TIO.SetOffsetLen(Value:word);
begin
  if Value<=0 then Value:=0;
  FOffsetLen:=Value;
  UpDated;
end;

procedure Register;
begin
  RegisterComponents('QixhComponent', [TIO]);
end;
end.