Autor Beitrag
xi23
Hält's aus hier
Beiträge: 13



BeitragVerfasst: Di 20.08.02 23:12 
hi,
ich habe folgende dll erstellt (quellcode von assarbad glaube ich). Ich habe ihn ein wenig abgeändert,
sodass beim createn eines fensters das fenster transparent werden soll. es muss aber ein fehler im quellcode
sein, da die HookProc function anscheinend nur 1x ausgeführt wird. kann mir vielleicht jemand den fehler
sagen, ich bedanke mich für eure mühen schonma im vorraus.


DLL Source:
ausblenden volle Höhe Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
library dll;

uses
  Windows,
  SysUtils,
  Messages;

type TSetLayeredWindowAttributes = function (Hwnd: THandle; crKey: COLORREF; bAlpha: Byte; dwFlags: DWORD): Boolean; stdcall;

var
  HookHandle: Cardinal = 0;
  WindowHandle: Cardinal = 0;
  SetLayeredWindowAttributes: TSetLayeredWindowAttributes = nil;

procedure SetLayeredAttribs(XHandle:THandle;colval:integer;hide:boolean);
procedure InitProcs;
const
  sUser32 = 'User32.dll';
var
  ModH: HMODULE;
begin
  ModH := GetModuleHandle(sUser32);
  if ModH <> 0 then
     @SetLayeredWindowAttributes := GetProcAddress(ModH, 'SetLayeredWindowAttributes');
end;

const
  cUseAlpha: array [Boolean] of Integer = (0, LWA_ALPHA);
  cUseColorKey: array [Boolean] of Integer = (0, LWA_COLORKEY);
var
  AStyle: Integer;
begin
  InitProcs;
  if(Assigned(SetLayeredWindowAttributes)) then
  begin
    AStyle := GetWindowLong(XHandle, GWL_EXSTYLE);
    if hide then
    begin
      if (AStyle and WS_EX_LAYERED) = 0 then
        SetWindowLong(XHandle, GWL_EXSTYLE, AStyle or WS_EX_LAYERED);
      SetLayeredWindowAttributes(XHandle, 0, colval,
        cUseAlpha[hide]);
    end
    else
    begin
      SetWindowLong(XHandle, GWL_EXSTYLE, AStyle and not WS_EX_LAYERED);
      RedrawWindow(XHandle, nil, 0, RDW_ERASE or RDW_INVALIDATE or RDW_FRAME or RDW_ALLCHILDREN);
    end;
  end;
end;

function HookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
var
  cwps: TCWPStruct;
begin
  //if (nCode = HC_ACTION) then
  if (nCode >= 0) then
  begin
    fillchar(cwps,Sizeof(CWPStruct),0);
    CopyMemory(@cwps, Pointer(lParam), SizeOf(CWPSTRUCT));
    case cwps.message of
      WM_CREATE:
        begin
             SetLayeredAttribs(cwps.hwnd,180,true);
        end;
    end;
  end
  else
   Result := CallNextHookEx(WH_CALLWNDPROC, nCode, wParam, lParam)
end;

function InstallHook(Hwnd: Cardinal): Boolean; stdcall;
var
 tpid : DWORD;
begin
  tpid := GetWindowThreadProcessId(hwnd, nil);
  Result := False;
  if HookHandle = 0 then begin
    HookHandle := SetWindowsHookEx(WH_CALLWNDPROC, @HookProc, HInstance, tpid);
    WindowHandle := Hwnd;
    Result := TRUE;
  end;
end;

function UninstallHook: Boolean; stdcall;
begin
  Result := UnhookWindowsHookEx(HookHandle);
  HookHandle := 0;
end;

exports
  InstallHook,
  UninstallHook;

end.


Form Source:
ausblenden volle Höhe Quelltext
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
type
  TInstallHook = function(Hwnd: THandle): Boolean; stdcall;
  TUninstallHook = function: Boolean; stdcall; 

procedure TForm1.Button1Click(Sender: TObject);
var
  InstallHook: TInstallHook;
  UninstallHook: TUninstallHook;
  lib: Cardinal;
begin
  lib := LoadLibrary('dll.dll');
  if lib <> INVALID_HANDLE_VALUE then begin
    InstallHook := GetProcAddress(lib, 'InstallHook');
  end; // else ERROR
  InstallHook(hInstance);
  timer1.Enabled := true;
end;


procedure TForm1.Button2Click(Sender: TObject);
var
  InstallHook: TInstallHook;
  UninstallHook: TUninstallHook;
  lib: Cardinal;

begin
  lib := LoadLibrary('dll.dll');
  if lib <> INVALID_HANDLE_VALUE then begin
    UnInstallHook := GetProcAddress(lib, 'UninstallHook');
  end; // else ERROR
  UnInstallHook;
end;