{ Ввод/вывод в порты для  Windows NT }

{---------------------------------------------------------------------------
The control units for mass-spectrometer MI1201-AGM
(c) Copyright	 Aleksandrov O.E., 1999

   Molecular Physics department, USTU, Ekaterinsburg, K-2, 620002, RUSSIA
   phone 75-47-15
   E-mail: aleks@dpt.ustu.ru

Модуль управления масс-спектрометром МИ1201-АГМ
(c) Собственность     Александрова О.Е., 1999

   620002, Екатеринбург, К-2, УГТУ, Кафедра молекулярной физики
   тел. 75-47-15
   E-mail: aleks@dpt.ustu.ru
----------------------------------------------------------------------------}

{ эквиваленты инструкций IN AL,DX и OUT DX,AL для использования в
операционных системах Windows NT (через драйвер устройства, см. cDeviceName)
и Windows 95/98 (прямо в порты)}

unit PortsIO;

interface
  USES Windows, xDDK;

const
  cDeviceName='\\.\PortIODev';{ действующее, но неудачное имя для драйвера }
  cMi1201AGM='\\.\MI1201_Dev'; { новое имя для драйвера }

type
  tFlag=(fIO_via_FileSystem, fIO_via_ExternalProcs, fIO_Error);
  tFlags=set of tFlag;

const
  cFlagsIO=[fIO_via_FileSystem, fIO_via_ExternalProcs, fIO_Error];

type
{ Вход: AL=b; DX=Port. Выход: ничего. Изменения: по соглашению о вызовах Delphi;}
  TOutB_Proc=procedure(b:Byte; Port:word); register;

{ Вход: AX=Port. Выход: AL=значение в порту. Изменения: по соглашению о вызовах Delphi;}
  TInB_Func =function(Port:word):byte; register;

  TLastError_Func =function:longint; register;

  tIOType=(ioDirect, ioViaFileSystem, ioError, ioEmulator, ioUnknown);

function IsError:boolean;
function LastErrorCode:cardinal;
function LastIOPort:Dword;

function Flags:tFlags;
function UsingDeviceIOControl:boolean;
function DeviceIOType:tIOType;

procedure OutByte(b:Byte; Port:word); register;
function  InByte(Port:word):byte; register;

procedure SetExternalInOutByte(
              InBt:TInB_Func;
              OutBt:TOutB_Proc;
              LastError:TLastError_Func); register;

procedure ResetInOutByte;

implementation
  {$IFDef LogPortIO}
  USES SysUtils, PortsIOLog;
  {$EndIF Def LogPortIO}

var
  OutB:TOutB_Proc; // вывод в порт
  InB:TInB_Func;   // ввод из порта
  LastErr:TLastError_Func;
  prFlags:tFlags;

function Flags:tFlags;
begin
  Flags:=prFlags;
end;

procedure ClearIOFlags;
begin
  prFlags:=prFlags-cFlagsIO;
end;

procedure SetIOFlag(f:tFlag);
begin
  if f in cFlagsIO then begin
    ClearIOFlags;
    Include(prFlags,f);
  end;
end;

// ---- прямой доступ к портам для Windows 95/98 ----
// прямой вывод в порт для Windows 95/98
procedure OutB_Direct(b:Byte; Port:word); register;
{Вход: AL=b; DX=Port}
assembler;
asm
  out Port,b
end;

// прямой ввод из порта для Windows 95/98
function  InB_Direct(Port:word):byte; register;
assembler;
asm
  mov DX,Port
  in al,DX
end;

procedure OutByte(b:Byte; Port:word); register;
assembler;
asm
  jmp OutB
end;

function  InByte(Port:word):byte; register;
assembler;
asm
  jmp InB
end;

var
  HDevice:THandle;
  LastIOErrorCode:DWord;
  LastPortIO:DWord;

