Code não copila ajuda corrigir erro

[Francis carlos]

unit HookDLL; 
  
interface 
  
uses 
  Windows; 
  
const 
  IDT_RESET = (WM_USER+WM_TIMER+0xff); 
  SC_SENDTOTRAY = -90; 
  TRAYICONID = 4; 
  WS_HOOKEDWINDOW = (WS_CAPTION or WS_SYSMENU); 
  SWP_HOOKED = (SWP_DRAWFRAME or SWP_FRAMECHANGED or SWP_NOMOVE or SWP_NOZORDER or SWP_SHOWWINDOW); 
  
type 
  WNDDATA = record 
    m_hWnd: HWND; 
    m_OrigWndProc LRESULT; 
    m_niData: NOTIFYICONDATA; 
    m_Subclassed: BOOL; 
    m_Hidden: BOOL; 
  end; 
  
<div>#pragma data_seg(".SHARE") 
HHOOK g_KBHook = NULL; 
WNDDATA g_Window; 
BOOL g_InUse = FALSE; 
BOOL g_bKeyF12 = FALSE; 
BOOL g_bKeyF11 = FALSE; 
INT g_XRES = 800; 
INT g_YRES = 600; // default to 800 * 600 
UINT SWM_TRAYMSG; 
#pragma data_seg() 
#pragma comment(linker,"/SECTION:.SHARE,RWS")</div> 
  
var 
  ghModule: HINSTANCE = 0; 
  
