Club Delphi  
    FTP   CCD     Buscar   Trucos   Trabajo   Foros

Retroceder   Foros Club Delphi > Principal > API de Windows
Registrarse FAQ Miembros Calendario Guía de estilo Temas de Hoy

Respuesta
 
Herramientas Buscar en Tema Desplegado
  #1  
Antiguo 12-06-2007
leirbag000 leirbag000 is offline
Miembro
 
Registrado: jun 2007
Posts: 11
Poder: 0
leirbag000 Va por buen camino
Talking Por favor alguien me compilaria esta libreria?

Hola quisiera x favor que alguien me pueda compilar esta libreria dll , la verdad es que mi objetivo es ver la cara de mi vecino luego que yo le corra el programa en su pc jejeje tan solo sentirme un joker por un momento jeje
Estas lineas de codigo fueron escritas por el magnifico seaone , yo tan solo use un poco de logica y agregue un par de lineas , funcionara?
Ahi les va..

Código Delphi [-]
library Injection;
uses
  Windows, Sysutils, Messages, Psapi;
type
  TShared = record
    Hook: HHooK;
    AttachCount: Integer;
  end;
  PShared = ^TShared;
  PItem = ^TItem;
  TItem = record
    hWnd: HWND;
    WndProc: Pointer;
    Next: PItem;
  end;
var
  Mutex, Mem: THandle;
  Shared: PShared;
  Injected: Boolean;
  HandleList: PItem;
function FindWindowProc(hWnd: HWND; Item: PItem): Pointer;
begin
  if Item <> nil then
  begin
    if Item.hWnd = hWnd then
      Result:= Item.WndProc
    else
      Result:= FindWindowProc(hWnd,Item.Next);
  end else
    Result:= nil;
end;
function WindowProc(hWnd: HWND; Msg: UINT; WParam: WPARAM; LParam: LPARAM):
  LRESULT; stdcall;
var
  Str: String;
begin
  if (Msg = WM_SETTEXT) then
  begin
    Str:= String(PChar(LParam));
    Str:= StringReplace(Str,'128 MB','1,00 GB',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'256 MB','1,00 GB',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'512 MB','2,00 GB',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'233 MHz','2,5 GHz',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'300 MHz','2,5 GHz',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'333 MHz','2,5 GHz',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'400 MHz','2,5 GHz',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'500 MHz','2,5 GHz',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'533 MHz','2,5 GHz',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'700 MHz','2,5 GHz',[rfReplaceAll,rfIgnoreCase]);
    Str:= StringReplace(Str,'versión 2002','versión 2007',[rfReplaceAll,rfIgnoreCase]);
  LParam:= Longint(PChar(Str));
  end;
  Result:= CallWindowProc(FindWindowProc(hWnd,HandleList),hWnd,Msg,WParam,lParam);
end;
function HookWindow(hWnd: HWND): Pointer;
var
  Item: PItem;
begin
  Result:= FindWindowProc(hWnd, HandleList);
  if Result = nil then
  begin
    GetMem(Item,Sizeof(TItem));
    Item.hWnd:= hWnd;
    Item.Next:= HandleList;
    Item.WndProc:= Pointer(SetWindowLong(hWnd,GWL_WNDPROC,LongInt(@WindowProc)));
    HandleList:= Item;
  end;
