Bonjour,

J'ai créé un bot qui est censé tourner pendant plusieurs heures, mais celui-ci crash après 1 ou 2 heures. Je pense à changer de support pour du Python, mais n'i connaissant rien je voulais d'abord savoir s'il y avait quelque chose a faire.

Code : Sélectionner tout - Visualiser dans une fenêtre à part
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
Cordialement,