[mag_cheater]

Добрый день! Имеется программа, которая управляет специализированными научными ISA платами (две платы соединенные шлейфом) под Win98. При анализе юнита, отвечающего за обращение к платам, я наткнулся под WinXP на ошибку при работе с машинным кодом: Privileged Instruction. Как я понял под ХР нужен доступ к нулевому кольцу через драйвер или через машинный код. Ни в том, ни в другом я не разбираюсь, поэтому прошу совета: есть ли сторонний софт/драйвер (giveio не помог) для полного доступа к портам ввода-вывода, или же, что лучше, есть ли возможность переписать нижеприведенный код для работы под ХР. Заранее спасибо.

Код:

//этот юнит нужен только для слотов ISA
//и содержит элементарные процедуры передачи и приема

unit IO;

interface

uses SysUtils;

const
STAT = 1;
DISA_LOCK = 1; {LOCK - шлюз, замок, запирать}
DAVR_LOCK = 2;

TIMEOUT = 1000000; //1000000;

procedure outp_as(addr_:integer;bdata:byte);
function inp_as(addr_:integer):byte;

procedure outp(addr_:integer;bdata:byte);
function inp(addr_:integer):byte;

procedure outp_b(addr_:integer;bdata:byte);
function inp_b(addr_:integer):byte;

procedure outp_w(addr_:integer;wdata:word);
function inp_w(addr_:integer):word;

procedure outp_l(addr_:integer;ldata:longint);
function inp_l(addr_:integer):longint;


type

ETimeOut = class(Exception); //SysUtils

implementation

uses MSTypes; //,Dialogs;

procedure outp_as(addr_:integer;bdata:byte);
asm
xchg eax,edx //обмен 32-х разрядными регистрами
out dx,al
end;

function inp_as(addr_:integer):byte;
asm
mov edx,eax
in al,dx
end;

procedure outp(addr_:integer;bdata:byte);
begin
if Is_W9x then outp_as(addr_,bdata)
else;
end;

function inp(addr_:integer):byte;
begin
if Is_W9x then Result := inp_as(addr_)
else Result := 0;
end;

procedure outp_b(addr_:integer; bdata : byte); //отослать bdata (byte) по адресу addr
var t:integer;
begin
//MessageDlg('outp_b-0', mtInformation,[mbOk], 0);
//DISA_LOCK = 1 - константа
t := 0;
while inp(addr_+STAT) AND DISA_LOCK > 0 do
begin
Inc(t);
if t > TIMEOUT then raise ETimeOut.Create('IO timeout - Output');
end;
//MessageDlg('outp_b-1', mtInformation,[mbOk], 0);
outp(addr_,bdata);
end;

function inp_b(addr_:integer):byte; //считать (получить) byte с адреса addr
var t:integer;
begin
//DAVR_LOCK = 2 - константа
//STAT = 1 - константа
// result := 0;

t := 0;
while inp(addr_+STAT) AND DAVR_LOCK = 0 do
begin Inc(t);
if t > TIMEOUT then
{begin RaiseErr := 'IO TimeOut!'; inc(RaiseNum); end;}
// try Break;
// finally result := 0;
// end;
raise ETimeOut.Create('IO timeout');
end;
result := inp(addr_);
end;

procedure outp_w(addr_:integer; wdata : word);
begin
//MessageDlg('outp_w-0', mtInformation,[mbOk], 0);
outp_b(addr_,wdata);
//MessageDlg('outp_w-1', mtInformation,[mbOk], 0);
outp_b(addr_,wdata SHR 8);
end;


function inp_w(addr_:integer):word;
begin
result := inp_b(addr_) OR inp_b(addr_) SHL 8;
end;

procedure outp_l(addr_:integer;ldata:longint);
begin
outp_b(addr_,ldata);
outp_b(addr_,ldata SHR 8);
outp_b(addr_,ldata SHR 16);
outp_b(addr_,ldata SHR 24);
end;

function inp_l(addr_:integer):longint;
begin
result := inp_b(addr_) OR inp_b(addr_) SHL 8 OR inp_b(addr_) SHL 16 OR inp_b(addr_) SHL 24;
end;

end.

Админ: учимся пользоваться тешами по назначению!

Защиту типа "if Is_W9x then ..." при компиляции я убирал.