Delphi-PRAXiS
Seite 1 von 2  1 2      

Delphi-PRAXiS (https://www.delphipraxis.net/forum.php)
-   Win32/Win64 API (native code) (https://www.delphipraxis.net/17-win32-win64-api-native-code/)
-   -   Delphi NtCreateThread verwenden (https://www.delphipraxis.net/105048-ntcreatethread-verwenden.html)

Zacherl 14. Dez 2007 18:26


NtCreateThread verwenden
 
Hey,

ich versuche verzweifelt mittelst NtCreateThread einen Thread zu erzeugen. Glaube ich mache irgendwas beim Allozieren des Stacks falsch, denn beide NtAllocateVirtualMemory Funktionen und danach auch die NtCreateThread Funktion schlagen fehl.

Delphi-Quellcode:
function ThreadProc(P: Pointer): Cardinal; stdcall;
begin
  MessageBox(0, 'Thread', 'Info', MB_SYSTEMMODAL);
end;

procedure DoCreateThread;

const
  THREAD_TERMINATE                = $0001;
  THREAD_SUSPEND_RESUME           = $0002;
  THREAD_GET_CONTEXT              = $0008;
  THREAD_SET_CONTEXT              = $0010;
  THREAD_SET_INFORMATION          = $0020;
  THREAD_QUERY_INFORMATION        = $0040;
  THREAD_SET_THREAD_TOKEN         = $0080;
  THREAD_IMPERSONATE              = $0100;
  THREAD_DIRECT_IMPERSONATION     = $0200;
  THREAD_SET_LIMITED_INFORMATION  = $0400;
  THREAD_QUERY_LIMITED_INFORMATION = $0800;
  THREAD_ALL_ACCESS               = STANDARD_RIGHTS_REQUIRED or SYNCHRONIZE or $03FF;

var
  ThreadHandle: Cardinal;
  DesiredAccess: Cardinal;
  ObjectAttributes: OBJECT_ATTRIBUTES;
  ProcessHandle: Cardinal;
  ClientID: CLIENT_ID;
  ThreadContext: CONTEXT;
  UserStack: USER_STACK;
  CreateSuspended: Boolean;
  P: Pointer;
begin
  DesiredAccess := THREAD_ALL_ACCESS;

  ObjectAttributes.Length := SizeOf(OBJECT_ATTRIBUTES);
  ObjectAttributes.RootDirectory := 0;
  ObjectAttributes.ObjectName := nil;
  ObjectAttributes.Attributes := 0;
  ObjectAttributes.SecurityDescriptor := nil;
  ObjectAttributes.SecurityQualityOfService := nil;

  ProcessHandle := GetCurrentProcess;

  FillChar(ThreadContext, SizeOf(CONTEXT), 0);
  ThreadContext.Eip := Longint(@ThreadProc);

 {
  userstack.FixedStackBase       // StackCommit
  userstack.FixedStackLimit      // StackReserve
  userstack.ExpandableStackBase  // StackBase
  userstack.ExpandableStackLimit // StackLimit
  userstack.ExpandableStackBottom // StackAllocate
                                                   }
  UserStack.FixedStackLimit := Pointer($1000000);
  UserStack.FixedStackBase := Pointer($1000000);
  if not NT_SUCCESS(NtAllocateVirtualMemory(ProcessHandle,
    @UserStack.ExpandableStackBottom, 0, UserStack.FixedStackLimit,
    MEM_RESERVE, PAGE_READWRITE)) then
  begin
    MessageBox(0, 'NtAllocateVirtualMemory1 failed', '', 0);
  end;
  UserStack.ExpandableStackBase := Pointer(Cardinal(UserStack.ExpandableStackBottom)
    + Cardinal(UserStack.FixedStackLimit));
  UserStack.ExpandableStackLimit := Pointer(Cardinal(UserStack.ExpandableStackBase)
    - Cardinal(UserStack.FixedStackBase));
  if not NT_SUCCESS(NtAllocateVirtualMemory(ProcessHandle,
    UserStack.ExpandableStackLimit, 0, UserStack.FixedStackBase,
    MEM_RESERVE, PAGE_READWRITE)) then
  begin
    MessageBox(0, 'NtAllocateVirtualMemory2 failed', '', 0);
  end;

  if not NT_SUCCESS(NtCreateThread(@ThreadHandle, DesiredAccess, @ObjectAttributes,
    ProcessHandle, @ClientID, @ThreadContext, @UserStack, CreateSuspended)) then
  begin
    MessageBox(0, 'NtCreateThread failed', '', 0);
  end;
end;
Weiß da jemand weiter?

Gruß

SirThornberry 14. Dez 2007 19:16

Re: NtCreateThread verwenden
 
hat es einen bestimmten Grund warum du diese Funktion nehmen willst und nicht die vorgefertigte die Delphi bereits mitbringt?

Zacherl 14. Dez 2007 19:27

Re: NtCreateThread verwenden
 
Ja! Meine Hoffnung ist, dass ich folgendes Problem damit lösen kann:
http://www.delphipraxis.net/internal...t.php?t=124714

Gruß

ErazerZ 17. Dez 2007 23:31

Re: NtCreateThread verwenden
 
Soooo, ich hab das mal ganze ins Delphi übersetzt und NtCreateThread funktioniert, kannst mal ausprobieren ob es unter Vista funkioniert! Falls es funktioniert dann können wir weiter daran arbeiten und es verbessern weil es gibt einen kleinen Fehler und zwar wird der Thread immer langsam ausgeführt - deswegen muss man davor einmal CreateRemoteThread von kernel32 aufrufen und danach erst unsere MyCreateRemoteThread funktion damit es ruckelfrei geladen wird. Aber das werd ich auch demächst beheben wenn ich mehr Zeit habe. Also viel Spaß beim testen und gute Nacht!

Delphi-Quellcode:
{
  17. Dezember 2007
  by ErazerZ

  Original code by soycola "a debuggable CreateProcessW implementation"
}

program xNtCreateThread;

{$APPTYPE CONSOLE}

uses
  Windows, JwaNative, JwaWindows;

type
  PINITIAL_TEB = ^INITIAL_TEB;
  INITIAL_TEB = record
    OldStackBase: PVOID;
    OldStackLimit: PVOID;
    StackBase: PVOID;
    StackLimit: PVOID;
    StackAllocationBase: PVOID;
  end;
  BASE_CONTEXT_TYPE = (BaseContextTypeProcess, BaseContextTypeThread, BaseContextTypeFiber);
  PBASE_CONTEXT_TYPE = ^BASE_CONTEXT_TYPE;

const
  KGDT_NULL = 0;
  KGDT_R0_CODE = 8;
  KGDT_R0_DATA = 16;
  KGDT_R3_CODE = 24;
  KGDT_R3_DATA = 32;
  KGDT_TSS = 40;
  KGDT_R0_PCR = 48;
  KGDT_R3_TEB = 56;
  KGDT_VDM_TILE = 64;
  KGDT_LDT = 72;
  KGDT_DF_TSS = 80;
  KGDT_NMI_TSS = 88;
  BASESRV_SERVERDLL_INDEX = 1;

function ThreadProc(P: Pointer): Cardinal; stdcall;
begin
  Result := MessageBox(0, 'Thread', 'Info', MB_SYSTEMMODAL);
end;

var
  BaseNamedObjectDirectory: THandle;

function Align(Value, Align: Cardinal): Cardinal;
begin
  if ((Value mod Align) = 0) then
    Result := Value
  else
    Result := ((Value + Align - 1) div Align) * Align;
end;

function BaseCreateStack(hProcess: THandle; StackSize: ULONG; MaximumStackSize: ULONG; InitialTeb: PINITIAL_TEB): NTSTATUS;
var
  Status: NTSTATUS;
  Stack: PCH;
  GuardPage: Boolean;
  RegionSize, OldProtect, ImageStackSize, ImageStackCommit: ULONG;
  NtHeaders: PIMAGE_NT_HEADERS;
  Peb: PPEB;
  PageSize: ULONG;
begin
  Result := STATUS_UNSUCCESSFUL;
  Peb := JwaNative.NtCurrentTeb.Peb;
  PageSize := $1000;
  // if the stack size was not supplied, then use the sizes from the image header
  NtHeaders := RtlImageNtHeader(Cardinal(Peb.ImageBaseAddress));
  ImageStackSize := NtHeaders^.OptionalHeader.SizeOfStackReserve;
  ImageStackCommit := NtHeaders^.OptionalHeader.SizeOfStackCommit;
  if (MaximumStackSize = 0) then
    MaximumStackSize := ImageStackSize;
  if (StackSize = 0) then
    StackSize := ImageStackCommit
  else
  begin
    if (StackSize >= MaximumStackSize) then
      MaximumStackSize := Align(StackSize, (1024 * 1024));
  end;
  StackSize := Align(StackSize, PageSize);
  MaximumStackSize := Align(MaximumStackSize, $10000);
  Stack := nil;
  Status := NtAllocateVirtualMemory(hProcess, @Stack, 0, @MaximumStackSize, MEM_RESERVE, PAGE_READWRITE);
  if not NT_SUCCESS(Status) then
    Exit;
  InitialTeb.OldStackBase := nil;
  InitialTeb.OldStackLimit := nil;
  InitialTeb.StackAllocationBase := Stack;
  InitialTeb.StackBase := PVOID(ULONG(Stack) +MaximumStackSize);
  Stack := PVOID(ULONG(Stack) + (MaximumStackSize - StackSize));
  if (MaximumStackSize > StackSize) then
  begin
    Stack := PVOID(ULONG(Stack) - PageSize);
    StackSize := StackSize + PageSize;
    GuardPage := True;
  end else
    GuardPage := False;
  // Commit the initially valid portion of the stack
  Status := NtAllocateVirtualmemory(hProcess, @Stack, 0, @StackSize, MEM_COMMIT, PAGE_READWRITE);
  if not NT_SUCCESS(Status) then
  begin
    RegionSize := 0;
    NtFreeVirtualMemory(hProcess, @Stack, @RegionSize, MEM_RELEASE);
    Exit;
  end;
  InitialTeb.StackLimit := Stack;
  // if we have space, create a guard page
  if (GuardPage) then
  begin
    RegionSize := PageSize;
    Status := NtProtectVirtualMemory(hProcess, @Stack, @RegionSize, PAGE_GUARD or PAGE_READWRITE, @OldProtect);
    if not NT_SUCCESS(Status) then
      Exit;
    InitialTeb.StackLimit := PVOID(ULONG(InitialTeb.StackLimit) + RegionSize);
  end;
  Result := STATUS_SUCCESS;
end;


procedure BaseInitializeContext(Context: PContext; Parameter: PVOID; InitialPc: PVOID; InitialSp: PVOID; ContextType: BASE_CONTEXT_TYPE);
begin
  Context.Eax := ULONG(InitialPc);
  Context.Ebx := ULONG(Parameter);
  Context.SegGs := 0;
  Context.SegFs := KGDT_R3_TEB;
  Context.SegEs := KGDT_R3_DATA;
  Context.SegDs := KGDT_R3_DATA;
  Context.SegSs := KGDT_R3_DATA;
  Context.SegCs := KGDT_R3_CODE;
  // Start the thread at IOPL=3
  Context.EFlags := $3000;
  // always start the thread at the thread start thunk
  Context.Esp := ULONG(InitialSp);
  Context.Eip := ULONG(InitialPc);
  // add code to check alignment and raise exception
  Context.ContextFlags := CONTEXT_FULL;
  Context.Esp := Context.Esp - SizeOf(Parameter);
end;

function BaseGetNamedObjectDirectory: THandle;
var
  Obja: TObjectAttributes;
  Status: NTSTATUS;
  DirAccess: ACCESS_MASK;
begin
  DirAccess := DIRECTORY_ALL_ACCESS and (DELETE or WRITE_DAC or WRITE_OWNER);
  RtlAcquirePebLock;
  if not Boolean(BaseNamedObjectDirectory) then
  begin
    InitializeObjectAttributes(@Obja, nil, OBJ_CASE_INSENSITIVE, 0, nil);
    Status := NtOpenDirectoryObject(@BaseNamedObjectDirectory, DirAccess, @Obja);
    if not NT_SUCCESS(Status) then
      BaseNamedObjectDirectory := 0;
  end;
  RtlReleasePebLock;
  Result := BaseNamedObjectDirectory;
end;

function BaseFormatObjectAttributes(ObjectAttributes: POBJECT_ATTRIBUTES; ObjectName: PUnicodeString): POBJECT_ATTRIBUTES;
var
  RootDirectory: THandle;
  Attributes: ULONG;
  SecurityDescriptor: PVOID;
begin
  SecurityDescriptor := nil;
  Attributes := 0;
  if (ARGUMENT_PRESENT(ObjectName))then
  begin
    if (ARGUMENT_PRESENT(ObjectName)) then
      RootDirectory := BaseGetNamedObjectDirectory
    else
      RootDirectory := 0;
    if (ARGUMENT_PRESENT(ObjectName)) then
      Attributes := Attributes or OBJ_OPENIF;
    InitializeObjectAttributes(ObjectAttributes, ObjectName, Attributes, RootDirectory, SecurityDescriptor);
    Result := ObjectAttributes;
  end else
    Result := nil;
end;

function MyCreateRemoteThread(hProcess: THandle; lpThreadAttributes: LPSECURITY_ATTRIBUTES;
                              dwStackSize: DWORD; lpStartAddress: LPTHREAD_START_ROUTINE;
                              lpParameter: LPVOID; dwCreationFlags: DWORD; lpThreadId: LPDWORD): THandle; stdcall;

var
  Status: NTSTATUS;
  ThreadHandle: THandle;
  ObjectAttributes: TObjectAttributes;
  pObj: PObjectAttributes;
  ClientId: TClientId;
  ThreadContext: TContext;
  InitialTeb: INITIAL_TEB;
  CreateSuspended: Boolean;
begin
  Result := INVALID_HANDLE_VALUE;
  Status := BaseCreateStack(hProcess, dwStackSize, 0, @InitialTeb);
  if not NT_SUCCESS(Status) then
    Exit;
  BaseInitializeContext(@ThreadContext, lpParameter, Pointer(@lpStartAddress), InitialTeb.StackBase, BaseContextTypeThread);
  pObj := BaseFormatObjectAttributes(@ObjectAttributes, nil);
  if ((dwCreationFlags and CREATE_SUSPENDED) = CREATE_SUSPENDED) then
    CreateSuspended := True
  else
    CreateSuspended := False;
  Status := NtCreateThread(@ThreadHandle, THREAD_ALL_ACCESS, pObj, hProcess, @ClientId, @ThreadContext, @InitialTeb, CreateSuspended);
  if not NT_SUCCESS(Status) then
    Exit;
 // if not CreateSuspended then
 //   NtResumeThread(ThreadHandle, nil);
  if (lpThreadId <> nil) then
    CopyMemory(lpThreadId, @ClientId.UniqueThread, SizeOf(ULONG));
  Result := ThreadHandle;
end;


var
  lpThreadId: ULONG;
  hProcess: THandle;
begin
  hProcess := OpenProcess(PROCESS_ALL_ACCESS, False, GetCurrentProcessId);
  if (hProcess <> INVALID_HANDLE_VALUE) then
  begin
    // erstellt man zuerst einen thread mittels
    // CreateRemoteThread und danach mittels MyCreateRemoteThread dann funktionieren
    // beide perfekt! Jedoch wenn man nur einen thread erstellt mittels
    // MyCreateRemoteThread dann funktioniert der thread nicht ganz
    // es muss sicherlich eine nachricht an windows gesendet werden oder sonstiges!
    // vielleicht mittels CsrClientCallServer? In CreateRemoteThread wird diese
    // aufjedenfall aufgerufen, aber naja
    CreateRemoteThread(hProcess, nil, 0, @ThreadProc, nil, 0, nil);
    MyCreateRemoteThread(hProcess, nil, 0, @ThreadProc, nil, 0, @lpThreadId);
  end;
  Sleep(3 * 1000);
end.

Zacherl 18. Dez 2007 13:20

Re: NtCreateThread verwenden
 
Boah cool es geht endlich :) Ich teste direkt mal und komme heute Abend mal in MSN, dann können wir noch bisschen weiter ausprobieren.

//Edit: Mir fällt grade auf, dass man hinter die MessageBox im Thread ein ExitThread(0) setzen sollte, um einen Fehler zu vermeiden. Ansonsten kommt eine Meldung, die man nicht entziffern kann und das CPU Fenster popt auf.

Unter Vista funktioniert das mit dem Thread sogar ohne vorherigen Aufruf von CreateRemoteThread :)

ErazerZ 18. Dez 2007 16:35

Re: NtCreateThread verwenden
 
Zitat:

Zitat von Zacherl
Boah cool es geht endlich :) Ich teste direkt mal und komme heute Abend mal in MSN, dann können wir noch bisschen weiter ausprobieren.

