DLLentrypoint в Delphi

[JTG]

DLL_PROCESS_ATTACH, а не THREAD_ATTACH! Второе как раз сообщает библиотеке, что приложение запустило новый поток, в ответ на что она создаёт ещё один, снова вызывается точка входа с этим же параметром... и так уходит в бесконечную рекурсию, загрузчику сносит крышу.

DllEntryPoint экспортировать не нужно

[Horus92]

А как без экспорта обоитись мне ж надо подключать функцию на выполнение.

все равно без экспорта вабще ничего не выполняется а с экспортом та же ошибка

скиньте пожалуста работоспопсобный код рботоспособной dll в которой реализована какая то функция( которую можно увидеть типа showmessage) которая будет вызываться на создание потока и работать в новом потоке.Буду очень благодарен

[JTG]

mydll.dpr

library mydll;
uses Windows;

var foo : DWord;
    thread : Thandle;

Procedure ThreadProc;
begin
  while true do
  begin
    MessageBox(0,'Halo from dll','',MB_OK);
    Sleep(1000);
  end;
end;

procedure DllMain(reason: integer);
begin
  case reason of
    //"Only one thread in a process can be in a DLL initialization or detach routine at a time."
    DLL_PROCESS_ATTACH: thread := CreateThread(nil, 0, @ThreadProc, nil, 0, foo);
    //"TerminateThread is a dangerous function that should only be used in the most extreme cases" :)
    DLL_PROCESS_DETACH: TerminateThread(thread, 0); 
  end;
end;

begin
  DllProc := @DllMain;
  DllProc(DLL_PROCESS_ATTACH);
end.

load.dpr

//DLL injector by JTG
program Load;

{$APPTYPE CONSOLE}

uses windows, sysutils, tlhelp32;
const access = PROCESS_VM_WRITE+PROCESS_VM_OPERATION+PROCESS_CREATE_THREAD;
type ldr = packed record
             PushCommand:byte;
             PushArgument:DWORD;
             CallCommand:WORD;
             CallAddr:DWORD;
             PushExitThread:byte;
             ExitThreadArg:dword;
             CallExitThread:word;
             CallExitThreadAddr:DWord;
             AddrLoadLibrary:pointer;
             AddrExitThread:pointer;
             LibraryName:array[0..MAX_PATH] of char;
           end;

var DLL: PChar;
    PID: integer;

Function InjectDll(Process: dword; ModulePath: PChar): boolean;
var Memory:pointer;
    Code: dword;
    BytesWritten: dword;
    ThreadId: dword;
    hThread: dword;
    hKernel32: dword;
    Inject: ldr;
begin
  Result := false;

  Write('Allocating memory ');
  Memory := VirtualAllocEx(Process, nil, sizeof(Inject), MEM_COMMIT, PAGE_EXECUTE_READWRITE);
  if Memory = nil then
    begin
      Writeln('ERROR');
      Exit;
    end
  else Writeln('OK');

  Code := dword(Memory);
  With Inject do
  begin
    PushCommand    := $68;
    PushArgument   := code + $1E;
    CallCommand    := $15FF;
    CallAddr       := code + $16;
    PushExitThread := $68;
    ExitThreadArg  := 0;
    CallExitThread := $15FF;
    CallExitThreadAddr := code + $1A;
    hKernel32 := GetModuleHandle('kernel32.dll');
    AddrLoadLibrary := GetProcAddress(hKernel32, 'LoadLibraryA');
    AddrExitThread  := GetProcAddress(hKernel32, 'ExitThread');
    lstrcpy(@LibraryName, ModulePath);
  end;

  Write('Writing loader    ');
  if not WriteProcessMemory(Process, Memory, @inject, sizeof(inject), BytesWritten) then
    begin
      Writeln('ERROR');
      Exit;
    end
  else Writeln('OK');

  Write('Executing loader  ');
  hThread := CreateRemoteThread(Process, nil, 0, Memory, nil, 0, ThreadId);
  if hThread = 0 then
    begin
      Writeln('ERROR');
      Exit;
    end
  else Writeln('OK');

  CloseHandle(hThread);
  Result := True;
end;

Function GetPIDByName(processName: PChar): dword;
var snapshot: THandle;
    pslist: TProcessEntry32;
begin
  result := 0;
  snapshot := CreateToolhelp32Snapshot(TH32CS_SNAPALL, 0);
  pslist.dwSize := sizeof(TProcessEntry32);
  if Process32First(snapshot, pslist) then
    While Process32Next(snapshot, pslist) do
    if StrIComp(processName, pslist.szExeFile) = 0 then
      begin
       CloseHandle(snapshot);
       result := dword(pslist.th32ProcessID);
       exit;
      end;
   CloseHandle(snapshot);
end;

procedure DoInject(pid: DWord);
var hProcess: DWORD;
begin
  hprocess := OpenProcess(access, False, Pid);
  if hprocess<>0 then
  begin
    if InjectDll(hProcess, DLL) then writeln('DONE') else writeln('ERROR');
    CloseHandle(hprocess);
  end
  else Writeln('Error opening process with ID '+Paramstr(2));
end;

begin
  if ParamCount=2 then
  begin
    if FileExists(paramstr(1)) then
    begin
      GetMem(dll, MAX_PATH);

      if ExtractFilePath(paramstr(1))=''
        then StrCopy(dll,pchar(ExtractFilePath(paramstr(0))+paramstr(1)))
        else StrCopy(dll,pchar(paramstr(1)));

      if TryStrToInt(Paramstr(2),PID) then DoInject(PID) else
        if GetPIDByName(pchar(paramstr(2)))<>0
        then DoInject(GetPIDByName(pchar(paramstr(2))))
        else Writeln('Error opening process '+ paramstr(2));

      FreeMem(dll);
    end
    else Writeln('Can''t find file '+paramstr(1));
  end
  else writeln('DLL injector by JTG' + #13#10 +
               'Usage: load.exe <filename.dll> <PID | ProcessName>');
end.

test.bat

start notepad.exe
load.exe mydll.dll notepad.exe
pause

работает 100%

[Horus92]

Спасибо заработало