TD Komut Robotu Kaynak Kodları (VB6)

Tahribat.com Forumları
line

Visual Basic - Basic - PicBasic ve Türevleri
line

TD Komut Robotu Kaynak Kodları (VB6)

16/Ağu/12 04:24

Kısayol

Şikayet

Özel Mesaj

DE5TROY3R

Kayıt Tarihi: 04/Nisan/2007

Tuş Gönderme, bekleme, pencere aktif etmek, fare tıkları, Windows komut istemcisi komutları
Birinci satırdaki, // açıklama kısmı
İkinci satır, komut uyumsuzlukları için
Üçüncü satır, TekrarSayısı(1) komutların kaç kez tekrarlancağını yazıyorsunuz
İlk 3 sabittir
() arası atanan değerlerdir

Form:

Private Type POINTAPI
    X As Long
    Y As Long
End Type
Private Declare Function GetCursorPos Lib "user32" _
   (lpPoint As POINTAPI) As Long
Dim Pt As POINTAPI
Private Declare Function SetCursorPos Lib "user32" (ByVal X As Long, _
    ByVal Y As Long) As Long
Private Declare Function ClientToScreen Lib "user32" (ByVal hWnd As Long, _
    lpPoint As POINTAPI) As Long
    Private Declare Function GetAsyncKeyState Lib "user32" _
  (ByVal vKey As Long) As Integer
Private Declare Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer

Dim saniyemiz, baslatatiklandi
  
Sub MoveMouseCursor(ByVal X As Long, ByVal Y As Long, _
Optional ByVal hWnd As Long)
If hWnd = 0 Then
SetCursorPos X, Y
Else
Dim lpPoint As POINTAPI
lpPoint.X = X
lpPoint.Y = Y
ClientToScreen hWnd, lpPoint
SetCursorPos lpPoint.X, lpPoint.Y
End If
End Sub

Private Sub Command1_Click()
Frame2.Caption = "Komutlar: '" & Right(kodlarlistbox.List(0), Len(kodlarlistbox.List(0)) - 2) & "' durduruldu"
tekrarsayisi = 0
yapilantekrarsayisi = 0
islenenkomut = 3
KodTimer.Enabled = False
tumbutonlariac
Command1.Enabled = False
End Sub

Private Sub Command10_Click()
Open App.Path & "\" & Hour(Now) & Minute(Now) & Second(Now) & Day(Now) & Month(Now) & Year(Now) & "_TDKomut.txt" For Append As #1
Print #1, kodlar.Text
Close #1
MsgBox "TD Komut Robotu klasörüne kaydedildi" & Chr(13) & App.Path & "\", vbInformation, Hour(Now) & Minute(Now) & Second(Now) & Day(Now) & Month(Now) & Year(Now) & "_TDKomut.txt"
End Sub

Private Sub Command11_Click()
komutdeger = InputBox("Komutunuzu yazın ?")
If komutdeger <> "" Then
kodlar.Text = kodlar.Text + "KomutGönder(" & komutdeger & ")" & vbCrLf
End If
End Sub

Private Sub Command2_Click()
tusgonderdeger = InputBox("Ne göndereceksin ?")
If tusgonderdeger <> "" Then
kodlar.Text = kodlar.Text + "TuşGönder(" & tusgonderdeger & ")" & vbCrLf
End If
End Sub

Sub KodKontrol()
If kodlarlistbox.List(1) = "<TDRobot v1.0>" Then
If Left(kodlarlistbox.List(2), 13) = "TekrarSayısı(" Then
tekrarsayisi.Text = TagYakala(kodlarlistbox.List(2), "TekrarSayısı(", ")")
KodTimer.Enabled = True
Else
MsgBox "Komutların 3. sırasına TekrarSayısı(0) ekle"
End If
Else
MsgBox "Komutların 2. sırasına <TDRobot v1.0> ekle"
End If
End Sub