//Edit: Mir fällt grade auf, dass man hinter die MessageBox im Thread ein ExitThread(0) setzen sollte, um einen Fehler zu vermeiden. Ansonsten kommt eine Meldung, die man nicht entziffern kann und das CPU Fenster popt auf.

Unter Vista funktioniert das mit dem Thread sogar ohne vorherigen Aufruf von CreateRemoteThread :)

Ja funktion funktioniert sowieso ohne vorherigen Aufruf von CreateRemoteThread nur das problem ist das auf meinem PC der Thread einwenig hängt, also MessageBox wenns bewegst dann hängt diese. Und deswegen habe ich einfach einmal davor CreateRemoteThread aufgerufen.
Ich habe es heute in der Schule auf meinem Laptop getestet unter Delphi 7 und da ging es ruckelfrei! Aber auf meinem PC hier ruckelt die MessageBox und in Delphi 2007 krieg ich die ganzeeee Zeit Nachrichten vom Debugger das z.b Client-Server (csrss) nicht richtig geladen wurde oder so etwas. (Wenn ich nicht einmal davor CreateRemoteThread aufrufe..)

Zacherl 18. Dez 2007 17:06

Re: NtCreateThread verwenden
 
Das ist seltsam .. bei mir läuft es ruckelfrei. Auf meiner XP VM auch. Dort bekomme ich allerdings eine AV, wenn ich den Prozess irgendwann nach einem Aufruf von NtCreateThread beende. Aber das ist denke ich nicht so tragisch ..

