//------------------------------------------------Tastendruck an fremdes Fenster
procedure PressKey(Key: Word);
overload;
begin
keybd_event(Key, 0, 0, 0);
keybd_event(Key, 0, KEYEVENTF_KEYUP, 0);
end;
procedure PressKey(Key: Char);
overload;
begin
PressKey(vkKeyScan(Key));
end;
//------------------------------------------------Tastendruck an fremdes Fenster
//-------------------------------------Username des eingeloggten Users ermitteln
function GetUsername:
String;
var
Buffer:
array[0..255]
of Char;
Size: DWord;
begin
Size := SizeOf(Buffer);
if not Windows.GetUserName(Buffer, Size)
then
RaiseLastOSError;
SetString(Result, Buffer, Size - 1);
end;
//-------------------------------------Username des eingeloggten Users ermitteln
//----------------------------------------------------------------Fenster finden
function FindWindowEx2(hParent: HWND; ChildClassName:
string; ChildNr: Word): HWND;
var
i: Word;
hChild: HWND;
begin
hChild := 0;
Result := 0;
Dec(ChildNr);
for i := 0
to ChildNr
do
begin
hChild := FindWindowEx(hParent, hChild, PChar(ChildClassName),
nil);
if hChild = 0
then
Break;
Result := hChild;
end;
end;
function FindWindowByTitle(WindowTitle:
string): Hwnd;
begin
NextHandle := GetWindow(Application.Handle, GW_HWNDFIRST);
while NextHandle > 0
do
begin
// retrieve its text
GetWindowText(NextHandle, NextTitle, 255);
if Pos(WindowTitle, StrPas(NextTitle)) <> 0
then
begin
Result := NextHandle;
Form1.Edit2.Text:= NextTitle;
Exit;
end
else
// Get the next window
NextHandle := GetWindow(NextHandle, GW_HWNDNEXT);
end;
Result := 0;
end;
//----------------------------------------------------------------Fenster finden
//---------------------------Alt+f+s=Datei speichern an aktuelles Fenster senden
procedure SaveMe;
begin
FindWindowByTitle('
- Message');
wndMain := FindWindow('
rctrl_renwnd32',NextTitle );
wndChild := FindWindowEx(wndMain, 0, '
AfxWndW',
nil);
SetForeGroundWindow(wndChild);
PressKey(vk_menu);
PressKey('
f');
PressKey('
s');
end;
//---------------------------Alt+f+s=Datei speichern an aktuelles Fenster senden
//------------------------------------------Fenster finden + Daten reinschreiben
procedure TForm1.Button2Click(Sender: TObject);
var
s:
string;
i,wert: integer;
begin
FindWindowByTitle('
- Message');
Actuell_Time:= FormatDateTime('
hh:nn', now);
wndMain := FindWindow('
rctrl_renwnd32',NextTitle );
if wndMain <> 0
then
begin
wndChild := FindWindowEx(wndMain, 0, '
AfxWndW',
nil);
wndChild := FindWindowEx(wndChild, 0, '
#32770',
nil);
wndChild := FindWindowEx2(wndChild,'
RichEdit20WPT', 5);
end else
begin
ShowMessage('
No Mail is opened!');
exit;
end;
if wndChild <> 0
then
begin
Clipboard.Clear;
SendMessage(wndChild,WM_COPY,0,0);
Edit1.PasteFromClipboard;
S:= My_User_Name+ '
' + Actuell_Time + '
| ';
for i := 1
to length(s)
do
begin
wert := ord(S[i]);
sendmessage(wndChild, WM_Char,(wert),1);
end;
SaveMe;
end else
begin
ShowMessage('
No Mail is opened!');
end;
end;
//------------------------------------------Fenster finden + Daten reinschreiben
procedure TForm1.FormCreate(Sender: TObject);
begin
My_User_Name:= GetUsername;
end;