iotalk.pas

通过PortTalk和改良的函数集、在Windows 2000 和 Windows XP 下进行IO口的直接访问。主调函数为OpenCurrentProcessIOAllAccess(PID: THa

unit IOTalk;

interface
uses
  Windows, SysUtils, Dialogs, WinSvc, Graphics, Classes;

const
  PORTTALK_TYPE = 40000; { 32768-65535是保留给用户使用的}
  METHOD_BUFFERED = 0;
  FILE_ANY_ACCESS = 0;
  IOCTL_IOPM_RESTRICT_ALL_ACCESS  = PORTTALK_TYPE shl 16 +
    $900 shl 2 +
    METHOD_BUFFERED +
    FILE_ANY_ACCESS shl 14;

  IOCTL_IOPM_ALLOW_EXCUSIVE_ACCESS = PORTTALK_TYPE shl 16 +
    $901 shl 2 +
    METHOD_BUFFERED +
    FILE_ANY_ACCESS shl 14;

  IOCTL_SET_IOPM = PORTTALK_TYPE shl 16 +
    $902 shl 2 +
    METHOD_BUFFERED +
    FILE_ANY_ACCESS shl 14;

  IOCTL_ENABLE_IOPM_ON_PROCESSID = PORTTALK_TYPE shl 16 +
    $903 shl 2 +
    METHOD_BUFFERED +
    FILE_ANY_ACCESS shl 14;

  IOCTL_READ_PORT_UCHAR = PORTTALK_TYPE shl 16 +
    $904 shl 2 +
    METHOD_BUFFERED +
    FILE_ANY_ACCESS shl 14;

  IOCTL_WRITE_PORT_UCHAR = PORTTALK_TYPE shl 16 +
    $905 shl 2 +
    METHOD_BUFFERED +
    FILE_ANY_ACCESS shl 14;

function OpenPortTalk: boolean;
procedure ClosePortTalk;
function StartPortTalkDriver: boolean;
function InstallPortTalkDriver: boolean;
function OpenCurProcessIOAllAccess(CurWnd: THandle): boolean;
function OpenCurrentProcessIOAllAccess(PID: THandle): boolean;
function OutPortB(PortAddress: word; byte1: byte): boolean;
function InPortB(PortAddress: word; var Error: boolean): byte;
function OpenIOPM: boolean;

implementation

function CopyPathName(FullName: string): string;
var
i : integer;
begin
 for i := Length(FullName) downto 1 do
  if FullName[i] = '\' then begin
   result := Copy(FullName,1,i);
   exit;
  end;
 result := '';
end;

function GetAppDir: string;
var
SPathStr : ShortString;
begin
 SPathStr := CopyPathName(ParamStr(0));
 SetLength(SPathStr,Length(SPathStr) - 1);
 result := SPathStr;
end;

var
// --------------------------- PortTalk value -----------------------------
PortTalk_Handle: THandle = 0;  {PortTalk句柄}
IOPM_isOpen : boolean = false;
// --------------------_----- PortTalk function----------------------------

function OpenPortTalk: boolean;
begin
 PortTalk_Handle := CreateFile('\\.\PortTalk',
                               GENERIC_READ,
                               0,
                               nil,
                               OPEN_EXISTING,
                               FILE_ATTRIBUTE_NORMAL,
                               0);
 if(PortTalk_Handle = INVALID_HANDLE_VALUE) then begin
  StartPortTalkDriver;
  PortTalk_Handle := CreateFile('\\.\PortTalk',
                                GENERIC_READ,
                                0,
                                nil,
                                OPEN_EXISTING,
                                FILE_ATTRIBUTE_NORMAL,
                                0);
  if(PortTalk_Handle = INVALID_HANDLE_VALUE) then begin
   result := false;
   exit;
  end;
 end;
 result := true;
end;

procedure ClosePortTalk;
begin
 CloseHandle(PortTalk_Handle);
end;

function StartPortTalkDriver: boolean;
type
TNewStartService = function (hService: SC_HANDLE; dwNumServiceArgs: DWORD;
                            lpServiceArgVectors: PPChar): BOOL; stdcall;
var
i : integer;
SchSCManager: SC_HANDLE;
schService: SC_HANDLE;
ret: BOOL;
err: DWORD;
begin
 SchSCManager := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
 if (SchSCManager = 0) then
 if (GetLastError = ERROR_ACCESS_DENIED) then begin
  result := false;
  exit;
 end;
 i := 0;
 repeat
  schService := OpenService(SchSCManager,'PortTalk',SERVICE_ALL_ACCESS);
  if (schService = 0) then begin
   case (GetLastError) of
    ERROR_ACCESS_DENIED:
       begin
        ShowMessage('PortTalk: 没有权限访问 PortTalk 服务数据库');
        result := false;
        exit;
       end;
    ERROR_INVALID_NAME:
       begin
        ShowMessage('PortTalk: 指定的服务名无效');
        result := false;
        exit;
       end;
    ERROR_SERVICE_DOES_NOT_EXIST:
       begin
        ShowMessage('PortTalk: PortTalk 驱动程序不存在');
        InstallPortTalkDriver;
        if i > 3 then begin
         result := false;
         exit;
        end;
        inc(i);
       end;
   end;
  end;
 until (schService <> 0);
 ret := TNewStartService(@StartService)(schService,0,nil); { 参数 }
 if not ret then begin
  err := GetLastError;
  if not (err = ERROR_SERVICE_ALREADY_RUNNING) then begin
   ShowMessage('PortTalk: 启动 PortTalk 时发生未知错误。'+#$D#$A+
               'PortTalk.sys 没有放入 \System32\Drivers 目录吗?');
   result:=false;
   exit;
  end;
 end;
 CloseServiceHandle(schService);
 result := true;
end;

function InstallPortTalkDriver : boolean;
var
SchSCManager:SC_HANDLE;
SchService:SC_HANDLE;
TDrvFileName : ShortString;
SDrvFileName : ShortString;
begin
 result := true;
 if GetSystemDirectory(@TDrvFileName[1],200) = 0 then exit;
 SetLength(TDrvFileName,StrLen(@TDrvFileName[1]));
 if TDrvFileName[Length(TDrvFileName)] <> '\' then
  TDrvFileName := TDrvFileName + '\Drivers\PortTalk.sys' else
  TDrvFileName := TDrvFileName + 'Drivers\PortTalk.sys';
 SDrvFileName := GetAppDir;
 if SDrvFileName[Length(SDrvFileName)] <> '\' then
  SDrvFileName := SDrvFileName + '\PortTalk.sys' + #0#0 else
  SDrvFileName := SDrvFileName + 'PortTalk.sys' + #0#0;
 if not FileExists(TDrvFileName) then begin
  TDrvFileName := TDrvFileName + #0#0;
  if not CopyFile(@SDrvFileName[1],@TDrvFileName[1],false) then begin
   result := false;
   exit;
  end;
 end else TDrvFileName := TDrvFileName + #0#0;
 SchSCManager := OpenSCManager(nil,nil,SC_MANAGER_ALL_ACCESS);
 if SchSCManager = 0 then begin
  result := false;
  exit;
 end;
 SchService := CreateService(SchSCManager,                     { SCManager数据库 }
                             'PortTalk',                        { 服务个数 }
                             'PortTalk',                        { 显示名 }
                             SERVICE_ALL_ACCESS,                { 权限 }
                             SERVICE_KERNEL_DRIVER,             { 服务类别 }
                             SERVICE_DEMAND_START,              { 启动类别 }
                             SERVICE_ERROR_NORMAL,              { 出错控件类别 }
                             @TDrvFileName[1],
                             nil,nil,nil,nil,nil);
 CloseServiceHandle(SchSCManager);
 if SchService = 0 then begin
  result := false;
  exit;
 end;
end;

function OpenCurProcessIOAllAccess(CurWnd: THandle): boolean;
var
BytesReturned : DWORD;
ProcessId : DWORD;
begin
 result := false;
 if not OpenPortTalk then exit;
 if not DeviceIoControl(PortTalk_Handle,
                        Cardinal(IOCTL_IOPM_RESTRICT_ALL_ACCESS),
                        nil,
                        0,
                        nil,
                        0,
                        BytesReturned,
                        nil) then begin
  ClosePortTalk;
  exit;
 end;
 if not DeviceIoControl(PortTalk_Handle,
                        Cardinal(IOCTL_IOPM_ALLOW_EXCUSIVE_ACCESS),
                        nil,
                        0,
                        nil,
                        0,
                        BytesReturned,
                        nil) then begin
  ClosePortTalk;
  exit;
 end;
 GetWindowThreadProcessId(CurWnd,@ProcessId);
 if not DeviceIoControl(PortTalk_Handle,
                        Cardinal(IOCTL_ENABLE_IOPM_ON_PROCESSID),
                        @ProcessId,
                        4,
                        nil,
                        0,
                        BytesReturned,
                        nil) then begin
  ClosePortTalk;
  exit;
 end;
 ClosePortTalk;
 sleep(300);
 result := true;
end;

function OpenCurrentProcessIOAllAccess(PID: THandle): boolean;
var
BytesReturned : DWORD;
begin
 result := false;
 if not OpenPortTalk then exit;
 if not DeviceIoControl(PortTalk_Handle,
                        Cardinal(IOCTL_IOPM_RESTRICT_ALL_ACCESS),
                        nil,
                        0,
                        nil,
                        0,
                        BytesReturned,
                        nil) then begin
  ClosePortTalk;
  exit;
 end;
 if not DeviceIoControl(PortTalk_Handle,
                        Cardinal(IOCTL_IOPM_ALLOW_EXCUSIVE_ACCESS),
                        nil,
                        0,
                        nil,
                        0,
                        BytesReturned,
                        nil) then begin
  ClosePortTalk;
  exit;
 end;
 if not DeviceIoControl(PortTalk_Handle,
                        Cardinal(IOCTL_ENABLE_IOPM_ON_PROCESSID),
                        @PID,
                        4,
                        nil,
                        0,
                        BytesReturned,
                        nil) then begin
  ClosePortTalk;
  exit;
 end;
 ClosePortTalk;
 sleep(300);
 result := true;
end;

function OutPortB(PortAddress:word;byte1:byte): boolean;
var
RCode: boolean;
BytesReturned: DWORD;
Buffer: array[0..2] of byte;
pBuffer: pword;
begin
 pBuffer := pword(@Buffer[0]);
 pBuffer^ := PortAddress;
 Buffer[2] := byte1;
 RCode := DeviceIoControl(PortTalk_Handle,
                          Cardinal(IOCTL_WRITE_PORT_UCHAR),
                          @Buffer,
                          3,
                          nil,
                          0,
                          BytesReturned,
                          nil);
 result := not RCode;
end;

function InPortB(PortAddress: word; var Error: boolean): byte;
var
RCode: boolean;
BytesReturned: DWORD;
Buffer: array[0..2]of byte;
pBuffer: pword;
begin
 pBuffer := pword(@Buffer[0]);
 pBuffer^ := PortAddress;
 RCode := DeviceIoControl(PortTalk_Handle,
                         cardinal(IOCTL_READ_PORT_UCHAR),
                         @Buffer,
                         2,
                         @Buffer,
                         1,
                         BytesReturned,
                         nil);
 Error := not RCode;
 Result := Buffer[0];
end;

function OpenIOPM: boolean;
var
CurProcessID  : THandle;
begin
 result := false;
 CurProcessID := GetCurrentProcessID;
 if CurProcessID <> 0 then begin
  IOPM_isOpen := OpenCurrentProcessIOAllAccess(CurProcessID);
  if IOPM_isOpen then begin
   result := true;
   Sleep(3);
  end;
 end;
end;


end.