function IH: BOOL; cdecl; 
function UIH: BOOL; cdecl; 
function GetFileIconHandle(lpszFileName: LPCTSTR; bSmallIcon: BOOL): HICON; 
function SubClassWindowProc(hWnd: HWND): BOOL; 
function RestoreWindowProc: BOOL; 
function IsMu(hWnd: HWND): BOOL; 
function SCWinProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 
function KBHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 
procedure TimerProc(hwnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall; 
procedure SetWindowRect(hWnd: HWND); 
procedure SR(Width, Height: Integer); cdecl; 
function WindowValid: BOOL; 
  
implemenation 
  
uses 
  ShellApi, SysUtils; 
  
procedure MyDllProc(Reason: Integer); 
begin 
  //Flesh out the entry point pending full implimentation 
  
  // reserve the DLL handle 
  ghModule = HInstance; 
  
  // register system-wide message 
  SWM_TRAYMSG := RegisterWindowMessage('TRAY_ACTIVATED'); 
  
  case Reason of 
    DLL_PROCESS_ATTACH: begin end; 
    DLL_THREAD_ATTACH: begin end; 
    DLL_THREAD_DETACH: begin end; 
    DLL_PROCESS_DETACH: begin end; 
  end; 
end; 
  
function KBHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 
var 
  hWnd: HWND; 
begin 
  //Flesh out the function pending implimentation 
  if nCode < 0 then 
  begin 
    Result := CallNextHookEx(g_KBHook, nCode, wParam, lParam); 
    Exit; 
  end; 
  
  case wParam of 
    VK_F11: 
    begin 
      if HIWORD(lParam) <> 0 then // the Key is down 
      begin 
        if not g_bKeyF11 then // key is not already down 
        begin 
          if not (g_InUse and WindowValid) then // a window is not subclassed or previous window is invalid 
          begin 
            // ok the hook has been requested to drop program to window 
            hWnd := GetForegroundWindow; // get the handle for the forground window 
  
            if IsMu(hWnd) then 
            begin 
              g_InUse := SubClassWindowProc(hWnd); // subclass the window and get its icon for its minimization 
  
              if g_InUse then 
              begin 
                ChangeDisplaySettings(nil, 0); // drop back to windows settings 
                SetWindowRect(hWnd); 
              end; 
  
              SetTimer(hWnd, IDT_RESET, 100, TimerProc); 
  
              g_bKeyF11 := True; 
            end; 
          end; 
        end; 
      end 
      else begin // the key is up 
        g_bKeyF11 := False; 
      end; 
    end; 
  
    VK_F12: 
    begin 
      if HIWORD(lParam) <> 0 then // the Key is down 
      begin 
        if not g_Window.m_Hidden then 
        begin 
          g_Window.m_Hidden := True; 
          Shell_NotifyIcon(NIM_ADD, @g_Window.m_niData); 
  
          // hide window 
          ShowWindow(g_Window.m_hWnd, SW_HIDE); 
        end; 
      end; 
    end; 
  end; 
  
  Result := CallNextHookEx(g_KBHook, nCode, wParam, lParam); 
end; 
  
function SCWinProc(hWnd: HWND; uMsg: UINT; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall; 
var 
  rct: TRect; 
  pos: POINTS; 
begin 
  case uMsg of 
    WM_DESTROY: 
    begin 
      KillTimer(g_Window.m_hWnd, IDT_RESET); 
      RestoreWindowProc; 
    end; 
    WM_SIZE, WM_ACTIVATE, WM_SETFOCUS, WM_KILLFOCUS: 
    begin 
      Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
      Exit; 
    WM_CLOSE: 
    begin 
      KillTimer(g_Window.m_hWnd, IDT_RESET); 
      RestoreWindowProc; 
    end; 
    WM_ACTIVATEAPP: 
    begin 
      if wParam <> 0 then 
        SetCapture(g_Window.m_hWnd) 
      else 
        ReleaseCapture; 
      Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
      Exit; 
    end; 
    WM_SETCURSOR, WM_NCACTIVATE: 
    begin 
      Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
      Exit; 
    end; 
    WM_COMMAND: 
    begin 
      if wParam = EN_KILLFOCUS then 
      begin 
        Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
        Exit; 
      end; 
    end; 
    WM_MOUSEMOVE: 
    begin 
      rct  =  Rect(0, 0, 0, 0); 
      pos := MAKEPOINTS(lParam); 
      GetClientRect(hWnd, rct); 
      if pos.x <= rct.right then 
      begin 
        if pos.y <= rct.bottom then 
        begin 
          ShowCursor(False); 
          Break; 
        end; 
      end; 
      ShowCursor(True); 
      Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
      Exit; 
    end; 
    WM_MOUSELEAVE: 
    begin 
      Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
      Exit; 
    end; 
    WM_SYSCOMMAND: // Intercept System Commands 
    begin 
      case wParam and $FFF0 of // Check System Calls 
        SC_SCREENSAVE, // Screensaver Trying To Start? 
        SC_MONITORPOWER: begin // Monitor Trying To Enter Powersave? 
          Result := 0; // Prevent From Happening 
          Exit; 
      end; 
    end; 
  else 
    if uMsg = SWM_TRAYMSG then 
    begin 
      if lParam = WM_LBUTTONDOWN then 
      begin 
        Shell_NotifyIcon(NIM_DELETE, @g_Window.m_niData); 
        ShowWindow(g_Window.m_hWnd, SW_SHOW); 
        g_Window.m_Hidden := False; 
      end; 
    end; 
  end; 
  
  //Flesh out the function pending implimentation 
  //Result := DefWindowProc(hWnd, uMsg, wParam, lParam); 
  Result := CallWindowProc(TFNWndProc(g_Window.m_OrigWndProc), hWnd, uMsg,wParam, lParam); 
end; 
  
function IH: BOOL; cdecl; 
begin 
  g_KBHook := SetWindowsHookEx(WH_KEYBOARD, KBHookProc, ghModule, 0); 
  Result := (g_KBHook <> nil); 
end; 
  
function UIH: BOOL; cdecl; 
begin 
  if g_InUse then 
    RestoreWindowProc; 
  
  Result := UnhookWindowsHookEx(g_KBHook); 
end; 
  
function GetFileIconHandle(lpszFileName: LPCTSTR; bSmallIcon: BOOL): HICON; 
var 
  uFlags: UINT; 
  sfi: SHFILEINFO; 
begin 
  uFlags := SHGFI_ICON or SHGFI_USEFILEATTRIBUTES; 
  
  if bSmallIcon then 
    uFlags := uFlags or SHGFI_SMALLICON 
  else 
    uFlags := uFlags or SHGFI_LARGEICON; 
  
  SHGetFileInfo(lpszFileName, FILE_ATTRIBUTE_NORMAL, @sfi, SizeOf(SHFILEINFO), uFlags); 
  Result := sfi.hIcon; 
end; 
  
function SubClassWindowProc(hWnd: HWND): BOOL; 
var 
  szText: array[0..254] of Char; 
  szPath: array[0..254] of Char; 
  hIcon: HICON; 
  hModule: HMODULE; 
begin 
  GetWindowText(hWnd, szText, 255); 
  
  // prepare a NotifyData struct for this window 
  ZeroMemory(@(g_Window.m_niData), SizeOf(NOTIFYICONDATA)); 
  g_Window.m_niData.cbSize := SizeOf(NOTIFYICONDATA); 
  g_Window.m_niData.hWnd := hWnd; 
  
  hIcon := HICON(SendMessage(hWnd, WM_GETICON, ICON_SMALL, 0)); 
  if hIcon <> 0 then 
  begin 
    hModule := HMODULE(OpenProcess(0, False, GetWindowThreadProcessId(hWnd, 0))); 
    GetModuleFileName(hModule, szPath, 255); 
    hIcon := GetFileIconHandle(szPath, True); 
  end; 
  
  if hIcon <0>= 0); 
end; 
  
procedure SetWindowRect(hWnd: HWND); 
var 
  rct: TRect; 
  bHasMenu: BOOL; 
begin 
  rct = Rect(0, 0, g_XRES, g_YRES); 
  bHasMenu := True; 
  
  SetWindowLongPtr(hWnd, GWL_STYLE, WS_HOOKEDWINDOW); 
  SetWindowLongPtr(hWnd, GWL_EXSTYLE, WS_EX_OVERLAPPEDWINDOW); 
  
  if GetMenu(g_Window.m_hWnd) = 0 then 
    bHasMenu := False; 
  
  AdjustWindowRectEx(rct, WS_HOOKEDWINDOW, bHasMenu, WS_EX_OVERLAPPEDWINDOW); 
  SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, rct.right - rct.left, rct.bottom-rct.top, SWP_HOOKED); 
  
  ShowCursor(True); 