Private Sub Command3_Click()
bekledeger = InputBox("Ne kadar bekleyecek ? " & vbCrLf & Chr(34) & "1 saniye = 1000" & Chr(34))
If bekledeger <> "" Then
kodlar.Text = kodlar.Text + "Bekle(" & bekledeger & ")" & vbCrLf
End If
End Sub

Private Sub Command4_Click()
tik = InputBox("Sağ tık = 1" & vbCrLf & "Sol tık = 2")
If tik = 1 Then
SagTikDeger = InputBox("X, Y koordinatları ?" & vbCrLf & "Örnek: 1453,2011")
If SagTikDeger <> "" Then
kodlar.Text = kodlar.Text + "SağTık(" & SagTikDeger & ")" & vbCrLf
End If
ElseIf tik = 2 Then
SolTikDeger = InputBox("X, Y koordinatları ?" & vbCrLf & "Örnek: 1453,2011")
kodlar.Text = kodlar.Text + "SolTık(" & SolTikDeger & ")" & vbCrLf
End If
End Sub

Private Sub Command5_Click()
KodlariListboxaAyarla
tumbutonlarikapat
Command1.Enabled = True
End Sub

Sub KodlariListboxaAyarla()
Dim i As Integer
Dim Text_Items() As String
kodlarlistbox.Clear
Text_Items = Split(kodlar.Text, vbCrLf)
For i = 0 To UBound(Text_Items)
If Text_Items(i) <> "" Then
kodlarlistbox.AddItem Text_Items(i)
End If
Next
KodKontrol
End Sub

Function TagYakala(veri As String, tagb As String, tags As String)
On Error Resume Next
On Local Error Resume Next
arrs = Split(veri, tagb)
arrB = Split(arrs(1), tags)
TagYakala = arrB(0)
End Function

Private Sub Command6_Click()
MsgBox "TD Software © 2011" & Chr(13) & "www.tdsoftware.tr.cx" & Chr(13) & "www.tahribat.com", vbInformation
Shell "explorer http://tdsoftware.tr.cx"
Shell "explorer http://tahribat.com"
End Sub

Private Sub Command7_Click()
pencereAktifEtDeger = InputBox("Aktif yapılacak pencere başlığını girin")
If pencereAktifEtDeger <> "" Then
kodlar.Text = kodlar.Text + "PencereAktifEt(" & pencereAktifEtDeger & ")" & vbCrLf
End If
End Sub

Private Sub Command8_Click()
KomutYakalayici.Enabled = False
tumbutonlariac
Command8.Enabled = False
kodlar.Locked = False
End Sub

Sub tumbutonlariac()
Command1.Enabled = True
Command2.Enabled = True
Command3.Enabled = True
Command4.Enabled = True
Command5.Enabled = True
Command6.Enabled = True
Command7.Enabled = True
Command8.Enabled = True
Command9.Enabled = True
Command10.Enabled = True
Command11.Enabled = True
End Sub

Sub tumbutonlarikapat()
Command1.Enabled = False
Command2.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
Command5.Enabled = False
Command7.Enabled = False
Command8.Enabled = False
Command9.Enabled = False
Command11.Enabled = False
End Sub

Private Sub Command9_Click()
tumbutonlarikapat
KomutYakalayici.Enabled = True
Command8.Enabled = True
kodlar.Locked = True
End Sub

Private Sub Form_Load()

End Sub

Private Sub KodTimer_Timer()
Frame2.Caption = "Komutlar: '" & Right(kodlarlistbox.List(0), Len(kodlarlistbox.List(0)) - 2) & "' çalışıyor"

