Uygulamalara tuş göndermek

[karflake]

Delphi ile yazılan programlardan başka bir programı aktifleştirerek tuş yollamak amacıyla aşağıdaki unit kullanılabilir.

Kod: Tümünü seç

(*
32-bit Delphi için SendKeys rutini.

Ken Henderson tarafından yazılmıştır.

Copyright (c) 1995 Ken Henderson

Bu unit Visual Basic'in çok popüler iki rutinini taklit eder:
Sendkeys ve AppActicate. Sendkeys ilk olarak PChar bir parametre
alır ve ikinci olarak mantıksal bir parametre alır, aşağıdaki gibi:

SendKeys('BirYazi', Wait);

Yukarıdaki BirYazi tuş adlarından ve değiştiricilerden oluşmuş bir
string'tir. Bununla geçerli odağa tuş yollanabilir ve Wait değişkeni
veya değeri SendKeys fonksiyonunun her tuş mesajının işlenmesinin 
beklenmesini sağlar. Daha fazla bilgi için aşağıdaki tabloya bakın.


AppActivate sadece PChar tipinde bir parametre alır, ki:


AppActivate('PencereAdi');

Yukarıdaki PencereAdi odaklanılacak pencere adıdır.

SendKeys Visual Basic'teki yazımı aşağıda da belirtildiği gibi destekler.

Desteklene değiştiriciler:

+ = Shift
^ = Control
% = Alt

Karakterler ve tuş adları parantezler kullanılarak gruplanabilir. 
Örneğin '+abc' sadece 'a' harfine shift işlemi uygular, '+(abc)' ise 
üç karaktere de shift işlemini uygular.


Desteklenen özel karakterler

~ = Enter
( = Değiştirici gruplama başlangıcı (üste bakın)
) = Değiştirici gruplama sonu (üste bakın)
{ = Tuş adı başlangıcı (alta bakın)
} = Tuş adı sonu (alta bakın)

Desteklenen karakterler:

Yazılabilen tüm karakterler desteklenmektedir. Yukarıda listelenen
değiştirici tuşlar ve süslü parantezlerle belirtilmemiş yazılar
normal yazı olarak gönderilir.

Desteklenen tuş adları (Bunları süslü parantez içine alın):

BKSP, BS, BACKSPACE
BREAK
CAPSLOCK
CLEAR
DEL
DELETE
DOWN
END
ENTER
ESC
ESCAPE
F1
F2
F3
F4
F5
F6
F7
F8
F9
F10
F11
F12
F13
F14
F15
F16
HELP
HOME
INS
LEFT
NUMLOCK
PGDN
PGUP
PRTSC
RIGHT
SCROLLLOCK
TAB
UP

Bir tuşu takip eden bir boşluk ve numara, gönderilecek tuşun verilen
numara kez gönderileceğini belirtir. (e.g., {left 6}).
*)

unit sndkey32tr;

interface

Uses SysUtils, Windows, Messages;

Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
function AppActivate(WindowName : PChar) : boolean;