// ---- ЗАГЛУШКА для Windows NT при отсутствии драйвера ----
// ЗАГЛУШКА для NT при отсутствии драйвера вывода в порт
procedure OutB_X(b:Byte; Port:word); register;
begin
  if LastIOErrorCode<>0 then Exit;
  LastPortIO:=Port;
  LastIOErrorCode:=High(LastIOErrorCode);
end;

// ЗАГЛУШКА для NT при отсутствии драйвера ввода из порта
function  InB_X(Port:word):byte; register;
begin
  Result:=$FF;
  if LastIOErrorCode<>0 then Exit;
  LastPortIO:=Port;
  LastIOErrorCode:=High(LastIOErrorCode);
end;

function LastErrorCode;
begin
  if Assigned(LastErr) then begin
    Result:=LastErr;
  end else begin
    Result:=LastIOErrorCode;
  end;
end;

function LastIOPort;
begin
  Result:=LastPortIO;
end;

function IsError;
begin
  Result:=LastErrorCode<>0;
end;


{function CTL_CODE(ADeviceType, AFunction, AMethod, AAccess:DWord):DWord;
begin
  Result := (ADeviceType shl 16) or
      	    (AAccess shl 14) or
	    (AFunction shl 2) or
	    AMethod;
end;}


procedure GetNtHandle(DriverName:PChar); forward;

// ПЕРВЫЙ вывод в порт для Windows NT
procedure OutB_ByFileSystem_Init(b:Byte; Port:word); register;
begin
  GetNtHandle(cDeviceName);
  OutB(b,Port);
end;

function DoLog(Port:word):boolean; register;
begin
//  Result:=(port<>60816);
  Result:=TRUE;
end;

// вывод в порт для Windows NT
procedure OutB_ByFileSystem(b:Byte; Port:word); register;
  var
    buf: tGENPORT_WRITE_INPUT_BUFFER;
    ReturnBytesCount: dword;
begin
{$IFDef LogPortIO}
  if DoLog(port) then
    LogStrLn(IntToHex(Port,5)+'<-'+IntTostr(b));
{$EndIF Def LogPortIO}
  buf.PortNumber:=Port;
  buf.UCharData:=b;
  if (not DeviceIOControl(HDevice,                      // handle to device of interest
                          IOCTL_GPD_WRITE_PORT_UCHAR,   // control code of operation to perform
                          @buf,                         // pointer to buffer to supply input data
			  SizeOf(buf),                  // size of input buffer
			  nil,                          // pointer to buffer to receive output data
			  0,                            // size of output buffer
			  ReturnBytesCount,             // ??? pointer to variable to receive output byte count
			  nil
                         )
     ) or (ReturnBytesCount <> 0) then  begin
     LastIOErrorCode:=GetLastError;
     LastPortIO:=Port;
     if LastIOErrorCode=0 then LastIOErrorCode:=High(LastIOErrorCode);
  end;
end;

// ПЕРВЫЙ из порта для Windows NT
function  InB_ByFileSystem_Init(Port:word):byte; register;
begin
  GetNtHandle(cDeviceName);
  Result:=InB(Port);
end;

// ввод из порта для Windows NT
function  InB_ByFileSystem(Port:word):byte; register;
  var ReturnBytesCount:dword;
      InputBuff:tGENPORT_READ_INPUT_BUFFER;
begin
  InputBuff.PortNumber:=Port;
  if (not DeviceIOControl(HDevice,                      // handle to device of interest
                          IOCTL_GPD_READ_PORT_UCHAR,    // control code of operation to perform
			  @InputBuff,                       // pointer to buffer to supply input data
			  SizeOf(InputBuff),// size of input buffer
			  @Result,                      // pointer to buffer to receive output data
			  1,                            // size of output buffer
//			  @OutputBuff,                      // pointer to buffer to receive output data
//			  SizeOf(OutputBuff),                            // size of output buffer
			  ReturnBytesCount,                          // pointer to variable to receive output byte count
			  nil                           // pointer to overlapped structure for asynchronous
			 )
     ) or (ReturnBytesCount <> 1) then begin
    LastIOErrorCode:=GetLastError;
    LastPortIO:=Port;
    if LastIOErrorCode=0 then LastIOErrorCode:=High(LastIOErrorCode);
    Result:=$FF;
  end;
{$IFDef LogPortIO}
  if DoLog(port) then
    LogStrLn(IntToHex(Port,5)+'->'+IntTostr(Result));
{$EndIF Def LogPortIO}
end;