If Left(kodlarlistbox.List(islenenkomut), 10) = "TuşGönder(" Then
tusgonderdegeri = TagYakala(kodlarlistbox.List(islenenkomut), "TuşGönder(", ")")
If tusgonderdegeri = "{ENTER}" Then
SendKeys "{ENTER}"
ElseIf tusgonderdegeri = "{ESC}" Then
SendKeys "{ESC}"
ElseIf tusgonderdegeri = "{BACKSPACE}" Then
SendKeys "{BACKSPACE}"
ElseIf tusgonderdegeri = "{SPACE}" Then
SendKeys "{SPACE}"
ElseIf tusgonderdegeri = "{TAB}" Then
SendKeys "{TAB}"
ElseIf tusgonderdegeri = "{DEL}" Then
SendKeys "{DEL}"
ElseIf tusgonderdegeri = "{F1}" Then
SendKeys "{F1}"
ElseIf tusgonderdegeri = "{F2}" Then
SendKeys "{F2}"
ElseIf tusgonderdegeri = "{F3}" Then
SendKeys "{F3}"
ElseIf tusgonderdegeri = "{F4}" Then
SendKeys "{F4}"
ElseIf tusgonderdegeri = "{F5}" Then
SendKeys "{F5}"
ElseIf tusgonderdegeri = "{F6}" Then
SendKeys "{F6}"
ElseIf tusgonderdegeri = "{F7}" Then
SendKeys "{F7}"
ElseIf tusgonderdegeri = "{F8}" Then
SendKeys "{F8}"
ElseIf tusgonderdegeri = "{F9}" Then
SendKeys "{F9}"
ElseIf tusgonderdegeri = "{F10}" Then
SendKeys "{F10}"
ElseIf tusgonderdegeri = "{F11}" Then
SendKeys "{F11}"
ElseIf tusgonderdegeri = "{F12}" Then
SendKeys "{F12}"


Else
SendKeys tusgonderdegeri
End If
'MsgBox "Gönderilecek tuş: " & TusGonderDegeri
islenenkomut = islenenkomut + 1
End If

wait 50

If Left(kodlarlistbox.List(islenenkomut), 6) = "Bekle(" Then
bekledegeri = TagYakala(kodlarlistbox.List(islenenkomut), "Bekle(", ")")
wait bekledegeri
'MsgBox "Bekle " & BekleDegeri
islenenkomut = islenenkomut + 1
End If

wait 50

If Left(kodlarlistbox.List(islenenkomut), 15) = "PencereAktifEt(" Then
aktifpenceredegeri = TagYakala(kodlarlistbox.List(islenenkomut), "PencereAktifEt(", ")")
cHwnd = FindWindow(vbNullString, aktifpenceredegeri)
retval = ShowWindow(cHwnd, 1)
'MsgBox "Bekle " & BekleDegeri
islenenkomut = islenenkomut + 1
End If

wait 50

If Left(kodlarlistbox.List(islenenkomut), 7) = "SolTık(" Then
soltikx = TagYakala(kodlarlistbox.List(islenenkomut), "SolTık(", ",")
soltiky = TagYakala(kodlarlistbox.List(islenenkomut), "SolTık(" & soltikx & ",", ")")
MoveMouseCursor soltikx, soltiky
LeftClick
'MsgBox "Bekle " & BekleDegeri
islenenkomut = islenenkomut + 1
End If

wait 50

If Left(kodlarlistbox.List(islenenkomut), 7) = "SağTık(" Then
sagtikx = TagYakala(kodlarlistbox.List(islenenkomut), "SağTık(", ",")
sagtiky = TagYakala(kodlarlistbox.List(islenenkomut), "SağTık(" & sagtikx & ",", ")")
MoveMouseCursor sagtikx, sagtiky
RightClick
'MsgBox "Bekle " & BekleDegeri
islenenkomut = islenenkomut + 1
End If

wait 50

If Left(kodlarlistbox.List(islenenkomut), 12) = "KomutGönder(" Then
komutumuz = TagYakala(kodlarlistbox.List(islenenkomut), "KomutGönder(", ")")
Shell "" & komutumuz & "", vbHide
'MsgBox "Bekle " & BekleDegeri
islenenkomut = islenenkomut + 1
End If

If kodlarlistbox.ListCount = islenenkomut Then ' KOMUT SONU
yapilantekrarsayisi = yapilantekrarsayisi + 1

