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

所属类别：DELPHI
推荐指数：★★★☆
文档人气：108
本周人气：1
发布日期：2008-4-29

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了。