{Buffer for working with PChar's}

const
  WorkBufLen = 40;
var
  WorkBuf : array[0..WorkBufLen] of Char;

implementation
type
  THKeys = array[0..pred(MaxLongInt)] of byte;
var
  AllocationSize : integer;

(*
Converts a string of characters and key names to keyboard events and
passes them to Windows.

Example syntax:

SendKeys('abc123{left}{left}{left}def{end}456{left 6}ghi{end}789', True);

*)

Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
type
  WBytes = array[0..pred(SizeOf(Word))] of Byte;

  TSendKey = record
    Name : ShortString;
    VKey : Byte;
  end;

const
  {Array of keys that SendKeys recognizes.

  If you add to this list, you must be sure to keep it sorted alphabetically
  by Name because a binary search routine is used to scan it.}

  MaxSendKeyRecs = 41;
  SendKeyRecs : array[1..MaxSendKeyRecs] of TSendKey =
  (
   (Name:'BACKSPACE';       VKey:VK_BACK),
   (Name:'BKSP';            VKey:VK_BACK),
   (Name:'BREAK';           VKey:VK_CANCEL),
   (Name:'BS';              VKey:VK_BACK),
   (Name:'CAPSLOCK';        VKey:VK_CAPITAL),
   (Name:'CLEAR';           VKey:VK_CLEAR),
   (Name:'DEL';             VKey:VK_DELETE),
   (Name:'DELETE';          VKey:VK_DELETE),
   (Name:'DOWN';            VKey:VK_DOWN),
   (Name:'END';             VKey:VK_END),
   (Name:'ENTER';           VKey:VK_RETURN),
   (Name:'ESC';             VKey:VK_ESCAPE),
   (Name:'ESCAPE';          VKey:VK_ESCAPE),
   (Name:'F1';              VKey:VK_F1),
   (Name:'F10';             VKey:VK_F10),
   (Name:'F11';             VKey:VK_F11),
   (Name:'F12';             VKey:VK_F12),
   (Name:'F13';             VKey:VK_F13),
   (Name:'F14';             VKey:VK_F14),
   (Name:'F15';             VKey:VK_F15),
   (Name:'F16';             VKey:VK_F16),
   (Name:'F2';              VKey:VK_F2),
   (Name:'F3';              VKey:VK_F3),
   (Name:'F4';              VKey:VK_F4),
   (Name:'F5';              VKey:VK_F5),
   (Name:'F6';              VKey:VK_F6),
   (Name:'F7';              VKey:VK_F7),
   (Name:'F8';              VKey:VK_F8),
   (Name:'F9';              VKey:VK_F9),
   (Name:'HELP';            VKey:VK_HELP),
   (Name:'HOME';            VKey:VK_HOME),
   (Name:'INS';             VKey:VK_INSERT),
   (Name:'LEFT';            VKey:VK_LEFT),
   (Name:'NUMLOCK';         VKey:VK_NUMLOCK),
   (Name:'PGDN';            VKey:VK_NEXT),
   (Name:'PGUP';            VKey:VK_PRIOR),
   (Name:'PRTSC';           VKey:VK_PRINT),
   (Name:'RIGHT';           VKey:VK_RIGHT),
   (Name:'SCROLLLOCK';      VKey:VK_SCROLL),
   (Name:'TAB';             VKey:VK_TAB),
   (Name:'UP';              VKey:VK_UP)
  );

  {Extra VK constants missing from Delphi's Windows API interface}
  VK_NULL=0;
  VK_SemiColon=186;
  VK_Equal=187;
  VK_Comma=188;
  VK_Minus=189;
  VK_Period=190;
  VK_Slash=191;
  VK_BackQuote=192;
  VK_LeftBracket=219;
  VK_BackSlash=220;
  VK_RightBracket=221;
  VK_Quote=222;
  VK_Last=VK_Quote;

  ExtendedVKeys : set of byte =
  [VK_Up,
   VK_Down,
   VK_Left,
   VK_Right,
   VK_Home,
   VK_End,
   VK_Prior,  {PgUp}
   VK_Next,   {PgDn}
   VK_Insert,
   VK_Delete];

const
  INVALIDKEY = $FFFF {Unsigned -1};
  VKKEYSCANSHIFTON = $01;
  VKKEYSCANCTRLON = $02;
  VKKEYSCANALTON = $04;
  UNITNAME = 'SendKeys';
var
  UsingParens, ShiftDown, ControlDown, AltDown, FoundClose : Boolean;
  PosSpace : Byte;
  I, L : Integer;
  NumTimes, MKey : Word;
  KeyString : String[20];

procedure DisplayMessage(Message : PChar);
begin
  MessageBox(0,Message,UNITNAME,0);
end;

function BitSet(BitTable, BitMask : Byte) : Boolean;
begin
  Result:=ByteBool(BitTable and BitMask);
end;

procedure SetBit(var BitTable : Byte; BitMask : Byte);
begin
  BitTable:=BitTable or Bitmask;
end;

Procedure KeyboardEvent(VKey, ScanCode : Byte; Flags : Longint);
var
  KeyboardMsg : TMsg;
begin
  keybd_event(VKey, ScanCode, Flags,0);
  If (Wait) then While (PeekMessage(KeyboardMsg,0,WM_KEYFIRST, WM_KEYLAST, PM_REMOVE)) do begin
    TranslateMessage(KeyboardMsg);
    DispatchMessage(KeyboardMsg);
  end;
end;

Procedure SendKeyDown(VKey: Byte; NumTimes : Word; GenUpMsg : Boolean);
var
  Cnt : Word;
  ScanCode : Byte;
  NumState : Boolean;
  KeyBoardState : TKeyboardState;
begin
  If (VKey=VK_NUMLOCK) then begin
    NumState:=ByteBool(GetKeyState(VK_NUMLOCK) and 1);
    GetKeyBoardState(KeyBoardState);
    If NumState then KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] and not 1)
    else KeyBoardState[VK_NUMLOCK]:=(KeyBoardState[VK_NUMLOCK] or 1);
    SetKeyBoardState(KeyBoardState);
    exit;
  end;

  ScanCode:=Lo(MapVirtualKey(VKey,0));
  For Cnt:=1 to NumTimes do
    If (VKey in ExtendedVKeys)then begin
      KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY);
      If (GenUpMsg) then
        KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP)
    end else begin
      KeyboardEvent(VKey, ScanCode, 0);
      If (GenUpMsg) then KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
    end;