'MsgBox "Komut sonu"
islenenkomut = 3

If tekrarsayisi = 0 Then
tekrarsayisi = 0
yapilantekrarsayisi = 0
islenenkomut = 3
KodTimer.Enabled = False

Frame2.Caption = "Komutlar: '" & Right(kodlarlistbox.List(0), Len(kodlarlistbox.List(0)) - 2) & "' çalıştırıldı"
tumbutonlariac
Command1.Enabled = False
'MsgBox "Program komut sonu"
Else

If tekrarsayisi = yapilantekrarsayisi Then
tekrarsayisi = 0
yapilantekrarsayisi = 0
islenenkomut = 3
Frame2.Caption = "Komutlar: '" & Right(kodlarlistbox.List(0), Len(kodlarlistbox.List(0)) - 2) & "' Çalıştırıldı"
tumbutonlariac
Command1.Enabled = False
KodTimer.Enabled = False

'MsgBox "Program komut sonu"
End If

End If

End If
End Sub


Private Function altgrkont() As Boolean
If GetAsyncKeyState(17) <> 0 And GetAsyncKeyState(18) <> 0 And GetAsyncKeyState(162) <> 0 And (GetAsyncKeyState(164) <> 0 Or GetAsyncKeyState(165) <> 0) Then
altgrkont = True
Else
altgrkont = False
End If
End Function

Private Function ctrlaltdelkont() As Boolean
If GetAsyncKeyState(17) <> 0 And GetAsyncKeyState(18) <> 0 And GetAsyncKeyState(46) <> 0 And GetAsyncKeyState(162) <> 0 And GetAsyncKeyState(164) <> 0 Then
ctrlaltdelkont = True
Else
ctrlaltdelkont = False
End If
End Function
Private Function alttabkont() As Boolean
If GetAsyncKeyState(9) <> 0 And GetAsyncKeyState(18) <> 0 And GetAsyncKeyState(164) <> 0 Then
alttabkont = True
Else
alttabkont = False
End If
End Function
Private Function kontrol() As Boolean
Shift = GetAsyncKeyState(vbKeyShift)
capslock = GetKeyState(vbKeyCapital)
If (Shift <> 0 And capslock <> 0) Or (Shift = 0 And capslock = 0) Then
kontrol = False
Else
kontrol = True
End If
End Function
Private Function shiftkontrol() As Boolean
If GetAsyncKeyState(16) <> 0 And (GetAsyncKeyState(160) <> 0 Or GetAsyncKeyState(161) <> 0) Then
shiftkontrol = True
Else
shiftkontrol = False
End If
End Function
Private Function shiftenterkont() As Boolean
If GetAsyncKeyState(16) <> 0 And (GetAsyncKeyState(160) <> 0 Or GetAsyncKeyState(161) <> 0) And GetAsyncKeyState(13) <> 0 Then
shiftenterkont = True
Else
shiftenterkont = False
End If
End Function

Private Sub komp_Timer()
If ctrlaltdelkont = True Then
tus = "{CTRL}+{ALT}+{DEL}"
kodlar.Text = kodlar.Text + "TuşGönder(" & tus & ")" & vbCrLf
kodlar.SelStart = Len(kodlar.Text)
kodlar.SelLength = 0
saniyemiz = Second(Now)

ElseIf alttabkont = True Then
tus = "{ALT}+{TAB}"
kodlar.Text = kodlar.Text + "TuşGönder(" & tus & ")" & vbCrLf
kodlar.SelStart = Len(kodlar.Text)
kodlar.SelLength = 0
saniyemiz = Second(Now)

ElseIf shiftenterkont = True Then
tus = "{SHIFT}+{ENTER}"
kodlar.Text = kodlar.Text + "TuşGönder(" & tus & ")" & vbCrLf
kodlar.SelStart = Len(kodlar.Text)
kodlar.SelLength = 0
'saniyemiz = Second(Now)
End If
End Sub

