ايران ويج

نسخه‌ی کامل: meerkat ساخت درایور کرنل با دلفی
شما در حال مشاهده‌ی نسخه‌ی متنی این صفحه می‌باشید. مشاهده‌ی نسخه‌ی کامل با قالب بندی مناسب.
گروه AT4RE یک پروژه ساختند به نام KmdKit4D این کیت بنام Meerkat Advanced kernel mode driver میباشد که برای نوشتن درایور به زبان دلفی برای کارهای کوچک و بیشتر کاربری user میباشد که میتوانید نسخه 1.1 ان با پشتیبانی از دلفی های نسخه XE را از لینک زیر دریافت کنید به همراه 15 مثال

[تصویر:  meerkat.jpg]

کد:
حجم 2.06 مگ
http://www.at4re.com/download.php?mirror.22

این هم یک مثال دیگر
NtOpenProcess[SSDT Hook]i
کد:
unit Driver;

interface

uses
  ntddk;  // ---->DDDK.pas

function _DriverEntry(DriverObject: PDriverObject; RegistryPath: PUnicodeString): NTSTATUS; stdcall;

implementation

type
  TZwOpenProcess = function(ProcessHandle:PHandle; DesiredAccess:TAccessMask; ObjectAttributes:PObjectAttributes; ClientId:PClientId): NTSTATUS; stdcall;

var
  HookActive: Boolean;
  ZwOpenProcessNextHook: TZwOpenProcess;

function GetImportFunAddr(lpImportAddr: Pointer): Pointer; stdcall;
begin
  Result := PPointer(PPointer(Cardinal(lpImportAddr) + 2)^)^;
end;

function SystemServiceName(AFunc: Pointer): PLONG; stdcall;
var
  lpKeServiceDescriptorTable: PServiceDescriptorEntry;
begin
  lpKeServiceDescriptorTable := PPointer(@KeServiceDescriptorTable)^;
  Result := PLONG(Cardinal(lpKeServiceDescriptorTable^.ServiceTableBase) + (SizeOf(ULONG) * PULONG(ULONG(AFunc) + 1)^));
end;

function SystemServiceOrd(iOrd: ULONG): PLONG; stdcall;
var
  lpKeServiceDescriptorTable: PServiceDescriptorEntry;
begin
  lpKeServiceDescriptorTable := PPointer(@KeServiceDescriptorTable)^;
  Result := PLONG(PLONG(Cardinal(lpKeServiceDescriptorTable^.ServiceTableBase) + (SizeOf(ULONG) * iOrd)));
end;

function ZwOpenProcessHookProc(ProcessHandle:PHandle; DesiredAccess:TAccessMask; ObjectAttributes:PObjectAttributes; ClientId:PClientId): NTSTATUS; stdcall;
begin
  DbgPrint('ZwOpenProcess HookProc: NewZwOpenProcess(ProcessHandle:0x%.8X,DesiredAccess:0x%.8X,ObjectAttributes:0x%.8X,ClientId:0x%.8X)',
         ProcessHandle, DesiredAccess, ObjectAttributes, ClientId);

  Result := ZwOpenProcessNextHook(ProcessHandle, DesiredAccess, ObjectAttributes, ClientId);
  DbgPrint('ZwOpenProcess HookProc: NewZwOpenProcess(-):0x%.8X', Result);
end;

procedure DriverUnload(DriverObject:PDriverObject); stdcall;
begin
  if (HookActive) then
  begin
    asm
      cli                                               //disable WP bit
      push  eax
      mov   eax, cr0                                    //move CR0 register into EAX
      and   eax, not 000010000h                         //disable WP bit
      mov   cr0, eax                                    //write register back
      pop   eax
    end;

    ZwOpenProcessNextHook := TZwOpenProcess(xInterlockedExchange(SystemServiceName(GetImportFunAddr(@ZwOpenProcess)), LONG(@ZwOpenProcessNextHook)));

    asm
      push  eax                                           //enable WP bit
      mov   eax, cr0                                      //move CR0 register into EAX
      or    eax, 000010000h                               //enable WP bit
      mov   cr0, eax                                      //write register back
      pop   eax
      sti
    end;

    DbgPrint('ZwOpenProcess New Address: 0x%.8X', SystemServiceName(GetImportFunAddr(@ZwOpenProcess))^);
    DbgPrint('ZwOpenProcess Old Address: 0x%.8X', DWORD(@ZwOpenProcessNextHook));

    HookActive := False;
  end;
  DbgPrint('DriverUnload(-)');
end;

function _DriverEntry(DriverObject:PDriverObject;RegistryPath:PUnicodeString): NTSTATUS; stdcall;
begin
  DriverObject^.DriverUnload := @DriverUnload;
  Result := STATUS_SUCCESS;
  DbgPrint('DriverEntry(-):0x%.8X', Result);

  HookActive := False;

  DbgPrint('ZwOpenProcess Import Address: 0x%.8X', GetImportFunAddr(@ZwOpenProcess));
  DbgPrint('KeServiceDescriptorTable() Address 1: 0x%.8X', @KeServiceDescriptorTable);
  DbgPrint('KeServiceDescriptorTable() Address 2: 0x%.8X', PPointer(@KeServiceDescriptorTable)^);

  DbgPrint('ZwOpenProcess Ord Address: 0x%.8X', SystemServiceOrd($7A)^);    //  XP Ord!
  DbgPrint('ZwOpenProcess Name Address: 0x%.8X', SystemServiceName(GetImportFunAddr(@ZwOpenProcess))^);
  DbgPrint('ZwOpenProcess HookProc Address: 0x%.8X', @ZwOpenProcessHookProc);

  if (Not HookActive) then
  begin
    //  SSDT Hook
    asm                                             //disable WP bit
      cli
      push  eax
      mov   eax, cr0                                   //move CR0 register into EAX
      and   eax, not 000010000h                        //disable WP bit
      mov   cr0, eax                                   //write register back
      pop   eax
    end;

    //lpNew^ := LONG(lpOld);
    ZwOpenProcessNextHook := TZwOpenProcess(xInterlockedExchange(SystemServiceName(GetImportFunAddr(@ZwOpenProcess)), LONG(@ZwOpenProcessHookProc)));

    asm
      push  eax                                       //enable WP bit
      mov   eax, cr0                                  //move CR0 register into EAX
      or    eax, 000010000h                           //enable WP bit
      mov   cr0, eax                                  //write register back
      pop   eax
      sti
    end;

    DbgPrint('ZwOpenProcess New Address: 0x%.8X', SystemServiceName(GetImportFunAddr(@ZwOpenProcess))^);
    DbgPrint('ZwOpenProcess Old Address: 0x%.8X', DWORD(@ZwOpenProcessNextHook));

    HookActive := True;
  end else
  begin
    DbgPrint('ZwOpenProcess Hooked!!! By Anskya');
  end;
end;

end.
به نظر من کسی که میخواد درایور بنویسه بهتره از خود زبان سی استفاده کنه چون این پکیج خیلی ضعیفه و پر باگه و آخرش هم که به فایلهای آبجکت با کامپایلر سی به درایور تبدیل میشن!
در هر صورت ممنون.
زیاد مهم نیست به جای کامپایل object pascal یا همون delphi میتونی از کامپایلر freepascal استفاده کنی از wdk هم استفاده میکنه انگار با همون c++ داری مینویسی

کد:
http://wiki.freepascal.org/Target_NativeNT
http://my-tech-site.blogspot.com/2011/12/driver-in-freepascal-nativent.html