1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207 208 209 210 211 212 213 214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248 249 250 251 252 253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290
| Public Declare PtrSafe Function GetKeyState Lib "user32" (ByVal nVirtKey As Long) As Integer
Public Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal Duree As Long)
Public Declare PtrSafe Function Beep Lib "kernel32" (ByVal Frequence As Long, ByVal Duree As Long) As Long
Public Declare PtrSafe Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare PtrSafe Function SetCursorPos Lib "user32" (ByVal x As Long, ByVal y As Long) As Long
Public Declare PtrSafe 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 Const MOUSEEVENTF_LEFTDOWN As Long = &H2
Public Const MOUSEEVENTF_LEFTUP As Long = &H4
Public Const MOUSEEVENTF_RIGHTDOWN As Long = &H8
Public Const MOUSEEVENTF_RIGHTUP As Long = &H10
Public Declare PtrSafe Function FindWindow Lib "user32" Alias "FindWindowA" (ByVal lpClassName As String, ByVal lpWindowName As String) As Long
Public Declare PtrSafe Function SetForegroundWindow Lib "user32" (ByVal hWnd As Long) As Long
Public Declare PtrSafe Function ShowWindow Lib "user32" (ByVal hWnd As Long, ByVal nCmdShow As Long) As Long
Public Declare PtrSafe Function MoveWindow Lib "user32.dll" (ByVal hWnd As Long, ByVal x As Long, ByVal y As Long, ByVal nWidth As Long, ByVal nHeight As Long, ByVal bRepaint As Long) As Long
Public Const SW_HIDE = 0
Public Const SW_SHOWNORMAL = 1
Public Const SW_NORMAL = 1
Public Const SW_SHOWMINIMIZED = 2
Public Const SW_SHOWMAXIMIZED = 3
Public Const SW_MAXIMIZE = 3
Public Const SW_SHOWNOACTIVATE = 4
Public Const SW_SHOW = 5
Public Const SW_MINIMIZE = 6
Public Const SW_SHOWMINNOACTIVE = 7
Public Const SW_SHOWNA = 8
Public Const SW_RESTORE = 9
Public Const SW_SHOWDEFAULT = 10
Public Const SW_MAX = 10
Public Declare PtrSafe Function GetDC Lib "user32" (ByVal hWnd As Long) As Long
Public Declare PtrSafe Function GetPixel Lib "gdi32" (ByVal hdc As Long, ByVal x As Long, ByVal y As Long) As Long
Public Sub set_window(nom As String, a As Long, b As Long, c As Long, d As Long, e As Long) 'pos, pos, dim, dim, jsp
Dim hWnd As Long
hWnd = FindWindow(vbNullString, nom)
If hWnd = 0 Then Exit Sub
MoveWindow hWnd, a, b, c, d, e
End Sub
Public Sub act_window(nom As String, action As Long)
Dim hWnd As Long
hWnd = FindWindow(vbNullString, nom)
If hWnd = 0 Then Exit Sub
SetForegroundWindow hWnd
ShowWindow hWnd, action
End Sub
Public Sub clic(xmin As Long, xmax As Long, ymin As Long, ymax As Long)
SetCursorPos random(xmin, xmax), random(ymin, ymax)
mouse_event MOUSEEVENTF_LEFTDOWN, 0, 0, 0, 0
mouse_event MOUSEEVENTF_LEFTUP, 0, 0, 0, 0
Call Sleep(random(2000, 3000))
End Sub
Public Function couleur(x As Long, y As Long)
couleur = GetPixel(GetDC(0), x, y)
End Function
Public Function random(x As Long, y As Long)
Randomize
random = Int((y - x + 1) * Rnd) + x
End Function
Public Sub autoclic10()
On Error GoTo fin
Application.StatusBar = "Farming..."
Dim a As Integer 'boucle while
Dim i As Integer 'boucle for
Dim j As Integer 'bouclefor
Dim raison As String 'mail
Dim destinataire As String 'mail
Dim vente As Boolean
Dim refillshop As Boolean
raison = "Pas de raison détecté" 'mail
destinataire = Cells(5, 11) 'mail
vente = Cells(7, 11)
refillshop = Cells(9, 11)
Dim vente_xmin(1 To 5) As Long
Dim vente_xmax(1 To 5) As Long
Dim vente_ymin(1 To 5) As Long
Dim vente_ymax(1 To 5) As Long
For i = 1 To 5
vente_xmin(i) = Cells(2 + i, 2)
vente_xmax(i) = Cells(2 + i, 3)
vente_ymin(i) = Cells(2 + i, 4)
vente_ymax(i) = Cells(2 + i, 5)
Next i
Dim coffre_xmin(1 To 3) As Long
Dim coffre_xmax(1 To 3) As Long
Dim coffre_ymin(1 To 3) As Long
Dim coffre_ymax(1 To 3) As Long
For i = 1 To 3
coffre_xmin(i) = Cells(7 + i, 2)
coffre_xmax(i) = Cells(7 + i, 3)
coffre_ymin(i) = Cells(7 + i, 4)
coffre_ymax(i) = Cells(7 + i, 5)
Next i
Dim refill_xmin(1 To 5) As Long
Dim refill_xmax(1 To 5) As Long
Dim refill_ymin(1 To 5) As Long
Dim refill_ymax(1 To 5) As Long
For i = 1 To 5
refill_xmin(i) = Cells(10 + i, 2)
refill_xmax(i) = Cells(10 + i, 3)
refill_ymin(i) = Cells(10 + i, 4)
refill_ymax(i) = Cells(10 + i, 5)
Next i
Dim rejouer(1 To 4) As Long
Dim go10(1 To 4) As Long
Dim antibot(1 To 4) As Long
Dim runes(1 To 4) As Long
For i = 1 To 4
rejouer(i) = Cells(16, 1 + i)
go10(i) = Cells(17, 1 + i)
antibot(i) = Cells(18, 1 + i)
runes(i) = Cells(19, 1 + i)
Next i
Dim fini_x(1 To 3) As Long
Dim fini_y(1 To 3) As Long
Dim fini_c(1 To 3) As Long
Dim vendre_x(1 To 3) As Long
Dim vendre_y(1 To 3) As Long
Dim vendre_c(1 To 3) As Long
Dim leg_x(1 To 3) As Long
Dim leg_y(1 To 3) As Long
Dim leg_c(1 To 3) As Long
Dim refill_x(1 To 3) As Long
Dim refill_y(1 To 3) As Long
Dim refill_c(1 To 3) As Long
Dim coffre_x(1 To 3) As Long
Dim coffre_y(1 To 3) As Long
Dim coffre_c(1 To 3) As Long
Dim antibot_x(1 To 3) As Long
Dim antibot_y(1 To 3) As Long
Dim antibot_c(1 To 3) As Long
Dim runes_x(1 To 3) As Long
Dim runes_y(1 To 3) As Long
Dim runes_c(1 To 3) As Long
For i = 1 To 3
fini_x(i) = Cells(2 + i, 7)
fini_y(i) = Cells(2 + i, 8)
fini_c(i) = Cells(2 + i, 9)
vendre_x(i) = Cells(5 + i, 7)
vendre_y(i) = Cells(5 + i, 8)
vendre_c(i) = Cells(5 + i, 9)
leg_x(i) = Cells(8 + i, 7)
leg_y(i) = Cells(8 + i, 8)
leg_c(i) = Cells(8 + i, 9)
refill_x(i) = Cells(11 + i, 7)
refill_y(i) = Cells(11 + i, 8)
refill_c(i) = Cells(11 + i, 9)
coffre_x(i) = Cells(14 + i, 7)
coffre_y(i) = Cells(14 + i, 8)
coffre_c(i) = Cells(14 + i, 9)
antibot_x(i) = Cells(17 + i, 7)
antibot_y(i) = Cells(17 + i, 8)
antibot_c(i) = Cells(17 + i, 9)
runes_x(i) = Cells(20 + i, 7)
runes_y(i) = Cells(20 + i, 8)
runes_c(i) = Cells(20 + i, 9)
Next i
Call window_BS
debut: 'de la boucle
'attend la fin des runs_____________________________________________________________________________________________________________________________________________
a = 0 'pas fini
While a = 0 'pas fini
Application.Wait (Now + TimeSerial(0, 0, random(2, 5)))
If couleur(fini_x(1), fini_y(1)) = fini_c(1) And _
couleur(fini_x(2), fini_y(2)) = fini_c(2) And _
couleur(fini_x(3), fini_y(3)) = fini_c(3) Then a = 1 'check si fini
Wend '____________________________________________________________________________________________________________________________________attend la fin des runs
'vente selective____________________________________________________________________________________________________________________________________________________
If vente = False Then GoTo vente_terminee 'check boolean
For i = 1 To 2 'vente selective
Call clic(vente_xmin(i), vente_xmax(i), vente_ymin(i), vente_ymax(i))
Next i
If couleur(vendre_x(1), vendre_y(1)) = vendre_c(1) And _
couleur(vendre_x(2), vendre_y(2)) = vendre_c(2) And _
couleur(vendre_x(3), vendre_y(3)) = vendre_c(3) Then GoTo rien_a_vendre 'check si rien a vendre
i = 3 'Vente Oui
Call clic(vente_xmin(i), vente_xmax(i), vente_ymin(i), vente_ymax(i))
If couleur(leg_x(1), leg_y(1)) = leg_c(1) And _
couleur(leg_x(2), leg_y(2)) = leg_c(2) And _
couleur(leg_x(3), leg_y(3)) = leg_c(3) Then Call clic(vente_xmin(i), vente_xmax(i), vente_ymin(i), vente_ymax(i)) 'check si leg a vendre
GoTo vente_terminee
rien_a_vendre:
For i = 4 To 5 'annule vente selective
Call clic(vente_xmin(i), vente_xmax(i), vente_ymin(i), vente_ymax(i))
Next i
vente_terminee: '____________________________________________________________________________________________________________________________________vente selective
'relance____________________________________________________________________________________________________________________________________________________________
Call clic(rejouer(1), rejouer(2), rejouer(3), rejouer(4)) 'click rejouer
Call Sleep(random(2000, 3000))
Call clic(go10(1), go10(2), go10(3), go10(4)) 'clic go
Call Sleep(random(2000, 3000))
'refill_____________________________________________________________________________________________________________________________________________________________
If Not (couleur(refill_x(1), refill_y(1)) = refill_c(1) And _
couleur(refill_x(2), refill_y(2)) = refill_c(2) And _
couleur(refill_x(3), refill_y(3)) = refill_c(3)) Then GoTo fin_refill 'check refill
If couleur(coffre_x(1), coffre_y(1)) = coffre_c(1) And _
couleur(coffre_x(2), coffre_y(2)) = coffre_c(2) And _
couleur(coffre_x(3), coffre_y(3)) = coffre_c(3) Then 'check coffre vide
If refillshop = False Then raison = "coffre vide": GoTo fin 'check boolean
For i = 1 To 2 'refill shop__________________________________________________
Call clic(refill_xmin(i), refill_xmax(i), refill_ymin(i), refill_ymax(i))
Next i
If couleur(antibot_x(1), antibot_y(1)) = antibot_c(1) And _
couleur(antibot_x(2), antibot_y(2)) = antibot_c(2) And _
couleur(antibot_x(3), antibot_y(3)) = antibot_c(3) Then 'check antibot
Call clic(antibot(1), antibot(2), antibot(3), antibot(4)) 'fermer antibot
raison = "Test antibot"
GoTo fin
End If
For i = 3 To 5 'refill shop
Call clic(refill_xmin(i), refill_xmax(i), refill_ymin(i), refill_ymax(i))
Next i '__________________________________________________________refill shop
Else
For i = 1 To 3 'refill coffre________________________________________________________
If i = 2 Then
For j = 1 To 3 'click 3 fois de plus
Call clic(coffre_xmin(i), coffre_xmax(i), coffre_ymin(i), coffre_ymax(i))
Next j
End If
Call clic(coffre_xmin(i), coffre_xmax(i), coffre_ymin(i), coffre_ymax(i))
Next i '________________________________________________________________refill coffre
End If
Call clic(go10(1), go10(2), go10(3), go10(4)) 'clic go
fin_refill: '_________________________________________________________________________________________________________________________________________________refill
'trop de runes______________________________________________________________________________________________________________________________________________________
If couleur(runes_x(1), runes_y(1)) = runes_c(1) And _
couleur(runes_x(2), runes_y(2)) = runes_c(2) And _
couleur(runes_x(3), runes_y(3)) = runes_c(3) Then 'check trop de runes
Call clic(runes(1), runes(2), runes(3), runes(4)) 'clic non
raison = "Inventaire full"
GoTo fin
End If '___________________________________________________________________________________________________________________________________________trop de runes
'fin de la boucle___________________________________________________________________________________________________________________________________________________
GoTo debut
'fin de la macro____________________________________________________________________________________________________________________________________________________
fin:
If destinataire <> "" Then Call EnvoyerEmail("Runs interrompus", destinataire, raison) 'mail
Application.StatusBar = False
If GetKeyState(vbKeyNumlock) = 0 Then SendKeys "{NUMLOCK}" 'reactive le clavier numérique
End Sub |
Partager