PC-Aktionen an mehrere PCs im Netzwerk senden

[1ceman]

also habs sie kompiliert, das funktioniert auch.
wenn ich jetzt aus den Button Listen klicke kommt diese information:

Zitat:

Project C:\...\P_Netz_Server.exe faulted with message: 'Access violation at 0x009c5cc1: write of address 0x1a340042'. Process Stopped. Use Step or Run to continue.

hab die dll nochmal was geändert und das projekt auch, hier sind nochmal die aktuellen versionen:
Projekt:

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;
  procedure InstallHook(); external 'keyboardHook.dll';

var
  F_Netz_Server: TF_Netz_Server;
  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.B_ListenClick(Sender: TObject);
begin
  If B_Listen.Caption = 'Listen'
  Then begin
         ServerSocket.Port := SpE_Port.Value;
         ServerSocket.Open;
         Connections := 0;
         Timer.Enabled := True;
         B_Listen.Caption := 'Schließen';
         SpE_Port.Enabled := False;
         InstallHook;
       end
  Else begin
         ServerSocket.Close;
         B_Listen.Caption := 'Listen';
         Timer.Enabled := False;
         LB_Clients.Clear;
         LB_Clients.Items.Add('Clients');
         SpE_Port.Enabled := True;
         @UninstallHook :=  GetProcAddress(lib, 'UninstallHook')
       end;
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;
    //UnInstallHook;
  end; // else ERROR
end;

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

end.

so und jetzt die dll:

Delphi-Quellcode:

library KeyboardHook;

uses
  Windows,
  Messages;

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

function KeyboardHookProc(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(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 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.

//Edit: Viele Dank für eure Hilfe.