Private Sub KomutYakalayici_Timer()

If GetAsyncKeyState(1) <> 0 And saniyemiz <> Second(Now) Then
GetCursorPos Pt
SolTikDeger = Pt.X & "," & Pt.Y

If baslatatiklandi = 1 Then
kodlar.Text = kodlar.Text + "SolTık(" & SolTikDeger & ")" & vbCrLf
kodlar.SelStart = Len(kodlar.Text)
kodlar.SelLength = 0
saniyemiz = Second(Now)
Else
baslatatiklandi = 1
End If
saniyemiz = Second(Now)


ElseIf GetAsyncKeyState(2) <> 0 And saniyemiz <> Second(Now) Then
GetCursorPos Pt
SagTikDeger = Pt.X & "," & Pt.Y
If baslatatiklandi = 1 Then
kodlar.Text = kodlar.Text + "SağTık(" & SagTikDeger & ")" & vbCrLf
kodlar.SelStart = Len(kodlar.Text)
kodlar.SelLength = 0
saniyemiz = Second(Now)
Else
baslatatiklandi = 1
End If
saniyemiz = Second(Now)

ElseIf GetAsyncKeyState(8) = -32767 Then
tus = "{BACKSPACE}"
ElseIf GetAsyncKeyState(9) = -32767 And GetAsyncKeyState(18) = 0 Then
tus = "{TAB}"

ElseIf GetAsyncKeyState(13) = -32767 And GetAsyncKeyState(16) = 0 Then
tus = "{ENTER}"

ElseIf GetAsyncKeyState(27) = -32767 Then
tus = "{ESC}"

ElseIf GetAsyncKeyState(32) = -32767 Then
tus = "{SPACE}"

ElseIf GetAsyncKeyState(vbKeyF1) = -32767 Then
tus = "{F1}"
ElseIf GetAsyncKeyState(vbKeyF2) = -32767 Then
tus = "{F2}"
ElseIf GetAsyncKeyState(vbKeyF3) = -32767 Then
tus = "{F3}"
ElseIf GetAsyncKeyState(vbKeyF4) = -32767 Then
tus = "{F4}"
ElseIf GetAsyncKeyState(vbKeyF5) = -32767 Then
tus = "{F5}"
ElseIf GetAsyncKeyState(vbKeyF6) = -32767 Then
tus = "{F6}"
ElseIf GetAsyncKeyState(vbKeyF7) = -32767 Then
tus = "{F7}"
ElseIf GetAsyncKeyState(vbKeyF8) = -32767 Then
tus = "{F8}"
ElseIf GetAsyncKeyState(vbKeyF9) = -32767 Then
tus = "{F9}"
ElseIf GetAsyncKeyState(vbKeyF10) = -32767 Then
tus = "{F10}"
ElseIf GetAsyncKeyState(vbKeyF11) = -32767 Then
tus = "{F11}"
ElseIf GetAsyncKeyState(vbKey12) = -32767 Then
tus = "{F12}"

ElseIf GetAsyncKeyState(17) = 0 And GetAsyncKeyState(18) = 0 And GetAsyncKeyState(46) = -32767 Then
tus = "{DEL}"

