[ Oto Kutu Topla +Kod + Modül ]USKO kendi KOXPUNU kendin yap VB6

If AttachKO = False Then Exit Sub

If Check1.Value = 1 Then

UseAutoLoot = 1

Timer31.Enabled = True

Else

UseAutoLoot = 0

Timer31.Enabled = False

End If

End Sub





1 adet check box ve bir adet timer ekleyinn.





Timer ve checki kendininkilerine göre ayarlayınız..



Timer özellikleri ve kodları:



Timer invertali 100 olacak . True olacak birde



Kodları :

Dim nn As Long

On Error Resume Next

DispatchMailSlot

If UseAutoLoot = 1 Then

If OpenNextBox = True Then

For nn = 1 To UBound(LootBox)

If LootBox(nn).BoxOpened = False And LootBox(nn).BoxID <> 0 Then

LootBox(nn).OpenTime = GetTickCount

'Debug.Print "Opening box..(" & LootBox(nn).BoxID & ")"

OpenBox LootBox(nn).BoxID

LootBox(nn).BoxOpened = True

Exit For

End If

Next

Else

For nn = 1 To UBound(LootBox)

If LootBox(nn).BoxOpened = True And LootBox(nn).BoxID <> 0 Then

If (LootBox(nn).OpenTime + 2000) < GetTickCount Then

LootBox(nn).BoxID = 0

'Debug.Print "Removing box.."

OpenNextBox = True

Exit For

End If

End If

Next

End If

End If

End Sub







MODÜL EKLENECEKLER:



Sub DispatchMailSlot()

Dim MsgCount As Long

Dim rc As Long

Dim MessageBuffer As String

Dim pVal As Long

Dim fullcode

Dim code

Dim sKey

MsgCount = 1

Do While MsgCount <> 0

rc = CheckForMessages(MsgCount)

If CBool(rc) And MsgCount > 0 Then

If ReadMessage(MessageBuffer, MsgCount) Then

Call HexVal(MessageBuffer)

code = MessageBuffer

On Error Resume Next

Debug.Print Asc(Left(MessageBuffer, 1))

Select Case Asc(Left(MessageBuffer, 1))

Case 34

Dim maxhp

Dim hp

maxhp = Hex2Val(Mid(MessageBuffer, 5, 3))

hp = Hex2Val(Mid(MessageBuffer, 9, 3))

Form1.Label5858.Caption = "MobHP:" & hp

Case 35

If UseAutoLoot = 1 Then

pVal = Hex2Val(Mid(MessageBuffer, 4, 4))

sKey = "B" & pVal

OpenBox pVal

End If



Case 36

If UseAutoLoot = 1 Then

pVal = Hex2Val(Mid(MessageBuffer, 2, 4))

LootItem pVal



pVal = Hex2Val(Mid(MessageBuffer, 8, 4))

LootItem pVal



pVal = Hex2Val(Mid(MessageBuffer, 14, 4))

LootItem pVal



pVal = Hex2Val(Mid(MessageBuffer, 20, 4))

LootItem pVal



pVal = Hex2Val(Mid(MessageBuffer, 26, 4))

LootItem pVal



pVal = Hex2Val(Mid(MessageBuffer, 32, 4))

LootItem pVal

End If



Case 26

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

End If

End Select

End If

End If

Loop

End Sub



Modülde label felan diyor bir label açarsınız onu değiştirirsiniz. Örnek labelim 15 onu 15 yapın ..