mod07onhook.bas

这是诛仙外挂的源代码

            nDistance = itmX.SubItems(Main.LVPick(0).ColumnHeaders("Ran").SubItemIndex)
            FGoodsX = CSng(itmX.SubItems(Main.LVPick(0).ColumnHeaders("X").SubItemIndex))
            FGoodsY = CSng(itmX.SubItems(Main.LVPick(0).ColumnHeaders("Y").SubItemIndex))
            FNum = Int(itmX.SubItems(Main.LVPick(0).ColumnHeaders("Num").SubItemIndex))
            FMNum = Int(itmX.SubItems(Main.LVPick(0).ColumnHeaders("MNum").SubItemIndex))
            IsPickUp = True
            If PartBagLeave = 0 Then
                IsPickUp = False
                For ii = 1 To Main.LVPick(1).ListItems.Count
                    Set itmX = Main.LVPick(1).ListItems(ii)
                    If CStr(FGoodsID) = itmX.SubItems(Main.LVPick(1).ColumnHeaders("FGID").SubItemIndex) And _
                        FNum < FMNum Then
                        IsPickUp = True
                        Exit For
                    End If
                Next ii
            End If
            If IsPickUp Then
                If nDistance <= Val(Main.TextPick1(0).Text) Then
                    If nDistance > 9 Then
                        CallGoTO Int((PartX + FGoodsX) / 2), Int((PartY + FGoodsY) / 2)
                    Else
                        CallPickItem FGoodsID, FGoodsSysID
                        AlreadyPickUp FGoodsName, FGoodsID, FGoodsSysID
                    End If
                End If
            End If
        Next i
        ReadPartBag
    End If
End Sub
''记录拾取过的物品
Sub AlreadyPickUp(APName As String, APID As Long, APSysID As Long)
On Error Resume Next
    Dim itmX As ListItem
    Dim i As Integer, IsAdd As Boolean
    
    IsAdd = True
    For i = 1 To Main.LVPick(4).ListItems.Count
        Set itmX = Main.LVPick(4).ListItems(i)
        If Trim(CStr(APSysID)) = Trim(itmX.SubItems(Main.LVPick(4).ColumnHeaders("FGSID").SubItemIndex)) And _
            Trim(CStr(APID)) = Trim(itmX.SubItems(Main.LVPick(4).ColumnHeaders("FGID").SubItemIndex)) Then
            IsAdd = False
            Exit For
        End If
    Next i
    If IsAdd Then
        Set itmX = Main.LVPick(4).ListItems.Add(, , APName)
        itmX.SubItems(Main.LVPick(4).ColumnHeaders("FGID").SubItemIndex) = CStr(APID)
        itmX.SubItems(Main.LVPick(4).ColumnHeaders("FGSID").SubItemIndex) = CStr(APSysID)
    End If
End Sub
''清理背包
Sub ClearBag()
On Error Resume Next
    Dim i As Integer, ii As Integer
    Dim itmX As ListItem
    Dim FGoodsName As String, FGoodsNum As Integer, IsClear As Boolean
    
    For i = 1 To Main.LVPick(1).ListItems.Count
        Set itmX = Main.LVPick(1).ListItems(i)
        FGoodsName = Trim(itmX.SubItems(Main.LVPick(1).ColumnHeaders("Name").SubItemIndex))
        FGoodsNum = Int(itmX.SubItems(Main.LVPick(1).ColumnHeaders("Num").SubItemIndex))
        IsClear = False
        For ii = 0 To Main.ListPick1.ListCount - 1
            If FGoodsName = Trim(Main.ListPick1.List(ii)) Then
                IsClear = True
                Exit For
            End If
        Next ii
        If IsClear Then
            PeckCall i - 1, FGoodsNum
            PartBagLeave = PartBagLeave + 1
        End If
    Next i
