mod88luck.bas

这是诛仙外挂的源代码

Attribute VB_Name = "Mod88Luck"
Option Explicit

''男号脚本执行
Sub ScriptLuckM()
On Error Resume Next
    Dim i As Integer
    Dim LuckTask(3) As Boolean
    
    Main.TimeLuck.Enabled = False
    
    If CheckTeam Then
        ReadMyTask
        Wait 500
        LuckTask(0) = CheckTaskHave("灵犀占卜")                             '判断是否有“灵犀占卜”任务
        LuckTask(1) = CheckTaskHave("难题")                                 '判断是否有“难题”任务
        LuckTask(2) = CheckTaskHave("心门为开")                             '判断是否有“心门为开”任务
        LuckTask(3) = CheckTaskHave("永远同心")                             '判断是否有“永远同心”任务
        If LuckTask(0) Then                                                 '如果有“灵犀占卜”任务
            If LuckTask(1) Then                                             '如果有“难题”任务
                If GoToNpc("青龙", 100, 140) Then                           '找青龙交“难题”任务
                    ShowLuckStat ("交任务 [难题]")
                    SetTaskCall "4786", 3
                    CloseNpcByName ("青龙")
                End If
            Else                                                            '没有“难题”任务
                If LuckTask(2) Then                                         '如果有“心门为开”任务
                    If GoToNpc("青龙", 100, 140) Then                       '找青龙交“心门为开”任务
                        ShowLuckStat ("交任务 [心门为开]")
                        SetTaskCall "4787", 2
                        CloseNpcByName ("青龙")
                    End If
                Else                                                        '没有“心门为开”任务
                    If LuckTask(3) Then                                     '如果有“永远同心”任务
                        If CheckKeepSake("真心之匙") >= 0 Then
                            If CheckKeepSake("真心之锁") >= 0 Then          '找月老交“永远同心”任务
                                If GoToNpc("月老", 182, 104) Then
                                    ShowLuckStat ("交任务 [永远同心]")
                                    SetTaskCall "4788", 1
                                    CloseNpcByName ("月老")
                                End If
                            Else
                                If GoToNpc("交换真心之锁地点", Val(Main.TextLuck(1).Text), Val(Main.TextLuck(2).Text)) Then                 '找女号取"真心之锁"
                                    ShowLuckStat ("等候与[" & Trim(Main.TextLuck(0).Text) & "]交换真心之锁")
                                    AutoPickUp
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        Else                                                                '没有“灵犀占卜”任务
            If CheckKeepSake("小环的信物") >= 0 Then                        '有信物就去接任务
                If GoToNpc("月老", 182, 104) Then
                    ShowLuckStat ("接任务 [灵犀占卜]")
                    GetTaskCall ("4785")
                    CloseNpcByName ("月老")
                End If
            Else                                                            '没有信物结束
                ShowLuckStat ("小环信物使用完，任务结束！")
                Main.ComLuck(0).Caption = "开始任务"
                Main.CboManName.Enabled = True
                Main.ComMain(0).Enabled = True
                Main.ComMain(2).Enabled = True
                Main.ComScript(2).Enabled = True
                Main.TimeLuck.Enabled = False
                Exit Sub
            End If
        End If
    End If
    
    Main.TimeLuck.Enabled = True
End Sub
''女号脚本执行
Sub ScriptLuckW()
On Error Resume Next
    Dim i As Integer
    Dim LuckTask(2) As Boolean, ManPos As String, ManPosXY() As String
    Dim itmX As ListItem, LockPos As Integer, LockNum As Integer
    
    Main.TimeLuck.Enabled = False
    
    If CheckTeam Then
        ReadMyTask
        Wait 500
        LuckTask(0) = CheckTaskHave("灵犀占卜")                             '判断是否有“灵犀占卜”任务
        LuckTask(1) = CheckTaskHave("难题")                                 '判断是否有“难题”任务
        LuckTask(2) = CheckTaskHave("情关有度")                             '判断是否有“心门为开”任务
        If LuckTask(0) Then                                                 '如果有“灵犀占卜”任务
            If LuckTask(1) Then                                             '如果有“难题”任务
                LuckSucceed = False
                If GoToNpc("许青衣", 98, 85) Then                           '找许青衣交“难题”任务
                    ShowLuckStat ("交任务 [难题]")
                    SetTaskCall "4790", 2
                    CloseNpcByName ("许青衣")
                End If
            Else                                                            '没有“难题”任务
                If LuckTask(2) Then                                         '如果有“情关有度”任务
                    If GoToNpc("许青衣", 98, 85) Then                       '找许青衣交“情关有度”任务
                        ShowLuckStat ("交任务 [情关有度]")
                        SetTaskCall "4791", 3
                        CloseNpcByName ("许青衣")
                        ShowLuckStat ("发呆ing...")
                    End If
                End If
            End If
        Else                                                                '没有“灵犀占卜”任务
            If CheckKeepSake("小环的信物") = -1 And CheckKeepSake("真心之锁") = -1 Then                     '有信物就去接任务
                ShowLuckStat ("小环信物使用完，任务结束！")
                Main.ComLuck(0).Caption = "开始任务"
                Main.CboManName.Enabled = True
                Main.ComMain(0).Enabled = True
                Main.ComMain(2).Enabled = True
                Main.ComScript(2).Enabled = True
                Main.TimeLuck.Enabled = False
                Exit Sub
            Else
                If CheckKeepSake("真心之锁") >= 0 Then                      '没有信物结束
                    ManPos = ReadPlayPos(Trim(Main.TextLuck(0).Text))
                    If ManPos <> "A|A" Then
                        ManPosXY = Split(ManPos, "|")
                        If Abs(Val(ManPosXY(0)) - Val(Main.TextLuck(1).Text)) <= 2 And Abs(Val(ManPosXY(1)) - Val(Main.TextLuck(2).Text)) <= 2 Then
                            '如果男号在特定的位置就过去扔"真心之锁"
                            If GoToNpc("交换真心之锁地点", Val(Main.TextLuck(1).Text), Val(Main.TextLuck(2).Text)) Then                                 '到合适地点扔
                                If LuckSucceed = False Then
                                    LockPos = CheckKeepSake("真心之锁")
                                    If Main.CheLuck(0).Value = 0 Then
                                        PeckCall LockPos, 1
                                        ShowLuckStat ("交给[" & Trim(Main.TextLuck(0).Text) & "]1个真心之锁")
                                    Else
                                        Set itmX = Main.LVPick(1).ListItems(LockPos + 1)
                                        LockNum = Val(Trim(itmX.SubItems(Main.LVPick(1).ColumnHeaders("Num").SubItemIndex)))
                                        PeckCall LockPos, LockNum
                                        ShowLuckStat ("交给[" & Trim(Main.TextLuck(0).Text) & "]" & Trim(CStr(LockNum)) & "个真心之锁")
                                    End If
                                    LuckSucceed = True
                                End If
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
    
    Main.TimeLuck.Enabled = True
