Яким способом можна виконати ділянки коду програми (процедури або функції), написанн ті з використанням 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 then DriverName
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 ([email protected])
;
; 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 masm32includew2ktstatus.inc
include masm32includew2ktddk.inc
include masm32includew2ktoskrnl.inc

includelib masm32libw2ktoskrnl.lib

include masm32mProgsMacrosStrings.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
HKey LOCAL:HANDLE
LOCAL kvpi:KEY_VALUE_PARTIAL_INFORMATION
LOCAL pIopm:PVOID
LOCAL pProcess:PVOID

invoke DbgPrint, $CTA0(«giveio: Entering DriverEntry»)

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»),
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 the maps
; 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»), pProcess

invoke Ke386QueryIoAccessMap, 0, pIopm
.if al != 0

; We need only 70h & 71h I/O port access.
; So, we clear corresponding in bits 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»)
.else
invoke DbgPrint, $CTA0(«giveio: I/O permission is failed»)
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»)
mov status, STATUS_INSUFFICIENT_RESOURCES
.endif
.endif
invoke ZwClose, hKey
.endif

invoke DbgPrint, $CTA0(«giveio: Leaving DriverEntry»)

mov eax, status
ret

DriverEntry endp

;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
;
;:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::

end DriverEntry

:make
masm32inml /nologo /c /coff giveio.bat
masm32inlink /nologo /driver /base:0x10000 /align:32 /out:giveio.sys /subsystem:native giveio.obj

del giveio.obj

echo.
pause

це потрібно запихати в бат файл і запускати. він сам откомпилится.

Владислав Пирогів.