function IsWindowsNT:boolean;
  var osvi:OSVERSIONINFO;
begin
  osvi.dwOSVersionInfoSize:=SizeOf(osvi);
  GetVersionEx(osvi);
  Result:=(osvi.dwPlatformId=VER_PLATFORM_WIN32_NT);
end;

procedure ReleaseHandle;
begin
  OutB:=OutB_X;
  InB:=InB_X;
  if HDevice<>INVALID_HANDLE_VALUE then begin
    CloseHandle(HDevice);
    LastIOErrorCode:=GetLastError;
    HDevice:=INVALID_HANDLE_VALUE;
  end;
  LastPortIO:=0;
end;

procedure GetNtHandle(DriverName:PChar);
begin
  ReleaseHandle;
  HDevice := CreateFile(DriverName,                   // address of name of the file
                        GENERIC_READ or GENERIC_WRITE,  // access (read-write) mode
                        FILE_SHARE_READ,                // share mode
                        nil,                            // address of security descriptor
                        OPEN_EXISTING,                  // how to create
		        0,                              // file attributes
			0                               // handle of file with attributes to copy
		       );
  LastIOErrorCode:=GetLastError;
  if HDevice<>INVALID_HANDLE_VALUE then begin
    OutB:=OutB_ByFileSystem;
    InB:=InB_ByFileSystem;
  end else begin
    OutB:=OutB_X;
    InB:=InB_X;
    SetIOFlag(fIO_Error);
  end;
end;

procedure GetHandle(DriverName:PChar);
begin
  if IsWindowsNT then begin
    OutB:=OutB_ByFileSystem_Init;
    InB:=InB_ByFileSystem_Init;
    prFlags:=prFlags-cFlagsIO;
    SetIOFlag(fIO_via_FileSystem);
  end else begin
    LastIOErrorCode:=0;
    LastPortIO:=0;
    HDevice:=INVALID_HANDLE_VALUE;
    OutB:=OutB_Direct;
    InB:=InB_Direct;
    ClearIOFlags;
  end;
end;

function UsingDeviceIOControl:boolean;
begin
  UsingDeviceIOControl:=fIO_via_filesystem in Flags;
end;

function DeviceIOType:tIOType;
begin
  if fIO_via_filesystem in Flags then begin
    DeviceIOType:=ioViaFileSystem;
  end else if (@OutB=@OutB_Direct) and (@InB=@InB_Direct) then begin
    DeviceIOType:=ioDirect;
  end else if (fIO_via_ExternalProcs in Flags) then begin
    DeviceIOType:=ioEmulator;
  end else if (fIO_Error in Flags) then begin
    DeviceIOType:=ioError;
  end else begin
    DeviceIOType:=ioUnknown;
  end;
end;

procedure SetExternalInOutByte;
begin
  ReleaseHandle;
  OutB:=@OutBt;
  InB:=@InBt;
  LastErr:=@LastErr;
  LastIOErrorCode:=0;
  SetIOFlag(fIO_via_ExternalProcs);
end;

procedure ResetInOutByte;
begin
  LastErr:=NIL;
  GetHandle(cDeviceName);
end;

INITIALIZATION
  prFlags:=[];
  HDevice:=INVALID_HANDLE_VALUE;
  LastErr:=NIL;
  GetHandle(cDeviceName);

FINALIZATION
{ Освободить HANDLE (закрыть файл) }
  ReleaseHandle;

END.