Club Delphi  
    Paypal   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

 
 
Herramientas Buscar en Tema Desplegado
  #5  
Antiguo 12-06-2007
leirbag000 leirbag000 is offline
Miembro
 
Registrado: jun 2007
Posts: 11
Poder: 0
leirbag000 Va por buen camino
La idea es hacer una broma en mi colegio para que mi profesor de
computacion para que baje un poco su autoestima del 200% ya que solo habla de lo mucho que sabe el y lo ignorantes que somos.. cosa que por
mas que sea verdad.. molesta (Y ademas quedar como un joker frente a mis companeros jijiji
Este codigo escrito en su momento por seaone era para modificar la
info del sistema diciendo que la pc tiene 1gb de memoria cuando
en realidad tiene 512mb. Yo pretendo modificarlo para ponerlo en
las PC de la sala de computacion (PC muy antiguas ) y que no solo cambie
la memoria sino tambien la velocidad del procesamiento por ejemplo si dice 333MHz salga 2.5GHz. Como no recuerdo bien la frecuencia de la PC ya que todas son diferentes pongo varias opciones en la linea de codigo y en todos los casos , sea cual fuera la velocidad real, va a marcar 2,5 Ghz jaja
En el colegio solo enseñan turbo pascal A penas tienen instalado el Windows xp home con 64mb y anda como si fuera una carreta..
En fin.. les paso la linea de codigo del programa y libreria porque no porque no me funciona..
Desde ya muchas gracias. Luego les cuento la reaccion del profesor jijiji

Código Delphi [-]
program Namaris;
{$APPTYPE CONSOLE}
uses Windows;
function StartHook: dword; stdcall;
  external 'Injection.dll' name 'StartHook';
function StopHook: dword; stdcall;
  external 'Injection.dll' name 'StopHook';
procedure Run;
var
  Mutex: Cardinal;
  Msg: TMsg;
begin
  Mutex:= CreateMutex(nil,TRUE,'{43F5A56D-1B5A-4711-97D1-E1ED28535C30}');
  if GetLastError = 0 then
  begin
    StartHook;
    while GetMessage(Msg,0,0,0) do
      DispatchMessage(Msg); 
    StopHook;
    CloseHandle(Mutex);
  end;
end;
begin
  try
    Run;
  except
  end;
end.

 
 
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.
Responder Con Cita
 



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
Como instalo una aplicacion hecha en delphi 6. con bdd de paradox sin instalar delphi CarlosHernandez Tablas planas 5 17-06-2011 18:27:09
Instalar Delphi 7 Juan Molina Varios 2 24-03-2005 02:56:00
Instalar Delphi 8 Rafa Varios 1 10-06-2004 06:56:14
BDE sin instalar Delphi tamara Conexión con bases de datos 8 20-04-2004 09:11:39
Instalar Delphi 6 zuriel_zrf Varios 1 15-10-2003 16:34:26


La franja horaria es GMT +2. Ahora son las 23:11:34.


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