Einzelnen Beitrag anzeigen

1ceman

Registriert seit: 16. Dez 2005
Ort: Odenthal
134 Beiträge
 
Delphi 6 Personal
 
#9

Re: PC-Aktionen an mehrere PCs im Netzwerk senden

  Alt 23. Okt 2007, 10:08
Danke für die schnelle Hilfe!

Nur es kommt nix bei der Form an. Ich glaube ich hab auch irgendwie die .dll nicht richtig drin.
Hier ist erstmal der Quellcode meiner Form:
(ich hab die deklarationen der uninteressanten Proceduren mal rausgenommen, damit es was übersichtlicher ist)
Delphi-Quellcode:
unit U_Netz_Server;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Spin, ScktComp, ExtCtrls, U_ASCII, Menus, Buttons, Winsock;

const
WM_KeyLogMessage = WM_USER + 23;

type
  TF_Netz_Server = class(TForm)
    ServerSocket: TServerSocket;
    SpE_Port: TSpinEdit;
    L_Port: TLabel;
    M_History: TMemo;
    E_Senden: TEdit;
    B_Senden: TButton;
    LB_Clients: TListBox;
    Timer: TTimer;
    B_Listen: TButton;
    RB_Key: TRadioButton;
    RB_Direkt: TRadioButton;
    RB_Kombi: TRadioButton;
    RB_Nichts: TRadioButton;
    Pop_ASCII: TPopupMenu;
    PopItem_ASCII: TMenuItem;
    BitB_Win_E: TBitBtn;
    B_Doppelpunkt: TButton;
    BitB_Win: TBitBtn;
    B_Slash: TButton;
    B_Backslash: TButton;
    B_Tab: TButton;
    B_Alt_F4: TButton;
    B_Shift_Tab: TButton;
    B_Alt_Tab: TButton;
    L_IP: TLabel;
    E_IP: TEdit;
    B_Strg_X: TButton;
    B_Strg_C: TButton;
    B_Strg_V: TButton;
    procedure TimerTimer(Sender: TObject);
    procedure B_ListenClick(Sender: TObject);
    procedure B_SendenClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure RB_KeyClick(Sender: TObject);
    procedure RB_KeyKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure B_ListenKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure B_SendenKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure E_SendenKeyDown(Sender: TObject; var Key: Word;
      Shift: TShiftState);
    procedure PopItem_ASCIIClick(Sender: TObject);
    procedure BitB_Win_EClick(Sender: TObject);
    procedure BitB_WinClick(Sender: TObject);
    procedure B_Alt_F4Click(Sender: TObject);
    procedure B_DoppelpunktClick(Sender: TObject);
    procedure B_SlashClick(Sender: TObject);
    procedure B_BackslashClick(Sender: TObject);
    procedure B_TabClick(Sender: TObject);
    procedure B_Shift_TabClick(Sender: TObject);
    procedure B_Alt_TabClick(Sender: TObject);
    function GetLocalIPs: String;
    procedure FormCreate(Sender: TObject);
    procedure B_Strg_XClick(Sender: TObject);
    procedure B_Strg_CClick(Sender: TObject);
    procedure B_Strg_VClick(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    protected
      procedure GotKeyMessage( var msg : TMessage ); message WM_KeyLogMessage;
  private
    { Private declarations }
    Connections: Integer;
    Keys_loggen: Boolean;
  public
    { Public declarations }
  end;

  
  TInstallHook = function(Hwnd: THandle): Boolean; stdcall;
  TUninstallHook = function: Boolean; stdcall;


var
  F_Netz_Server: TF_Netz_Server;
  InstallHook: TInstallHook;
  UninstallHook: TUninstallHook;
  lib: Cardinal;

implementation

{$R *.dfm}

procedure TF_Netz_Server.GotKeyMessage( var msg : TMessage );
begin
M_History.Lines.Add(inttostr(msg.WParam));
M_History.Lines.Add(inttostr(msg.lParam));
end;

procedure TF_Netz_Server.FormClose(Sender: TObject;
  var Action: TCloseAction);
begin
  ServerSocket.Close;
end;

procedure TF_Netz_Server.FormCreate(Sender: TObject);
begin
  E_IP.Text := GetLocalIPs;
  lib := LoadLibrary('Keyboardhook.dll');
  if lib <> INVALID_HANDLE_VALUE then begin
    InstallHook := GetProcAddress(lib, 'InstallHook');
    UnInstallHook := GetProcAddress(lib, 'UninstallHook');
  end; // else ERROR
end;

procedure TF_Netz_Server.FormDestroy(Sender: TObject);
begin
freelibrary(lib);
end;

end.

So und jetzt meine datei keyboardhook.dpr:

Delphi-Quellcode:
library Keyboardhook;

uses
  Windows,
  Messages;

var
  HookHandle: Cardinal = 0;
  WindowHandle: Cardinal = 0;
  WM_KeyLogMessage: WM_USER + 23;

function KeyboardHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
//es ist ebenfalls möglich die Bearbeitung an eine Bedingung zu knüpfen
//it's possible to call CallNextHookEx conditional only.
  Result := CallNextHookEx(HookHandle, nCode, wParam, lParam);
  case nCode < 0 of
    TRUE: exit; //wenn code kleiner 0 wird nix gemacht
                //if code smaller 0 nothing has to be done
    FALSE:
      begin
       sendmessage(HookHandle, WM_KeyLogMessage, wParam, lParam);
//Hier kann jetzt alles bearbeitet werden
//Here one can work with the parameters
      end;
  end;
end;

function MouseHookProc(nCode: Integer; wParam: WPARAM; lParam: LPARAM): LRESULT; stdcall;
begin
//es ist ebenfalls moeglich die Bearbeitung an eine Bedingung zu knuepfen
//it's possible to call CallNextHookEx conditional only.
  Result := CallNextHookEx(Mouse_HookHandle, nCode, wParam, lParam);
  case nCode < 0 of
    TRUE: exit; //wenn code kleiner 0 wird nix gemacht
                //if code smaller 0 nothing has to be done
    FALSE:
      begin
//Hier kann jetzt alles bearbeitet werden
//Here one can work with the parameters
        setprop(WindowHandle, 'mous_ncode', nCode);
        setprop(WindowHandle, 'mous_hwnd', PMOUSEHOOKSTRUCT(lParam)^.hwnd);
        setprop(WindowHandle, 'mous_hitt', PMOUSEHOOKSTRUCT(lParam)^.wHitTestCode);
        setprop(WindowHandle, 'mous_xpos', PMOUSEHOOKSTRUCT(lParam)^.pt.x);
        setprop(WindowHandle, 'mous_ypos', PMOUSEHOOKSTRUCT(lParam)^.pt.y);
        SendMessage(HWND_BROADCAST, WM_MOUSEHOOKMSG, wParam, lParam);
      end;
  end;
end;

function InstallHook(Hwnd: Cardinal): Boolean; stdcall;
begin
  Result := False;
  if HookHandle = 0 then begin
//Erstmal Hook installieren
//First install the hook
    HookHandle := SetWindowsHookEx(WH_KEYBOARD, @KeyboardHookProc, HInstance, 0);
//Uebergebenes Fensterhandle sichern
//Save the given window handle
    WindowHandle := Hwnd;
    Result := TRUE;
  end;
end;

function UninstallHook: Boolean; stdcall;
begin
//Hook aus der Hookchain entfernen
//Uninstall hook from hook chain
  Result := UnhookWindowsHookEx(HookHandle);
  HookHandle := 0;
end;

exports
//Installations- und Deinstallationsroutine exportieren
//Export the installation and deinstallation routine
  InstallHook,
  UninstallHook;
end.
Also entweder ist die dll nicht richtig drin oder die Message wird an nen falsches fenster gesendet.
Ich weiß aber leider net was da falsch sein soll...
Roman
  Mit Zitat antworten Zitat