end;
function CallWndProc(Code: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT;
  stdcall;
var
  ClassName: array[0..16] of Char;
begin
  if Code = HC_ACTION then
    if Injected then
    begin
      FillChar(ClassName,Sizeof(ClassName),0);
      if GetClassName(PCWPStruct(lParam).hwnd,@ClassName,Sizeof(ClassName)-1) > 0 then
      begin
        if StrIComp(ClassName,'Link Window') = 0 then
          HookWindow(PCWPStruct(lParam).hwnd);
      end;
    end;
  Result := CallNextHookEx(Shared^.Hook, Code, wParam, lParam);
end;
procedure StartHook; stdcall;
begin
  if Shared <> nil then
  begin
    WaitForSingleObject(Mutex, INFINITE);
    try
      with Shared^ do
      begin
        if Hook = 0 then
          Hook := SetWindowsHookEx(WH_CALLWNDPROC, @CallWndProc, HInstance, 0);
      end;
    finally
      ReleaseMutex(Mutex);
    end;
  end;
end;
procedure StopHook; stdcall;
begin
  if Shared <> nil then
  begin
    WaitForSingleObject(Mutex, INFINITE);
    try
      with Shared^ do
      begin
        if Hook <> 0 then
        begin
          UnhookWindowsHookEx(Hook);
          Hook := 0;
        end;
      end;
    finally
      ReleaseMutex(Mutex);
    end;
  end;
end;
procedure Inject;
var
  Process: THandle;
  ModName: array[0..MAX_PATH] of Char;
  Target: array[0..MAX_PATH] of Char;
begin
  Injected:= FALSE;
  Process := OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, FALSE,
    GetCurrentProcessId);
  if Process <> 0 then
  begin
    if GetModuleFileNameEx(Process, 0, ModName,sizeof(ModName)-1) > 0  then
    begin
      FillChar(Target,Sizeof(Target),#0);
      GetSystemDirectory(@Target,Sizeof(Target)-1);
      StrLCat(Target,'\rundll32.exe',Sizeof(Target)-1);
      if StrIComp(Target,ModName) = 0 then
      begin
        HandleList:= nil;
        Injected:= TRUE;
      end;
    end;
    CloseHandle(Process);
  end;
end;
procedure Attach; stdcall;
var
  isNew: boolean;
begin
  Mutex := CreateMutex(nil, True, '{92366DA1-4F66-472D-BE12-65F0993F62AC}');
  try
    Mem := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TShared),
      '{D1A38D62-9FAB-4298-A358-579D2D286E40}');
    isNew := GetLastError() = 0;
    if Mem <> 0 then
      Shared := MapViewOfFile(Mem, FILE_MAP_WRITE, 0, 0, 0)
    else
      Shared := nil;
    if Shared <> nil then
      if isNew then
        with Shared^ do
        begin
          Hook := 0;
          AttachCount := 1;
        end
      else
        inc(Shared^.AttachCount);
  finally
    ReleaseMutex(Mutex);
  end;
  // Aqui viene la inyeccion
  Inject;
end;
procedure UnHookWindows(Item: PItem);
begin
  if Item <> nil then
  begin
    UnHookWindows(Item.Next);
    SetWindowLong(Item.hWnd,GWL_WNDPROC,LongInt(Item.WndProc));
    FreeMem(Item);
  end;
end;
procedure Detach; stdcall;
begin
  WaitForSingleObject(Mutex, INFINITE);
  try
    if (Shared <> nil) then
      dec(Shared^.AttachCount);
  finally
    ReleaseMutex(Mutex);
  end;
  if (Shared <> nil) then
    if Shared^.AttachCount <= 0 then
    begin
      StopHook;
      UnmapViewOfFile(Shared);
      CloseHandle(Mem);
      CloseHandle(Mutex);
    end;
  if Injected then
    UnHookWindows(HandleList);
end;
procedure DLLEntryPoint(Reason: integer);
begin
  case Reason of
    Dll_Process_Detach: Detach;
    Dll_Process_Attach: Attach;
  end;
end;
exports
  StartHook,
  StopHook;
begin
  Attach;
  DLLProc:= @DLLEntryPoint;
end.

Por favor si pueden dejarme algun link donde pueda bajar el dll estaria mas que agradecido

Desde ya.. GRACIAS TOTALES por su tiempo..

Última edición por dec fecha: 12-06-2007 a las 13:51:42.
Responder Con Cita
Respuesta



Normas de Publicación
no Puedes crear nuevos temas
no Puedes responder a temas
no Puedes adjuntar archivos
no Puedes editar tus mensajes

El código vB está habilitado
Las caritas están habilitado
Código [IMG] está habilitado
Código HTML está deshabilitado
Saltar a Foro

Temas Similares
Tema Autor Foro Respuestas Último mensaje
Alguien tiene la libreria Borland.VclRTL.dll ??? coloso Conexión con bases de datos 0 31-05-2006 16:20:00
Usar una clase que esta dentro de una libreria lookmydoom OOP 3 18-04-2006 15:25:34
Por favor si me puede ayudar alguien Petolansa Conexión con bases de datos 3 29-07-2005 22:20:25
alguien tiene la libreria ElDioni Varios 3 15-07-2005 13:21:19
Por Favor, Si Alguien Lo Sabe Que Me Ayude Legolas Varios 1 10-11-2003 21:44:47


La franja horaria es GMT +2. Ahora son las 10:44:17.


Powered by vBulletin® Version 3.6.8
Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
Traducción al castellano por el equipo de moderadores del Club Delphi
Copyright 1996-2007 Club Delphi