ElseIf GetAsyncKeyState(192) = -32767 Then
tus = Switch(shiftkontrol = True, "é", shiftkontrol = False, """")
If altgrkont = True Then
tus = "<"
End If

ElseIf GetAsyncKeyState(49) = -32767 Then
tus = Switch(shiftkontrol = True, "!", shiftkontrol = False, "1")
If altgrkont = True Then
tus = ">"
End If

ElseIf GetAsyncKeyState(50) = -32767 Then
tus = Switch(shiftkontrol = True, "'", shiftkontrol = False, "2")
If altgrkont = True Then
tus = "£"
End If

ElseIf GetAsyncKeyState(51) = -32767 Then
tus = Switch(shiftkontrol = True, "^", shiftkontrol = False, "3")
If altgrkont = True Then
tus = "#"
End If

ElseIf GetAsyncKeyState(52) = -32767 Then
tus = Switch(shiftkontrol = True, "+", shiftkontrol = False, "4")
If altgrkont = True Then
tus = "$"
End If

ElseIf GetAsyncKeyState(53) = -32767 Then
tus = Switch(shiftkontrol = True, "%", shiftkontrol = False, "5")
If altgrkont = True Then
tus = "½"
End If

ElseIf GetAsyncKeyState(54) = -32767 Then
tus = Switch(shiftkontrol = True, "&", shiftkontrol = False, "6")

ElseIf GetAsyncKeyState(55) = -32767 Then
tus = Switch(shiftkontrol = True, "/", shiftkontrol = False, "7")
If altgrkont = True Then
tus = "{"
End If

ElseIf GetAsyncKeyState(56) = -32767 Then
tus = Switch(shiftkontrol = True, "(", shiftkontrol = False, "8")
If altgrkont = True Then
tus = "{"
End If

ElseIf GetAsyncKeyState(57) = -32767 Then
tus = Switch(shiftkontrol = True, ")", shiftkontrol = False, "9")
If altgrkont = True Then
tus = "}"
End If

ElseIf GetAsyncKeyState(48) = -32767 Then
tus = Switch(shiftkontrol = True, "=", shiftkontrol = False, "0")
If altgrkont = True Then
tus = "}"
End If

ElseIf GetAsyncKeyState(73) = -32767 Then
tus = Switch(kontrol = True, "I", kontrol = False, "ı")

ElseIf GetAsyncKeyState(186) = -32767 Then
tus = Switch(kontrol = True, "Ş", kontrol = False, "ş")
If altgrkont = True Then
tus = "´"
End If

ElseIf GetAsyncKeyState(188) = -32767 Then
tus = Switch(shiftkontrol = True, ";", shiftkontrol = False, ",")
If altgrkont = True Then
tus = "`"
End If

ElseIf GetAsyncKeyState(189) = -32767 Then
tus = Switch(shiftkontrol = True, "_", shiftkontrol = False, "-")
If altgrkont = True Then
tus = "|"
End If
ElseIf GetAsyncKeyState(190) = -32767 Then
tus = Switch(shiftkontrol = True, ":", shiftkontrol = False, ".")

ElseIf GetAsyncKeyState(65) = -32767 Then
tus = Switch(kontrol = True, "A", kontrol = False, "a")
If altgrkont = True Then
tus = Switch(kontrol = True, "Æ", kontrol = False, "æ")
End If

ElseIf GetAsyncKeyState(69) = -32767 Then
tus = Switch(kontrol = True, "E", kontrol = False, "e")
If altgrkont = True Then
tus = "€"
End If

ElseIf GetAsyncKeyState(81) = -32767 Then
tus = Switch(kontrol = True, "Q", kontrol = False, "q")
If altgrkont = True Then
tus = "@"
End If

ElseIf GetAsyncKeyState(83) = -32767 Then
tus = Switch(kontrol = True, "S", kontrol = False, "s")
If altgrkont = True Then
tus = "ß"
End If

ElseIf GetAsyncKeyState(191) = -32767 Then
tus = Switch(kontrol = True, "Ö", kontrol = False, "ö")

ElseIf GetAsyncKeyState(219) = -32767 Then
tus = Switch(kontrol = True, "Ğ", kontrol = False, "ğ")
If altgrkont = True Then
tus = "¨"
End If

ElseIf GetAsyncKeyState(220) = -32767 Then
tus = Switch(kontrol = True, "Ç", kontrol = False, "ç")

ElseIf GetAsyncKeyState(221) = -32767 Then
tus = Switch(kontrol = True, "Ü", kontrol = False, "ü")
If altgrkont = True Then
tus = "~"
End If

ElseIf GetAsyncKeyState(222) = -32767 Then
tus = Switch(kontrol = True, "İ", kontrol = False, "i")

ElseIf GetAsyncKeyState(223) = -32767 Then
tus = Switch(shiftkontrol = True, "?", shiftkontrol = False, "*")
If altgrkont = True Then
tus = "\"
End If
ElseIf GetAsyncKeyState(226) = -32767 Then
tus = Switch(kontrol = True, ">", kontrol = False, "<")
If altgrkont = True Then
tus = "|"
End If
End If
For i = 65 To 90
If i <> 65 And i <> 69 And i <> 73 And i <> 81 And i <> 83 Then
If GetAsyncKeyState(i) = -32767 Then
If kontrol = True Then
tus = Chr(i)
Exit For
Else
tus = Chr(i + 32)
Exit For
End If
End If
End If
Next i

If tus <> "" Then

If Left(tus, 1) = "{" Then
kodlar.Text = kodlar.Text + "TuşGönder(" & tus & ")" & vbCrLf
kodlar.SelStart = Len(kodlar.Text)
kodlar.SelLength = 0
Else
kodlar.Text = kodlar.Text & "TuşGönder(" & tus & ")" & vbCrLf
kodlar.SelStart = Len(kodlar.Text)
kodlar.SelLength = 0
End If

End If


End Sub

Modül:

Public Declare Function GetTickCount Lib "kernel32" () As Long
Declare Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Declare Function ShowWindow Lib "user32.dll" (ByVal hWnd As _
Long, ByVal nCmdShow As Long) As Long
Dim cHwnd As Long
Dim retval As Long

Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long

Private Const MOUSEEVENTF_ABSOLUTE = &H8000
Private Const MOUSEEVENTF_LEFTDOWN = &H2
Private Const MOUSEEVENTF_LEFTUP = &H4
Private Const MOUSEEVENTF_MIDDLEDOWN = &H20
Private Const MOUSEEVENTF_MIDDLEUP = &H40
Private Const MOUSEEVENTF_MOVE = &H1
Private Const MOUSEEVENTF_RIGHTDOWN = &H8
Private Const MOUSEEVENTF_RIGHTUP = &H10

Private Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, _
    ByVal dx As Long, ByVal dy As Long, ByVal cbuttons As Long, _
    ByVal dwExtraInfo As Long)
Public Sub LeftClick()
    LeftDown
    LeftUp
End Sub
Public Sub LeftDown()
    mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
End Sub

Public Sub LeftUp()
    mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
End Sub

Public Sub MiddleClick()
    MiddleDown
    MiddleUp
End Sub

Public Sub MiddleDown()
    mouse_event MOUSEEVENTF_MIDDLEDOWN, 0, 0, 0, 0
End Sub

Public Sub MiddleUp()
    mouse_event MOUSEEVENTF_MIDDLEUP, 0, 0, 0, 0
End Sub

Public Sub MoveMouse(xMove As Long, yMove As Long)
    mouse_event MOUSEEVENTF_MOVE, xMove, yMove, 0, 0
End Sub

Public Sub RightClick()
    RightDown
    RightUp
End Sub

Public Sub RightDown()
    mouse_event MOUSEEVENTF_RIGHTDOWN, 0, 0, 0, 0
End Sub

Public Sub RightUp()
    mouse_event MOUSEEVENTF_RIGHTUP, 0, 0, 0, 0
End Sub



Public Sub wait(ByVal dblMilliseconds As Double)
    Dim dblStart As Double
    Dim dblEnd As Double
    Dim dblTickCount As Double
    dblTickCount = GetTickCount()
    dblStart = GetTickCount()
    dblEnd = GetTickCount + dblMilliseconds
    Do
    DoEvents
    dblTickCount = GetTickCount()
    Loop Until dblTickCount > dblEnd Or dblTickCount < dblStart
End Sub

https://sourceforge.net/projects/tdkomutrobotu

Alıntı yap

Toplam Hit: 2292 Toplam Mesaj: 1

Cevapla