End Sub
''检查队伍
Function CheckTeam() As Boolean
On Error Resume Next
    Dim TempName As String, LName As String, TName As String
    
    If TeamNum = 2 Then
        Main.OptTeam(0).Value = True
        Select Case PartSex
            Case 0              '男
                LName = Trim(Main.LabTeam2(0).Caption)
                TName = Trim(Main.LabTeam2(2).Caption)
            Case 1              '女
                LName = Trim(Main.LabTeam2(2).Caption)
                TName = Trim(Main.LabTeam2(0).Caption)
        End Select
        LName = Trim(Mid(LName, InStr(LName, ")") + 1))
        LName = Trim(Left(LName, InStr(LName, "[") - 1))
        TName = Trim(Mid(TName, InStr(TName, ")") + 1))
        TName = Trim(Left(TName, InStr(TName, "[") - 1))
        If LName = PartName And TName = Trim(Main.TextLuck(0).Text) Then
            CheckTeam = True
            Exit Function
        Else
            LeaveCall
        End If
    ElseIf TeamNum > 2 Then
        LeaveCall
    Else
        If Main.ListTeam.ListCount = 1 And Trim(Main.ListTeam.List(0)) = Trim(Main.TextLuck(0).Text) Then
            Select Case PartSex
                Case 0              '男
                    If Main.OptTeam(1).Value = False Then
                        Main.OptTeam(1).Value = True
                    End If
                Case 1              '女
                    If Main.OptTeam(2).Value = False Then
                        Main.OptTeam(2).Value = True
                    End If
            End Select
        Else
            Main.OptTeam(0).Value = True
            Main.ListTeam.Clear
            Main.ListTeam.AddItem Trim(Main.TextLuck(0).Text)
            Select Case PartSex
                Case 0              '男
                    If Main.OptTeam(1).Value = False Then
                        Main.OptTeam(1).Value = True
                    End If
                Case 1              '女
                    If Main.OptTeam(2).Value = False Then
                        Main.OptTeam(2).Value = True
                    End If
            End Select
        End If
    End If
    CheckTeam = False
End Function
''检查背包物品位置(没有返回-1)
Function CheckKeepSake(GName As String) As Integer
On Error Resume Next
    Dim i As Integer, KeepSakeName As String
    Dim itmX As ListItem
    
    ReadPartBag
    For i = 1 To Main.LVPick(1).ListItems.Count
        Set itmX = Main.LVPick(1).ListItems(i)
        KeepSakeName = Trim(itmX.SubItems(Main.LVPick(1).ColumnHeaders("Name").SubItemIndex))
        If KeepSakeName = GName Then
            CheckKeepSake = i - 1
            Exit Function
        End If
    Next i
    CheckKeepSake = -1
End Function
''移动到NPC
Function GoToNpc(NpcName As String, NpcX As Single, NpcY As Single) As Boolean
On Error Resume Next
    Dim NPCID As Long
    
    If Int(Abs(PartX - NpcX)) <= 2 And Int(Abs(PartY - NpcY)) <= 2 Then
        NPCID = CDbl(SeleNpcInfo(NpcName, "ID"))
        If NPCID <> 0 Then
            CallNPCOpen NPCID
            ShowLuckStat ("与NPC [" & NpcName & "] 对话")
            Wait 200
        End If
        GoToNpc = True
        Exit Function
    Else
        If NpcWinStat = 1 Then
            CallNPCClose
        End If
        If Len(NpcName) > 0 Then ShowLuckStat ("正在向 [" & NpcName & "] 移动……")
        CallRunTO NpcX, 0, NpcY, MapID
    End If
    GoToNpc = False
End Function
''关闭指定名称Npc
Sub CloseNpcByName(NpcName As String)
On Error Resume Next
    Wait 50
    POpenNpcCall CDbl(SeleNpcInfo(NpcName, "ID"))
    Wait 50
    CallNPCClose
End Sub
''显示状态
Sub ShowLuckStat(cStatString As String)
On Error Resume Next
    Main.LabLuck(0).Caption = Trim(cStatString)
End Sub