end;

Procedure SendKeyUp(VKey: Byte);
var
  ScanCode : Byte;
begin
  ScanCode:=Lo(MapVirtualKey(VKey,0));
  If (VKey in ExtendedVKeys)then
    KeyboardEvent(VKey, ScanCode, KEYEVENTF_EXTENDEDKEY and KEYEVENTF_KEYUP)
  else KeyboardEvent(VKey, ScanCode, KEYEVENTF_KEYUP);
end;

Procedure SendKey(MKey: Word; NumTimes : Word; GenDownMsg : Boolean);
begin
  If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyDown(VK_SHIFT,1,False);
  If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyDown(VK_CONTROL,1,False);
  If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyDown(VK_MENU,1,False);
  SendKeyDown(Lo(MKey), NumTimes, GenDownMsg);
  If (BitSet(Hi(MKey),VKKEYSCANSHIFTON)) then SendKeyUp(VK_SHIFT);
  If (BitSet(Hi(MKey),VKKEYSCANCTRLON)) then SendKeyUp(VK_CONTROL);
  If (BitSet(Hi(MKey),VKKEYSCANALTON)) then SendKeyUp(VK_MENU);
end;

{Implements a simple binary search to locate special key name strings}

Function StringToVKey(KeyString : ShortString) : Word;
var
  Found, Collided : Boolean;
  Bottom, Top, Middle : Byte;
begin
  Result:=INVALIDKEY;
  Bottom:=1;
  Top:=MaxSendKeyRecs;
  Found:=false;
  Middle:=(Bottom+Top) div 2;
  Repeat
    Collided:=((Bottom=Middle) or (Top=Middle));
    If (KeyString=SendKeyRecs[Middle].Name) then begin
       Found:=True;
       Result:=SendKeyRecs[Middle].VKey;
    end else begin
       If (KeyString>SendKeyRecs[Middle].Name) then Bottom:=Middle
       else Top:=Middle;
       Middle:=(Succ(Bottom+Top)) div 2;
    end;
  Until (Found or Collided);
  If (Result=INVALIDKEY) then DisplayMessage('Invalid Key Name');
end;

procedure PopUpShiftKeys;
begin
  If (not UsingParens) then begin
    If ShiftDown then SendKeyUp(VK_SHIFT);
    If ControlDown then SendKeyUp(VK_CONTROL);
    If AltDown then SendKeyUp(VK_MENU);
    ShiftDown:=false;
    ControlDown:=false;
    AltDown:=false;
  end;
end;

begin
  AllocationSize:=MaxInt;
  Result:=false;
  UsingParens:=false;
  ShiftDown:=false;
  ControlDown:=false;
  AltDown:=false;
  I:=0;
  L:=StrLen(SendKeysString);
  If (L>AllocationSize) then L:=AllocationSize;
  If (L=0) then Exit;

  While (I<L) do begin
    case SendKeysString[I] of
    '(' : begin
            UsingParens:=True;
            Inc(I);
          end;
    ')' : begin
            UsingParens:=False;
            PopUpShiftKeys;
            Inc(I);
          end;
    '%' : begin
             AltDown:=True;
             SendKeyDown(VK_MENU,1,False);
             Inc(I);
          end;
    '+' :  begin
             ShiftDown:=True;
             SendKeyDown(VK_SHIFT,1,False);
             Inc(I);
           end;
    '^' :  begin
             ControlDown:=True;
             SendKeyDown(VK_CONTROL,1,False);
             Inc(I);
           end;
    '{' : begin
            NumTimes:=1;
            If (SendKeysString[Succ(I)]='{') then begin
              MKey:=VK_LEFTBRACKET;
              SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
              SendKey(MKey,1,True);
              PopUpShiftKeys;
              Inc(I,3);
              Continue;
            end;
            KeyString:='';
            FoundClose:=False;
            While (I<=L) do begin
              Inc(I);
              If (SendKeysString[I]='}') then begin
                FoundClose:=True;
                Inc(I);
                Break;
              end;
              KeyString:=KeyString+Upcase(SendKeysString[I]);
            end;
            If (Not FoundClose) then begin
               DisplayMessage('No Close');
               Exit;
            end;
            If (SendKeysString[I]='}') then begin
              MKey:=VK_RIGHTBRACKET;
              SetBit(Wbytes(MKey)[1],VKKEYSCANSHIFTON);
              SendKey(MKey,1,True);
              PopUpShiftKeys;
              Inc(I);
              Continue;
            end;
            PosSpace:=Pos(' ',KeyString);
            If (PosSpace<>0) then begin
               NumTimes:=StrToInt(Copy(KeyString,Succ(PosSpace),Length(KeyString)-PosSpace));
               KeyString:=Copy(KeyString,1,Pred(PosSpace));
            end;
            If (Length(KeyString)=1) then MKey:=vkKeyScan(KeyString[1])
            else MKey:=StringToVKey(KeyString);
            If (MKey<>INVALIDKEY) then begin
              SendKey(MKey,NumTimes,True);
              PopUpShiftKeys;
              Continue;
            end;
          end;
    '~' : begin
            SendKeyDown(VK_RETURN,1,True);
            PopUpShiftKeys;
            Inc(I);
          end;
    else  begin
             MKey:=vkKeyScan(SendKeysString[I]);
             If (MKey<>INVALIDKEY) then begin
               SendKey(MKey,1,True);
               PopUpShiftKeys;
             end else DisplayMessage('Invalid KeyName');
             Inc(I);
          end;
    end;
  end;
  Result:=true;
  PopUpShiftKeys;
