Autotext-Programm - aber wie?

[Marco Steinebach]

Hallo zusammen,
Ich brauche bitte doch nochmal eure Hilfe.
Ich hab's jetzt so umgebaut, daß das Wort, welches vor dem Cursor steht, in die Zwischenablage kopiert, ausgewertet, ggf. ersetzt, und dann mittels strg+v wieder eingefügt wird. Daß die Zwischenablage dabei überschrieben werden kann, ist klar, stör micht aber nicht - außer, es gibt eine schönere lösung.
Aber, wenn ich das Programm ausführe, kommt es zu eine exception, und mir ist überhaupt nicht klar, warum.
Hat jemand 'ne Idee, was ich hier falsch gemacht abe?

Delphi-Quellcode:

unit main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs;

type
  TGlobalHotkey = record // damit's zusammengefaßt ist
    AtomName: string;
    atom: integer;
  end;
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private-Deklarationen }
    globalHotkey: TGlobalHotkey;
    hNextViewer: DWORD; // Handle des nexten Mitglieds in der Clipboard-Viewer-Kette
    hf: hwnd; // handle des fordergrundfensters, in dem strg+leertaste gedrückt wird.
    procedure CopyTextToClipboard (aWnd: HWND; aText: PChar);
    function GetFocusedControlHandle: HWND;
  public
    { Public-Deklarationen }
    procedure WMHotKey (var Msg: TWMHotKey); message WM_HOTKEY;
    procedure WMChangeCBChain(var Msg: TMessage); message WM_CHANGECBCHAIN;
    procedure WMDrawClipboard(var Msg: TMessage); message WM_DRAWCLIPBOARD;
  end;

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.FormCreate(Sender: TObject);
begin
  with globalHotkey do
  begin
    AtomName := 'Test_Strg_Leertaste';
    atom := GlobalFindAtom (pChar(AtomName));
    if atom = 0 then // Atom gibt's noch nicht ...
      atom := GlobalAddAtom (pChar(AtomName));
      // sonst wird das bereits vorhandene in Atom gespeichert.
    RegisterHotkey (handle, atom, mod_Control, vk_space)
  end;
  // hängen wir uns in die Clipboard-Kette..,.
  hNextViewer := SetClipBoardViewer (Handle);
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  // hotkey weg und raus aus der Clipboardkette...
  unregisterHotkey (handle, globalHotkey.Atom);
  ChangeClipBoardChain(Handle, hNextViewer);
  action := caFree;
end;

procedure TForm1.WMChangeCBChain(var Msg: TMessage);
begin
  if Msg.WParam = hNextViewer then
    hNextViewer := Msg.lParam
  else if hNextViewer <> 0 then
    SendMessage(hNextViewer, MSG.Msg, MSG.wParam, MSG.lParam);
end;

procedure TForm1.CopyTextToClipboard(aWnd: HWND; aText: PChar);
var
  Data: THandle;
  DataPtr: Pointer;
  Size: Integer;
  oldWND: HWND;
begin
  Size := Length(aText) + 1;
  OpenClipboard(aWnd); //Open Clipboard
  try
    EmptyClipboard; // Clear Clipboard
    oldWND := SetClipboardViewer(aWnd); // Clipboard für Programm registr.
    Data := GlobalAlloc(GMEM_MOVEABLE or GMEM_DDESHARE, Size); // Get Memory
    try
      DataPtr := GlobalLock(Data);
      try
        Move(aText^, DataPtr^, Size);
        SetClipboardData(CF_TEXT, Data); // Clpbrd-Format as Text & send Text
      finally
        GlobalUnlock(Data);
      end;
    except
      GlobalFree(Data); // Free res. Memory
      raise; // Get global Memory Err
    end;
    ChangeClipboardChain(aWnd, oldWND);
  finally
    CloseClipboard; //Close Clipboard
  end;
end;

procedure TForm1.WMDrawClipboard(var Msg: TMessage);
var
  hClipbrdObj: THandle;
  pClipbrdObj: Pointer;
  s: string;
begin
  OpenClipboard(Handle);
  hClipbrdObj := GetClipboardData(CF_TEXT);
  if hClipbrdObj = 0 then // nix text oder drin...
  begin
    CloseClipBoard;
    exit;
  end;
  pClipbrdObj := GlobalLock(hClipbrdObj);
  s := pChar (pClipbrdObj); // sollte der im Clipboard stehende Text sein
  GlobalUnlock(DWORD(pClipbrdObj));
  GlobalFree(hClipbrdObj);
  CloseClipBoard;
  if uppercase (s) <> 'MFG' then exit; // blos zum testen.
  s := 'Mit freundlichen Grüßen!';
  CopyTextToClipboard (handle, pChar(s));
  // strg+v
  keybd_event (vk_control, 0, 0, 0);
  keybd_event (vkKeyScan('v'), 0, 0, 0);
  keybd_event (vkKeyScan('v'), 0, keyeventf_keyup, 0);
  keybd_event (vk_control, 0, keyeventf_keyup, 0);
end;

function TForm1.GetFocusedControlHandle: HWND;
var
  FG_Window_Handle: HWND;
  FocusedThreadID: DWORD;
begin
  FG_Window_Handle := GetForegroundWindow;

  FocusedThreadID := GetWindowThreadProcessID (FG_Window_Handle, nil);

  if AttachThreadInput (GetCurrentThreadID, FocusedThreadID, true) then
    Result := GetFocus
  else result := 0;
  AttachThreadInput (GetCurrentThreadID, FocusedThreadID, false);
end;

procedure TForm1.WMHotKey(var Msg: TWMHotKey);
begin
  hf := GetFocusedControlHandle;
  if hf = 0 then exit;

  // strg+shift+pfeil links - Wort vor'm Cursor markieren...
  keybd_event (vk_control, 0, 0, 0);
  keybd_event (vk_Shift, 0, 0, 0);
  keybd_event (vk_left, 0, 0, 0);
  keybd_event (vk_left, 0, keyeventf_keyup, 0);
  keybd_event (vk_shift, 0, keyeventf_keyup, 0);
  keybd_event (vk_control, 0, keyeventf_keyup, 0);
  // strg+c - ab in die Zwischenablage
  keybd_event (vk_control, 0, 0, 0);
  keybd_event (vkKeyScan('c'), 0, 0, 0);
  keybd_event (vkKeyScan('c'), 0, keyeventf_keyup, 0);
  keybd_event (vk_control, 0, keyeventf_keyup, 0);
  // jetzt, sollte, eigentlich WMDrawClipboard greifen...
end;

end.

Viele Grüße
Marco
p.s.: bitte entschuldigt, daß ich nicht mehr alle Querverweise parat habe, bei wem ich mir was abgeschaut habe!