Каким способом можно выполнить участки кода программы (процедуры или функции), написанн ые с использованием asm-вставок в этом кольце защиты, т.к. ОС Windows XP(2000) не разрешает на прямую работать с регистрами, прерываниями и портами компьютера. Компонент TVicHW32 не впаривать:).
 

1. Дельфийский линкер в жизни не слинкует драйвер режима ядра. Хотя теоритически сделать его полностью на дельфе можно
2. Выход есть. Нужно сделать драйвер режима ядра и он должен получить хендл твоего приложения, вскрыть таблицу TS, открыть доступ к портам твоему приложению из нулевого кольца. Тады будешь обращаться напрямую обычным образом. По идее нуно почитать про TSS, драйверы режима ядра, Native API, DDK, и менеджер SCM.
Причем само приложение на Дельфи может выступать в роли запускающего драйвер, но сам драйвер писать нужно на асме или сях.

Когда то копал в этой области, но сечас уже многое забыл, воть накопаное:
интерфейсная секция

function OpenSCManager(lpMachineName : LPSTR; lpDatabaseName : LPSTR;
           dwDesireAccess : DWORD): HWND; stdcall; external 'ADVAPI32.DLL' name 'OpenSCManagerA';
function CreateService(hSCManager : THandle; lpServiceName : LPSTR; lpDisplayName : LPSTR;
           dwDisiredAccess : DWORD; dwServiceType : DWORD; dwStartType : DWORD;
           dwErrorControl : DWORD; lpBinaryPathName : LPSTR; lpLoadOrderGroup : LPSTR;
           lpdwTagId : LPDWORD; lpDependencies : LPSTR; lpServiceStartName : LPSTR;
           lpPassword : LPSTR) : DWORD; stdcall; external 'ADVAPI32.DLL' name 'CreateServiceA';
function StartService(hService : DWORD; dwNumServiceArgs : DWORD; lpServiceArgVector : LPCTSTR) : boolean; stdcall; external 'ADVAPI32.DLL' name 'StartServiceA';
function DeleteService(hService : THandle): DWORD; stdcall; external 'ADVAPI32.DLL';
function CloseServiceHandle(hSCManager : THandle) : DWORD; stdcall; external 'ADVAPI32.DLL';

имплементэйшен

Код:

function ServiceInstall(DriverPath, DriverName, descriptor : String): THandle; var   SCMHandle : HWND;   SHandle : HWND; begin   result := 0;   if DriverName <> then     begin       SCMHandle := OpenSCManager(nil,nil,$2 );       if SCMHandle = 0 then exit;       SHandle := CreateService(SCMHandle, PChar(DriverName), PChar(descriptor), ($10+ $1000),                       $00000001, $00000003, $00000000, PChar(DriverPath), nil,nil,nil,nil,nil);       if SHandle = 0 then         begin           CloseServiceHandle(SCMHandle);           exit;         end;       if StartService(SHandle, 0, nil) = true then         begin           if not(DeleteService(SHandle)) then exit;           if not(CloseServiceHandle(SHandle)) then exit;           if not(CloseServiceHandle(SCMHandle)) then exit;           result := SHandle;         end;     end; end; procedure TForm1.Button1Click(Sender: PObj); var   s : string; begin   s := getstartdir+beeper1.sys;   if ServiceInstall(s,beeper1,) = 0 then     msgok(SysErrorMessage(getlasterror)); end;

работало, правда с удалением кажись траблы были, обязательно раскопай материал по регистрации сервисов, а то потом не сможешь в случае сбоя удалить драйвер из системы он просто прописывается в реестре и регится в БД сервисов, и прямое удаление из реестра или прописывание в нем не ведет к его фактическому запуску.

Код:

;@echo off ;goto make ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ; ;  giveio - Kernel Mode Driver ; ;  Demonstrate direct port I/O access from a user mode. ;   Based on c-souce by Dale Roberts ; ;  Written by Four-F (four-f@mail.ru) ; ;  WARNING: Tested W2000 & XP only! ; ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: .386 .model flat, stdcall option casemap:none ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ;                                  I N C L U D E   F I L E S                                        ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: include \masm32\include\w2k\ntstatus.inc include \masm32\include\w2k\ntddk.inc include \masm32\include\w2k\ntoskrnl.inc includelib \masm32\lib\w2k\ntoskrnl.lib include \masm32\mProgs\Macros\Strings.mac ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ;                           U S E R   D E F I N E D   E Q U A T E S                                  ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: IOPM_SIZE equ 2000h            ; sizeof I/O permission map ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ;                                         C O D E                                                    ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: .code ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ;                                       DriverEntry                                                  ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: DriverEntry proc pDriverObject:PDRIVER_OBJECT, pusRegistryPath:PUNICODE_STRING LOCAL status:NTSTATUS LOCAL oa:OBJECT_ATTRIBUTES LOCAL hKey:HANDLE LOCAL kvpi:KEY_VALUE_PARTIAL_INFORMATION LOCAL pIopm:PVOID LOCAL pProcess:PVOID    invoke DbgPrint, $CTA0("giveio: Entering DriverEntry\n")           mov status, STATUS_DEVICE_CONFIGURATION_ERROR    lea ecx, oa    InitializeObjectAttributes ecx, pusRegistryPath, 0, NULL, NULL    invoke ZwOpenKey, addr hKey, KEY_READ, ecx    .if eax == STATUS_SUCCESS       push eax       invoke ZwQueryValueKey, hKey, $CCOUNTED_UNICODE_STRING("ProcessId", 4), \                         KeyValuePartialInformation, addr kvpi, sizeof kvpi, esp       pop ecx       .if ( eax != STATUS_OBJECT_NAME_NOT_FOUND ) && ( ecx != 0 )          invoke DbgPrint, $CTA0("giveio: Process ID: %X\n"), \                         dword ptr (KEY_VALUE_PARTIAL_INFORMATION PTR [kvpi]).Data          ; Allocate a buffer for the IOPM (I/O permission map).          ; Holds 8K * 8 bits -> 64K bits of the IOPM, which maps the          ;  entire 64K I/O space of the x86 processor.          ;  Any 0 bits will give access to the corresponding port for user mode processes.          ;  Any 1 bits will disallow I/O access to the corresponding port.          invoke MmAllocateNonCachedMemory, IOPM_SIZE          .if eax != NULL             mov pIopm, eax             lea ecx, kvpi             invoke PsLookupProcessByProcessId, \                   dword ptr (KEY_VALUE_PARTIAL_INFORMATION PTR [ecx]).Data, addr pProcess             .if eax == STATUS_SUCCESS                invoke DbgPrint, $CTA0("giveio: PTR KPROCESS: %08X\n"), pProcess                invoke Ke386QueryIoAccessMap, 0, pIopm                .if al != 0                   ; We need only 70h & 71h I/O port access.                   ; So, we clear corresponding bits in IOPM.                   ; I/O access for 70h port                   mov ecx, pIopm                   add ecx, 70h / 8                   mov eax, [ecx]                   btr eax, 70h MOD 8                   mov [ecx], eax                   ; I/O access for 71h port                   mov ecx, pIopm                   add ecx, 71h / 8                   mov eax, [ecx]                   btr eax, 71h MOD 8                   mov [ecx], eax                   ; Set modified IOPM                   invoke Ke386SetIoAccessMap, 1, pIopm                   .if al != 0                      ; If second parameter to Ke386IoSetAccessProcess is 1, the process is given I/O access.                      ; If it is 0, access is removed.                      invoke Ke386IoSetAccessProcess, pProcess, 1                      .if al != 0                         invoke DbgPrint, $CTA0("giveio: I/O permission is successfully given\n")                      .else                         invoke DbgPrint, $CTA0("giveio: I/O permission is failed\n")                         mov status, STATUS_IO_PRIVILEGE_FAILED                      .endif                   .else                      mov status, STATUS_IO_PRIVILEGE_FAILED                   .endif                .else                   mov status, STATUS_IO_PRIVILEGE_FAILED                .endif                invoke ObDereferenceObject, pProcess             .else                mov status, STATUS_OBJECT_TYPE_MISMATCH             .endif             invoke MmFreeNonCachedMemory, pIopm, IOPM_SIZE          .else             invoke DbgPrint, $CTA0("giveio: Call to MmAllocateNonCachedMemory failed\n")             mov status, STATUS_INSUFFICIENT_RESOURCES          .endif       .endif       invoke ZwClose, hKey    .endif    invoke DbgPrint, $CTA0("giveio: Leaving DriverEntry\n")    mov eax, status    ret DriverEntry endp ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ;                                                                                                    ;::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: end DriverEntry :make \masm32\bin\ml /nologo /c /coff giveio.bat \masm32\bin\link /nologo /driver /base:0x10000 /align:32 /out:giveio.sys /subsystem:native giveio.obj del giveio.obj echo. pause

это нужно запихивать в бат файл и запускать. он сам откомпилится.