end;

{AppActivate

This is used to set the current input focus to a given window using its
name.  This is especially useful for ensuring a window is active before
sending it input messages using the SendKeys function.  You can specify
a window's name in its entirety, or only portion of it, beginning from
the left.

}


var
  WindowHandle : HWND;

function EnumWindowsProc(WHandle: HWND; lParam: LPARAM): BOOL; export; stdcall;
var
  WindowName : array[0..MAX_PATH] of char;
begin
  {Can't test GetWindowText's return value since some windows don't have a title}
  GetWindowText(WHandle,WindowName,MAX_PATH);
  Result := (StrLIComp(WindowName,PChar(lParam), StrLen(PChar(lParam))) <> 0);
  If (not Result) then WindowHandle:=WHandle;
end;

function AppActivate(WindowName : PChar) : boolean;
begin
  try
    Result:=true;
    WindowHandle:=FindWindow(nil,WindowName);
    If (WindowHandle=0) then EnumWindows(@EnumWindowsProc,Integer(PChar(WindowName)));
    If (WindowHandle<>0) then begin
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_HOTKEY, WindowHandle);
      SendMessage(WindowHandle, WM_SYSCOMMAND, SC_RESTORE, WindowHandle);
      SetForegroundWindow(WindowHandle);
    end else Result:=false;
  except
    on Exception do Result:=false;
  end;
end;

end.

Aşağıda yukarıdaki unit kullanılarak hazırlanmış bir örnek program yer almaktadır. Programı çalıştırmak için bir forma içinde text'inde yazılar olan bir edit box ve bir button yerleştirin. Daha sonra button'un click olayına aşağıdaki kodu yazın.

Kod: Tümünü seç

/uses kısmına sndkey32tr unit'ini eklemeyi unutmayın...
procedure TForm1.Button1Click(Sender: TObject);
var
  i:integer;
  tut, harf: string;
begin
  WinExec('Notepad.exe', SW_SHOWNORMAL) ;
  AppActivate('Not Defteri');
  tut:=edit1.Text;
  for i:=1 to length(tut) do
  begin
    sleep(50);
    harf:=tut[i];
    SendKeys(PChar(harf),true);
  end;
end;

Not: Açıklamaları ben yetersiz İngilizce'mle Türkçe'ye çevirdiğim için bazı hatalar olabilir. Sürç-i lisan ettiysek affola...

[husonet]

Elinize sağlık güzel olmuş.

[digital_agels]

ya şu var burda programı kendi açıyor ben açık olan notepad yada mirc gibi char yazılımlarınd veya oyunlarda nasıl yaptırcam o yeni açıyor aktif olan program adını versek olmazmı kendisi yeni açmasadda

[sadettinpolat]

AppActivate('Not Defteri'); satırında istediğiniz pencereyi aktif yapabilirsiniz.

[karflake]

@husonet ve @sadettinpolat;

Yorumlarınız ve katkılarınız için teşekkürler.

[DeathBlow]

merhaba Edit1.texte selam{tab}naber yazıyorum olmuyor nasıl kullancaz bu enter tab vb. komutları ?

[karflake]