end; 
  
procedure SR(Width, Height: Integer); cdecl; 
begin 
  g_XRES := Width; 
  g_YRES := Height; 
end; 
  
function WindowValid: BOOL; 
var 
  hWnd: HWND; 
  ErrorCode: DWORD; 
begin 
  hWnd := GetWindow(g_Window.m_hWnd, GW_HWNDFIRST); // QUICKHACK: to check if window is still valid 
  ErrorCode := GetLastError; 
  Result := (ErrorCode <> ERROR_INVALID_WINDOW_HANDLE); 
end; 
  
procedure TimerProc(hWnd: HWND; uMsg: UINT; idEvent: UINT_PTR; dwTime: DWORD); stdcall; 
var 
  rct: TRect; 
  bHasMenu: BOOL; 
begin 
  if idEvent = IDT_RESET then 
  begin 
    if not WindowValid then 
    begin 
      KillTimer(g_Window.m_hWnd, IDT_RESET); 
      MessageBox(g_Window.m_hWnd, 'Timer killed', 'TIMER', MB_OK); 
    end; 
  
    if not g_Window.m_Hidden then 
    begin 
      rct = Rect(0, 0, g_XRES, g_YRES); 
      bHasMenu := True; 
  
      if GetMenu(g_Window.m_hWnd) = 0 then 
        bHasMenu := False; 
  
      AdjustWindowRectEx(rct, WS_HOOKEDWINDOW, bHasMenu, WS_EX_OVERLAPPEDWINDOW); 
      SetWindowPos(hWnd, HWND_NOTOPMOST, 0, 0, rct.right - rct.left, rct.bottom-rct.top, SWP_HOOKED); 
      //ShowCursor(True); 
    end; 
  end; 
end; 
  
function IsMu(hWnd: HWND): BOOL; 
var 
  szText: array[0..254] of Char; 
  szPath: array[0..254] of Char; 
  Len: Integer; 
  hModule: HMODULE; 
begin 
  szText[0] := #0; 
  szPath[0] := #0; 
  
  hModule := HMODULE(OpenProcess(0, False, GetWindowThreadProcessId(hWnd, 0))); 
  Len := GetWindowText(hWnd, szText, 255); 
  
  if StrIComp(szText, 'mu') <> 0 then 
  begin 
    Result := False; 
    Exit; 
  end; 
  
  GetModuleFileName(hModule, szPath, 255); 
  CloseHandle(hModule); 
  
  if not AnsiSameText(ExtractFileName(szPath), 'main.exe') then 
  begin 
    Result := False; 
    Exit; 
  end; 
  
  Result := True; 
end; 
  
exports 
  IH, UIH, SR; 
  
initialization 
  DllProc := MyDllProc; 
  MyDllProc(DLL_PROCESS_ATTACH.); 
finalization 
  DllProc := nil; 
end.

[Jhonas]

amigo , esse código é uma conversão de uma dll em C++ para delphi

https://forums.embarcadero.com/thread.jspa?messageID=181022

então voce vai em File > New > Unit

e cole esse código nessa unit, salve e depois utilize-a como uma chamada em seu aplicativo

OBS:

O comando compile pode ser usado somente quando você tiver carregado um projeto no editor.

Se nenhum projeto estiver ativo e você carregar um arquivo-fonte Pascal ( como essa unit ) , não poderá compilá-lo.

Porém se você carregar o arquivo-fonte como se ele fosse um projeto, poderá compila-lo

Se houver algum erro no código, durante a execução o erro será informado

abraço

[Francis carlos]

amigo , esse código é uma conversão de uma dll em C++ para delphi

https://forums.embarcadero.com/thread.jspa?messageID=181022

então voce vai em File > New > Unit

e cole esse código nessa unit, salve e depois utilize-a como uma chamada em seu aplicativo

OBS:

O comando compile pode ser usado somente quando você tiver carregado um projeto no editor.

Se nenhum projeto estiver ativo e você carregar um arquivo-fonte Pascal ( como essa unit ) , não poderá compilá-lo.

Porém se você carregar o arquivo-fonte como se ele fosse um projeto, poderá compila-lo

Se houver algum erro no código, durante a execução o erro será informado

abraço

amigo é que ta mal convertida, ta com muitos errinhos

você poderia ajudar corrigir

ex:

type

WNDDATA = record

m_hWnd: HWND;

m_OrigWndProc LRESULT; << falta :

m_niData: NOTIFYICONDATA;

m_Subclassed: BOOL;

m_Hidden: BOOL;

end;

e otras coisinhas

Editado Novembro 25, 2010 por Francis carlos

[Jhonas]

Estou terminando um trabalho, e fazer correções em código toma tempo

veja se esse ajuda.

http://www.progamercity.net/delphi/hookapi...ation-t847.html

abraço