Anasayfa
tarafından VisualBasic de kendini biraz geliştirenler anlatımımı hemen anlayacaktır.
Size İlk Olarak Gereken
RecvID: 35A4E900
Case 26 Kodu İçin:
DispatchMailSlot için:
Repair için:
[code]'3B 01 08 D0 EE 8A 09
3B 01 0C D9 6F 5D 0E
3B 01 0A 07 68 5D 0E
3B 01 04 21 64 5D 0E
3B 01 01 EF 6B 5D 0E
Dim packetX() As Byte, xStr As String
3B 01 08 D0 EE 8A 09
3B 01 08 D0 EE 8A 09
If RepairID <> "0" Then
xStr = "3B0108" & RepairID
ConvHEX2ByteArray xStr, packetX
SendPackets packetX
Form1.RepairLabel.Caption "Reparing...(" & xStr & ")"
End If
[/code]
ConvHEX2ByteArray olmayanlar için:
OFFSETS:
dinput modülünüze:
İtem Listesi:
İsteğe Göre paylaşıcam [Resimleri görebilmek için üye olun veya giriş yapın.]
Size İlk Olarak Gereken
If UseAutoLoot = 1 Then
ItemID = fullcode(4) & fullcode(3) & fullcode(2) & fullcode(1)
LootItem ("&H" & ItemID)
SecondID = fullcode(10) & fullcode(9) & fullcode( & fullcode(7)
LootItem ("&H" & SecondID)
ThirdID = fullcode(16) & fullcode(15) & fullcode(14) & fullcode(13)
LootItem ("&H" & ThirdID)
FourthID = fullcode(22) & fullcode(21) & fullcode(20) & fullcode(19)
LootItem ("&H" & FourthID)
FifthID = fullcode(28) & fullcode(27) & fullcode(26) & fullcode(25)
LootItem ("&H" & FifthID)
SixthID = fullcode(34) & fullcode(33) & fullcode(32) & fullcode(31)
LootItem ("&H" & SixthID)
Remove LastBoxID
End IF
RecvID: 35A4E900
Case 26 Kodu İçin:
ItemSlot = fullcode(2)
RecvID = fullcode(6) & fullcode(5) & fullcode(4) & fullcode(3) 'item from recv 26
If RecvID <> "35A4E900" And RecvID <> "00000000" And UseAutoSell = 1 Then
'379048000 = silk bundle
ItemSell "&H" & RecvID, ItemSlot
DispatchMailSlot için:
Sub DispatchMailSlot()
Dim MsgCount As Long
Dim rc As Long
Dim MessageBuffer As String
Dim pVal As Long
Dim fullcode
Dim code
On Error Resume Next
MsgCount = 1
Do While MsgCount <> 0
rc = CheckForMessages(MsgCount)
If CBool(rc) And MsgCount > 0 Then
If ReadMessage(MessageBuffer, MsgCount) Then
code = MessageBuffer
fullcode = Strings.Split(MessageBuffer, "eStyTech")
Select Case fullcode(0)
Repair için:
[code]'3B 01 08 D0 EE 8A 09
3B 01 0C D9 6F 5D 0E
3B 01 0A 07 68 5D 0E
3B 01 04 21 64 5D 0E
3B 01 01 EF 6B 5D 0E
Dim packetX() As Byte, xStr As String
3B 01 08 D0 EE 8A 09
3B 01 08 D0 EE 8A 09
If RepairID <> "0" Then
xStr = "3B0108" & RepairID
ConvHEX2ByteArray xStr, packetX
SendPackets packetX
Form1.RepairLabel.Caption "Reparing...(" & xStr & ")"
End If
[/code]
ConvHEX2ByteArray olmayanlar için:
Public Function ConvHEX2ByteArray(pStr As String, pByte() As Byte)
Dim i As Long
Dim j As Long
ReDim pByte(1 To Len(pStr) / 2)
j = LBound(pByte) - 1
For i = 1 To Len(pStr) Step 2
j = j + 1
pByte(j) = CByte("&H" & Mid(pStr, i, 2))
Next
End Function
OFFSETS:
offset değişmiş olabilir Arkadaşlar...KO_COINS = 2068
dinput modülünüze:
Sub f_Sleep(pMS As Long, Optional pDoevents As Boolean = False)
Dim pTime As Long
pTime = GetTickCount
Do While pMS + pTime > GetTickCount
If pDoevents = True Then DoEvents
Loop
End Sub
İtem Listesi:
İsteğe Göre paylaşıcam [Resimleri görebilmek için üye olun veya giriş yapın.]