Forma iki edit ve bir button koyduktan sonra aşağıdaki kodu kullanabilirsiniz.

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text:='Selam{TAB}herkese';
  Edit2.Text:='Merhaba Dünya';
  WinExec('Notepad.exe', SW_SHOWNORMAL) ;
  AppActivate('Not Defteri');
  SendKeys(PChar(edit1.Text),true);
  SendKeys(PChar('{ENTER}'),true);
  SendKeys(PChar(Edit2.Text),true);
end;

[karflake]

Burada da(15. mesaj) yukarıdaki unit ile yaptığım bir sanal klavye benzeri bir program var.

[fox]

paylaşım için teşekkürler benim bir sorum var ben ilk olarak mesela shellapi ile sw_hide ile notepad i açıyorum ama send key diyinice gizli olan notepad karşıma geliyor arka planda iken yani gözükmezken tuş gönderme işini nasıl yapabilirim

[ron]

peki windows tuşunu nasıl göndericez. windows + L tuşunu gönderip çalışan programları kapatmadan kullanıcı değiştirme ekranına gelmek istiyorumda. bunun için api aradım fakat bulamadım.

[karflake]

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  keybd_event(VK_LWIN, 0, 0, 0);
  keybd_event(Ord('L'), 0, 0, 0);
  keybd_event(VK_LWIN, 0, KEYEVENTF_KEYUP, 0);
end;

Kaynak

[Gokcons]

Selam üstatlarım öncelikle hepinize teşekkür ediyorum 1 gün içerisinde bayağı bir yol kat etmiş durumdayım ben delphi ile 1 günlüğüm yeni doğmuş gibi herneyse...


soruma gelmek istiyorum bu uygulamada kodları inceledim değiştirdim birleştirdim ama bazı yerlerde sorumlar ile karşılaştım

Kod: Tümünü seç

procedure TForm1.Button1Click(Sender: TObject);
begin
  Edit1.Text:='Selam{TAB}herkese';
  Edit2.Text:='Merhaba Dünya';
  WinExec('Notepad.exe', SW_SHOWNORMAL) ;
  AppActivate('Not Defteri');
  SendKeys(PChar(edit1.Text),true);
  SendKeys(PChar('{ENTER}'),true);
  SendKeys(PChar(Edit2.Text),true);
end;

buradaki kodları ben kendimce çoğalttım yani edit1 den edit10 a kadar bu kodda çok seri yazıyodu en üstteki kodda bulunan sleep kodunu kullanmak istedim eksikleri ekledim veya teker teker ekledim yavaşlatamadım aksine bu 10 editlik yazıyı bana 10-20 kere tekrarlamış gibi oldu üstteki verdiğim kodda nasıl bir yavaşlatma işlemi yapabilirim ve bunu programa dönüştürdüğüm de flood programları gibi olması için mesela 5 kez tekrarla 10 kez tekrarla sınırsız tekrarlanış olarak 3 komut butonu nasıl koyabilirim yine farz edelim ki sınırsız da iken başlat butonunun yanında durdur butonu nasıl yapabilirim iyi güzel hoş çalışıyor ama sınırsız çalışması ve yeri geldiğinde pause işlemi nasıl yapabilirim

şimdiden teşekkür ediyorum

not: saldırı veya başka bir işlemde kullanmıycam sevdiğim kişiye bir jest yapmayı düşünüyorum editler de bir şiir editlerin üstünüde memo ile kapatarak kandırıcam başlat diyince not defterine şiir yazsın istiyorum bu konuyu bu forumu bulmama vesile olan karflake arkadaşıma çok teşekkür ediyorum başka bir sitede buranın linkini vererek beni buraya yönlendirdiği için


Dip not : flood olmasın diye msjımı editliyorum

Kod: Tümünü seç

WinExec('Notepad.exe', SW_SHOWNORMAL) ;

buradaki Notepat.exe yi sildiğimizde aktif pencerede işlem yaptığını gördüm msn olabilir not defteri veya chat ortamı sağlayan oyun site vs her şekilde kullanabilirliğini gördüm söylemeye çalıştığım kod şu şekli aldı

Kod: Tümünü seç

WinExec('', SW_SHOWNORMAL) ;

[Nick_]

S.a arkadaslar sndkey32tr.pas dosyasını kullanarak 1 defa calısacak bı uygulama yaptım. programım tray da calısıyor. appactive fonksiyonu tam ıstedıgım ıslemı yapıyor. yanı uygulama tray da da olsa kullanıcı programı tekrar acmak ıstedıgınde traydakı uygulayı acıyor. Ama formumdakı bazı butonları calıstırtmıyor. sebebı nedır?

[akin.tugcu]

Tşk çok güzel olmuş.