ErazerZ 18. Dez 2007 17:44

Re: NtCreateThread verwenden
 
Ich bekomme andauernd diese Fehlermeldungen (ich glaube es liegt auch daran das es der Thread so hängt):

Zitat:

Modul entladen: lgscroll.dll. Prozess xNtCreateThread.exe (3536)
Modul laden: lgscroll.dll. Ohne Debug-Infos. Basisadresse: $10100000. Prozess xNtCreateThread.exe (3536)
Debug-Ausgabe: SXS: BasepCreateActCtx() Calling csrss server failed Prozess xNtCreateThread.exe (3536)
Debug-Ausgabe: LDR: LdrpWalkImportDescriptor() failed to probe C:\Programme\Logitech\SetPoint\lgscroll.dll for its manifest, ntstatus 0xc00000af Prozess xNtCreateThreadx.exe (3536)

Olli 19. Dez 2007 09:51

Re: NtCreateThread verwenden
 
Nebbett bereitet in seinem Beispiel allerlei Dinge für den Thread vor. Vielleicht da was vergessen?

Zacherl 19. Dez 2007 13:10

Re: NtCreateThread verwenden
 
Ja da ist noch ein Teil mit Dlls und sowas, soweit ich den C Code verstehe. Allerdings erscheinen die ganzen Debug Outputs und auch Dll lade / unload Nachrichten nicht in meinem Delphi. (Auch 2007)


Alle Zeitangaben in WEZ +1. Es ist jetzt 22:05 Uhr.
Seite 1 von 2  1 2      

Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz