WindowsXP 操作IO端口的Delphi的源代码(无需dll或sys)

type

  _DEBUG_CONTROL_CODE = (
    DebugSysReadIoSpace = 14,
    DebugSysWriteIoSpace = 15,
    DebugSysReadMsr = 16,
    DebugSysWriteMsr = 17,
    DebugSysReadBusData = 18,
    DebugSysWriteBusData = 19
    );
  DEBUG_CONTROL_CODE = _DEBUG_CONTROL_CODE;

  TIOStruct = record
    IoAddr: DWORD;
    Reserved1: DWORD;
    pBuffer: Pointer;
    NumBYTEs: DWORD;
    Reserved4: DWORD;
    Reserved5: DWORD;
    Reserved6: DWORD;
    Reserved7: DWORD;
  end;

function ZwSystemDebugControl(ControlCode: _DEBUG_CONTROL_CODE; InputBuffer: Pointer; InputBufferLength: ULONG; OutputBuffer: Pointer; OutputBufferLength: ULONG; ReturnLength: PULONG): LongInt; stdcall; external 'ntdll.dll';

function InPortB(Port: DWORD): Byte;
var
  Value                                                     : BYTE;
  io                                                        : TIOStruct;
begin
  Value := 0;
  io.IoAddr := Port;
  io.Reserved1 := 0;
  io.pBuffer := Pointer(@Value);
  io.NumBYTEs := sizeof(BYTE);
  io.Reserved4 := 1;
  io.Reserved5 := 0;
  io.Reserved6 := 1;
  io.Reserved7 := 0;
  ZwSystemDebugControl(DebugSysReadIoSpace, @io, sizeof(io), nil, 0, nil);
  Result := Value;
end;

procedure OutPortB(Port: DWORD; Value: Byte);
var
  io                                                        : TIOStruct;
begin
  io.IoAddr := Port;
  io.Reserved1 := 0;
  io.pBuffer := Pointer(@Value);
  io.NumBYTEs := sizeof(BYTE);
  io.Reserved4 := 1;
  io.Reserved5 := 0;
  io.Reserved6 := 1;
  io.Reserved7 := 0;
  ZwSystemDebugControl(DebugSysWriteIoSpace, @io, sizeof(io), nil, 0, nil);
end;

 function EnableDebugPrivilege(CanDebug: boolean): Boolean;
  function EnablePrivilege(hToken: Cardinal; PrivName: string; bEnable: Boolean): Boolean;
  var
    TP                                                      : Windows.TOKEN_PRIVILEGES;
    Dummy                                                   : Cardinal;
  begin
    TP.PrivilegeCount := 1;
    LookupPrivilegeValue(nil, pchar(PrivName), TP.Privileges[0].Luid);
    if bEnable then TP.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED else TP.Privileges[0].Attributes := 0;
    AdjustTokenPrivileges(hToken, False, TP, SizeOf(TP), nil, Dummy);
    Result := GetLastError = ERROR_SUCCESS;
  end;
var
  hToken                                                    : Cardinal;
begin
  OpenProcessToken(GetCurrentProcess, TOKEN_ADJUST_PRIVILEGES, hToken);
  Result := EnablePrivilege(hToken, 'SeDebugPrivilege', CanDebug);
  CloseHandle(hToken);
  hToken := 0;
end;

 

调用时，先调用EnableDebugPrivilege，就可以调用InPortB、OutPortB了。