End Sub
''自动交接任务
Function AutoDoTask() As Boolean
On Error Resume Next
    Dim i As Integer, ii As Integer
    Dim MyTaskArr() As String, ATaskArr() As String, NpcArrS As String, NpcArr() As String
    Dim TaskNoSuc As Boolean, NoHaveTask As Boolean, IsAdd As Boolean
    Dim NoSucTaskId As String
    
    If Main.ListATask.ListCount > 0 Then
        '读取自身现有任务
        ReadMyTask
        Wait 500
        '判断身上是否有要做的任务
        TaskNoSuc = False
        NoHaveTask = False
        For i = 0 To Main.ListLuck.ListCount - 1
            MyTaskArr = Split(Trim(Main.ListLuck.List(i)), "|")
            For ii = 0 To Main.ListATask.ListCount - 1
                ATaskArr = Split(Trim(Main.ListATask.List(ii)), "|")
                If Trim(MyTaskArr(1)) = Trim(ATaskArr(1)) And Trim(MyTaskArr(2)) = Trim(ATaskArr(2)) And Trim(ATaskArr(0)) = "√" Then
                    NoHaveTask = True
                    If CheckTaskOk(Trim(MyTaskArr(2))) = False Then
                        NoSucTaskId = Trim(MyTaskArr(1))
                        TaskNoSuc = True
                        Exit For
                    End If
                End If
            Next ii
            If TaskNoSuc Then
                Exit For
            End If
        Next i
        Erase MyTaskArr
        Erase ATaskArr
        If TaskNoSuc Then
            '有没有完成的任务，去完成任务
            '   嗜血妖僧#10#符录
            NpcArrS = ""
            For i = 0 To Main.Task.ListCount - 1
                ATaskArr = Split(Trim(ReadIni("Task", "Task" & MapID, "Item" & Trim(CStr(i)))), ",")
                If Trim(ATaskArr(0)) = NoSucTaskId Then
                    NpcArrS = Trim(ATaskArr(4))
                    Main.TaskStat(0).Caption = "正在完成[" & Trim(ATaskArr(1)) & "]任务"
                    Exit For
                End If
            Next i
            Erase ATaskArr
            If Len(NpcArrS) > 0 Then
                MyTaskArr = Split(NpcArrS, "|")
                '多项子任务的需要加循环
                For i = 0 To UBound(MyTaskArr)
                    NpcArr = Split(Trim(MyTaskArr(i)), "#")
                    '如果有要杀怪的信息
                    If Len(Trim(NpcArr(0))) > 0 Then
                        '需要添加判断完成数量的函数
                        'If  Then
                            Main.TaskStat(1).Caption = "杀" & NpcArr(1) & "个任务怪[" & NpcArr(0) & "]"
                            NpcArrS = Trim(ReadIni("Monster", "Monster", Trim(NpcArr(0))))
                            ATaskArr = Split(NpcArrS, ",")
                            Main.ChePath1(0).Value = 1
                            Main.TextPath1(1).Text = ATaskArr(2)
                            Main.TextPath1(2).Text = ATaskArr(3)
                            AutoDoTask = False
                            IsAdd = True
                            If Main.CheAutoTask(1).Value = 1 And Main.ListWar1.ListCount > 1 Then
                                Main.ListWar1.Clear
                            End If
                            For ii = 0 To Main.ListWar1.ListCount - 1
                                If Trim(Main.ListWar1.List(ii)) = Trim(NpcArr(0)) Then
                                    IsAdd = False
                                    Exit For
                                End If
                            Next ii
                            If IsAdd Then
                                If Main.CheAutoTask(1).Value = 1 Then
                                    Main.ListWar1.Clear
                                End If
                                Main.ListWar1.AddItem Trim(NpcArr(0))
                            End If
                            Exit Function
                        'End If
                    End If
                Next i
            End If
        Else
            '全部完成，去交任务
            If NoHaveTask = True Then
                For i = 0 To Main.ListLuck.ListCount - 1
                    ATaskArr = Split(Trim(Main.ListLuck.List(i)), "|")
                    If ATaskArr(0) = "3" Then
                        For ii = 0 To Main.Task.ListCount - 1
                            MyTaskArr = Split(Trim(ReadIni("Task", "Task" & MapID, "Item" & Trim(CStr(ii)))), ",")
                            If ATaskArr(1) = MyTaskArr(0) Then
                                NpcArrS = Trim(ReadIni("Npc", "Npc", Trim(MyTaskArr(3))))
                                If Len(Trim(NpcArrS)) > 1 Then
                                    NpcArr = Split(NpcArrS, ",")
                                    AutoSetTask Trim(MyTaskArr(3)), CSng(NpcArr(2)), CSng(NpcArr(3)), Trim(MyTaskArr(1)), Trim(MyTaskArr(0)), 0
                                    AutoDoTask = True
                                    Exit Function
                                Else
                                    Exit For
                                End If
                            End If
                        Next ii
                    End If
                Next i
                Erase MyTaskArr
                Erase ATaskArr
            Else
                '没有任务存在，去管理员处接任务
                Main.ChePath1(0).Value = 0
                For i = 0 To Main.ListATask.ListCount - 1
                    ATaskArr = Split(Trim(Main.ListATask.List(i)), "|")
                    For ii = 0 To Main.Task.ListCount - 1
                        MyTaskArr = Split(Trim(ReadIni("Task", "Task" & MapID, "Item" & Trim(CStr(ii)))), ",")
                        If MyTaskArr(0) = ATaskArr(1) Then
                            NpcArrS = Trim(ReadIni("Npc", "Npc", Trim(MyTaskArr(2))))
                            If Len(Trim(NpcArrS)) > 1 Then
                                NpcArr = Split(NpcArrS, ",")
                                AutoGetTask Trim(MyTaskArr(2)), CSng(NpcArr(2)), CSng(NpcArr(3)), Trim(MyTaskArr(1)), Trim(MyTaskArr(0)), 1
                                Wait 200
                                AutoDoTask = True
                            End If
                        End If
                    Next ii
                Next
                Erase MyTaskArr
                Erase ATaskArr
            End If
        End If
    End If
    AutoDoTask = False
End Function
''自定义脚本
Sub DiyScript()
On Error Resume Next
    If ScriptNo <= Main.ListScript.ListCount Then
        Main.ListScript.ListIndex = ScriptNo - 1
        Select Case Main.ListScript.List(ScriptNo - 1)
            Case "回城"
                GoHome
            Case "存物品"
                OpenNpcHouse
            Case "卖物品"
                SellGoods
            Case "买红药"
                BuyRed
            Case "买蓝药"
                BuyBlue
        End Select
    Else
        Main.ComScript(2).Caption = "运行脚本"
        Main.TDiyScript.Enabled = False
    End If
End Sub
''包满脚本
Sub Script()
On Error Resume Next
    Select Case ScriptNo
        Case 1
            GoHome
        Case 2
            OpenNpcHouse
        Case 3
            SellGoods
        Case 4
            BuyRed
        Case 5
            BuyBlue
        Case 6
            Main.TimeScript.Enabled = False
            Main.TimeOnHook.Enabled = True
            Main.TimeBuff.Enabled = True
    End Select
End Sub