Windows'a mouse'a basıldı yada klavyeye basıldı mesajını nasıl gönderirim?
SetCursorPos(X,Y:Integer) ile mouse istenilen koordinata yönlendirilebiliyor. Peki nasıl click yaptılır?
Bir ceşit makro programı yazmak istiyorum. Başka programları çalıştırıp menülerini tıklayıp calıştırmak istiyorum.
Ayni şeyi Form (yazdığım programin formu) üzerinde denedim ama beceremedim.
Form1.MouseDown((mbLeft,[ssLeft],90,290);
Belirtilen koordinata bir TMemo yerleştirdim. Yukarıdaki komutu yazdim.
ama cursor TMemo üzerine focus olmadı.
İlgilenen olursa sevinirim.
Mouse ve klavye kontrolü.
Forum kuralları
Forum kurallarını okuyup, uyunuz!
Forum kurallarını okuyup, uyunuz!
istediğin şekilde bir macro programı mevcut. autorunner diye bir program.
sitenin birinden indirmiştim.
Bu kodu unit1.pas olarak kaydet. Yeni uygulama açıp forma bi tane buton koyarsan. program çalışmaya başlayacaktır.
Aşağıda yardım dosyasını da gönderiyorum.
Yardım dosyası, aşağıdaki açıklamaları komut.txt dosyasında kullanırsınız.
Özel tuş tanımları
~ enter
^ ctrl ile
+ shift ile
% alt ile
+abc yapılırsa sadece A büyük yazılır
+(abc) yapılırsa ABC hepsi büyük yazılır
rakamlar ve yazılar için direkt yazın
* işareti il çalışacak program belirtilir ---> C:\windows\sol.exe
/ işareti il komut gönderilecek pencere adı ---> Solitaire
+ işareti ile komutlar arası bekleme süresi sn olarak ---> 1
= Gönderilecek komutlar yazılır
Örnek olarak;
*Çalışacak program Soliter
/Programın penceresindeki isim
+her bir komut için bekleme süresi
=%O Oyun menüsü açılır
=s Seçenekler bölümüne girilir
={TAB} Tab ile diğer seçeneğe geçilir
={DOWN} ile alttaki seçenek seçilir
={ENTER} Kabul edilir.
------------------------------
*C:\windows\sol.exe
/Solitaire
+1
=%O
=s
={TAB}
={down}
={enter}
------------------------------
{BEKLE N}
{BKSP}
{BS}
{BACKSPACE}
{BREAK}
{CAPSLOCK}
{CLEAR}
{DEL}
{DELETE}
{DOWN}
{END}
{ENTER}
{ESC}
{ESCAPE}
{F1}
{F10}
{F11}
{F12}
{F13}
{F14}
{F15}
{F16}
{F2}
{F3}
{F4}
{F5}
{F6}
{F7}
{F8}
{F9}
{HELP}
{HOME}
{INS}
{LEFT}
{NUMLOCK}
{PGDN}
{PGUP}
{PRTSC}
{RIGHT}
{SCROLLLOCK}
{TAB}
{UP}
Bu program ile MS-Dos programlarına da hükmedebilirsiniz.
*C:\windows\system32\command.com
/Command.com
+1
=DENEME
={TAB}
={TAB}
=BU BİR DENEMEDİR
={ENTER}
=EXIT
={ENTER}
takıldığınız kontalar olursa yazarsınız. elimden geleni yaparım.
iyi çalışmalar.
sitenin birinden indirmiştim.
Bu kodu unit1.pas olarak kaydet. Yeni uygulama açıp forma bi tane buton koyarsan. program çalışmaya başlayacaktır.
Aşağıda yardım dosyasını da gönderiyorum.
Kod: Tümünü seç
unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls;
type
TForm1 = class(TForm)
Memo1: TMemo;
Button1: TButton;
procedure FormShow(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
Function SendKeys(SendKeysString : PChar; Wait : Boolean) : Boolean;
function AppActivate(WindowName : PChar) : boolean;
var
AllocationSize : integer;
Form1: TForm1;
ftext:text;
kmtm,kmt,kod,bekle,i,j:integer;
prg,baslik,sure,komut,gec,s:string;
implementation
{$R *.dfm}
// 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:'BKSP'; VKey:VK_BACK),
(Name:'BS'; VKey:VK_BACK),
(Name:'BACKSPACE'; VKey:VK_BACK),
(Name:'BREAK'; VKey:VK_CANCEL),
(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('Hatalı tuş girildi');
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('Kapalı değil');
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('Hatalı tuş adı');
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;
const
MAX_WINDOW_NAME_LEN = 80;
var
WindowName : array[0..MAX_WINDOW_NAME_LEN] of char;
begin
{Can't test GetWindowText's return value since some windows don't have a title}
GetWindowText(WHandle,WindowName,MAX_WINDOW_NAME_LEN);
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);
end else Result:=false;
except
on Exception do Result:=false;
end;
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Assignfile(ftext,'komut.txt');
reset(ftext);
while not Eof(Ftext) do begin
readln(ftext,s);
if s[1]='*' then begin
prg:=copy(s,2,length(s));
winexec(pchar(prg),SW_SHOW);
end;
if s[1]='/' then begin
baslik:=copy(s,2,length(s));
AppActivate(pchar(baslik));
end;
if s[1]='+' then begin
sure:=copy(s,2,length(s));
val(sure,bekle,kod);
bekle:=bekle*1000;
end;
if s[1]='=' then begin
komut:=copy(s,2,length(s));
end;
SetForegroundWindow(windowHandle);
SendKeys(pchar(komut), True);
sleep(bekle);
end;
closefile(ftext);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
//PostMessage(FindWindow(Nil, pchar(baslik)), WM_QUIT, 0, 0);
form1.Close;
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
end;
end.
Özel tuş tanımları
~ enter
^ ctrl ile
+ shift ile
% alt ile
+abc yapılırsa sadece A büyük yazılır
+(abc) yapılırsa ABC hepsi büyük yazılır
rakamlar ve yazılar için direkt yazın
* işareti il çalışacak program belirtilir ---> C:\windows\sol.exe
/ işareti il komut gönderilecek pencere adı ---> Solitaire
+ işareti ile komutlar arası bekleme süresi sn olarak ---> 1
= Gönderilecek komutlar yazılır
Örnek olarak;
*Çalışacak program Soliter
/Programın penceresindeki isim
+her bir komut için bekleme süresi
=%O Oyun menüsü açılır
=s Seçenekler bölümüne girilir
={TAB} Tab ile diğer seçeneğe geçilir
={DOWN} ile alttaki seçenek seçilir
={ENTER} Kabul edilir.
------------------------------
*C:\windows\sol.exe
/Solitaire
+1
=%O
=s
={TAB}
={down}
={enter}
------------------------------
{BEKLE N}
{BKSP}
{BS}
{BACKSPACE}
{BREAK}
{CAPSLOCK}
{CLEAR}
{DEL}
{DELETE}
{DOWN}
{END}
{ENTER}
{ESC}
{ESCAPE}
{F1}
{F10}
{F11}
{F12}
{F13}
{F14}
{F15}
{F16}
{F2}
{F3}
{F4}
{F5}
{F6}
{F7}
{F8}
{F9}
{HELP}
{HOME}
{INS}
{LEFT}
{NUMLOCK}
{PGDN}
{PGUP}
{PRTSC}
{RIGHT}
{SCROLLLOCK}
{TAB}
{UP}
Bu program ile MS-Dos programlarına da hükmedebilirsiniz.
*C:\windows\system32\command.com
/Command.com
+1
=DENEME
={TAB}
={TAB}
=BU BİR DENEMEDİR
={ENTER}
=EXIT
={ENTER}
takıldığınız kontalar olursa yazarsınız. elimden geleni yaparım.
iyi çalışmalar.
Öğrenmek ve öğretmek, akıntıya karşı yüzmek gibidir ilerleyemediğiniz taktirde gerilersiniz.
kardeş biraz uğraştım ve programı çalıştırabildim... sonrada deneme yapayım dedim... Ben XP kullanıyorum ve senin verdiğin solitaire örneğindeki dosya yolları farklı olduğu için onları değiştirerek denedim... programı açıyor ama program üzerinde herhangi bir işlem yapmıyor....
Teşekkürler... Kolay gelsin...
Teşekkürler... Kolay gelsin...
www.DelphiTurkiye.com u Çok Seviyorum 
