mod09funsub.bas

这是诛仙外挂的源代码

Attribute VB_Name = "Mod09FunSub"
''回城
Sub GoHome()
On Error Resume Next
    Dim NpcCoo As String, NpcX As Single, NpcY As Single

    NpcCoo = ReadIni("Npc", "回城", "坐标" & Trim(CStr(MapID)))  '回城点坐标
    NpcX = CSng(Mid(NpcCoo, 1, InStr(NpcCoo, ",")))
    NpcY = CSng(Mid(NpcCoo, InStr(NpcCoo, ",") + 1))
    If Int(Abs(PartX - NpcX)) <= 2 And Int(Abs(PartY - NpcY)) <= 2 Then
        '准备处理下一步
        ScriptNo = ScriptNo + 1
    Else
        If NpcWinStat = 1 Then
            CallNPCClose
        End If
        If ReadSDoStat(389) = False Then
            CallSkillAttack 389
        End If
        If PartStat <> 4 Then
            CallRunTO NpcX, 0, NpcY, MapID
        End If
    End If
End Sub
''存物
Sub OpenNpcHouse()
On Error Resume Next
    Dim NpcX As Single, NpcY As Single
    Dim NPCID As Long
    
    '如果背包有物并且有过滤表则存
    Main.TimeReBag.Enabled = False
    ReadPartBag
    If Main.LVPick(1).ListItems.Count > 0 And Main.ListPick3.ListCount > 0 Then
        NpcX = CSng(SeleNpcInfo("仓库", "X"))
        NpcY = CSng(SeleNpcInfo("仓库", "Y"))
        If Int(Abs(PartX - NpcX)) <= 2 And Int(Abs(PartY - NpcY)) <= 2 Then
            NPCID = CDbl(SeleNpcInfo("仓库", "ID"))
            CallNPCOpen NPCID
            Wait 200
            If NpcWinStat = 1 Then
                CallNPCClose
                Wait 200
            End If
            CallHouseOpen
            Wait 500
            ReadPartHouse
            '此处开始存物品
            If Main.LVPick(2).ListItems.Count > 0 Then
                SaveGoods
            End If
        Else
            If NpcWinStat = 1 Then
                CallNPCClose
            End If
            CallRunTO NpcX, 0, NpcY, MapID
        End If
    Else
        ScriptNo = ScriptNo + 1
    End If
    Main.TimeReBag.Enabled = True
End Sub
''存物
Sub SaveGoods()
On Error Resume Next
    Dim i As Integer, ii As Integer
    Dim SaveBNo As Long, SaveBName As String, SaveBNum As String, SaveBMNum As String
    Dim SaveHNo As Long, SaveHName As String, SaveHNum As String, SaveHNull As Long
    Dim IsSave As Boolean
    
    '此处开始存物品
    For i = 1 To Main.LVPick(1).ListItems.Count
        SaveBNo = i - 1
        SaveBName = Trim(Main.LVPick(1).ListItems.Item(i).SubItems(Main.LVPick(1).ColumnHeaders("Name").SubItemIndex))
        SaveBNum = Trim(Main.LVPick(1).ListItems.Item(i).SubItems(Main.LVPick(1).ColumnHeaders("Num").SubItemIndex))
        SaveBMNum = Trim(Main.LVPick(1).ListItems.Item(i).SubItems(Main.LVPick(1).ColumnHeaders("MNum").SubItemIndex))
        If Len(SaveBName) > 0 Then
            IsSave = False
            For ii = 0 To Main.ListPick3.ListCount - 1
                If SaveBName = Trim(Main.ListPick3.List(ii)) Then
                    IsSave = True
                    ii = Main.ListPick3.ListCount
                End If
            Next ii
            If IsSave = True Then
                SaveHNo = -1
                SaveHNull = -1
                If CDbl(SaveBMNum) = 1 Then           '单一物品，只能放仓库空格里面
                    For ii = 1 To Main.LVPick(2).ListItems.Count
                        SaveHNum = Trim(Main.LVPick(2).ListItems.Item(ii).SubItems(Main.LVPick(2).ColumnHeaders("Num").SubItemIndex))
                        If CDbl(SaveHNum) = 0 Then
                            If SaveHNull < 0 Then
                                SaveHNo = -1
                                SaveHNull = ii - 1
                                ii = Main.LVPick(2).ListItems.Count + 1
                            End If
                        End If
                    Next ii
                Else                            '能堆叠的物品，先找没满的仓库格子，再找仓库空格
                    For ii = 1 To Main.LVPick(2).ListItems.Count
                        SaveHName = Trim(Main.LVPick(2).ListItems.Item(ii).SubItems(Main.LVPick(2).ColumnHeaders("Name").SubItemIndex))
                        SaveHNum = Trim(Main.LVPick(2).ListItems.Item(ii).SubItems(Main.LVPick(2).ColumnHeaders("Num").SubItemIndex))
                        If Len(SaveHName) > 0 Then
                            If SaveBName = SaveHName And CDbl(SaveHNum) < CDbl(SaveBMNum) Then
                                SaveHNo = ii - 1
                                SaveHNull = -1
                                ii = Main.LVPick(2).ListItems.Count + 1
                            End If
                        Else
                            If SaveHNull < 0 Then
                                SaveHNull = ii - 1
                            End If
                        End If
                    Next ii
                End If
                '存物
                If SaveHNull >= 0 Then
                    CallSaveItem CDbl(SaveBNum), SaveBNo, SaveHNull
                    Wait 1000
                    ReadPartBag
                    ReadPartHouse
                ElseIf SaveHNo >= 0 Then
                    CallSaveItem CDbl(SaveBNum), SaveBNo, SaveHNo
                    Wait 1000
                    ReadPartBag
                    ReadPartHouse
                    i = i - 1
                End If
            End If
        End If
    Next i
    ScriptNo = ScriptNo + 1
End Sub
''卖物
Sub SellGoods()
On Error Resume Next
    Dim NpcX As Single, NpcY As Single
    Dim i As Integer, ii As Integer, NPCID As Long
    Dim SellBGID As String, SellName As String, SellBGNum As String
    Dim IsSell As Boolean

    '如果背包有物则卖
    If Main.LVPick(1).ListItems.Count > 0 Then
        NpcX = CSng(SeleNpcInfo("名医", "X"))
        NpcY = CSng(SeleNpcInfo("名医", "Y"))
        If Int(Abs(PartX - NpcX)) <= 2 And Int(Abs(PartY - NpcY)) <= 2 Then
            '此处开始卖物
            NPCID = CDbl(SeleNpcInfo("名医", "ID"))
            CallNPCOpen NPCID
            Wait 200
            For i = 1 To Main.LVPick(1).ListItems.Count
                SellBGID = Trim(Main.LVPick(1).ListItems.Item(i).SubItems(Main.LVPick(1).ColumnHeaders("ID").SubItemIndex))
                SellName = Trim(Main.LVPick(1).ListItems.Item(i).SubItems(Main.LVPick(1).ColumnHeaders("Name").SubItemIndex))
                SellBGNum = Trim(Main.LVPick(1).ListItems.Item(i).SubItems(Main.LVPick(1).ColumnHeaders("Num").SubItemIndex))
                If Len(SellName) > 0 Then
                    If Main.ChePick1(2).Value = 1 Then
                        IsSell = False
                        For ii = 0 To Main.ListPick1.ListCount - 1
                            If SellName = Trim(Main.ListPick1.List(ii)) Then
                                IsSell = True
                                ii = Main.ListPick1.ListCount + 1
                            End If
                        Next ii
                        If IsSell = False Then
                            For ii = 0 To Main.ListPick2.ListCount - 1
                                If SellName = Trim(Main.ListPick2.List(ii)) Then
                                    IsSell = True
                                    ii = Main.ListPick2.ListCount + 1
                                End If
                            Next ii
                        End If
                    Else
                        IsSell = False
                    End If
                    If IsSell = True Then
                        '卖物
                        CallSell CDbl(SellBGID), CDbl(i - 1), CDbl(SellBGNum)
                    End If
                End If
            Next i
            ScriptNo = ScriptNo + 1
        Else
            If NpcWinStat = 1 Then
                CallNPCClose
            End If
            CallRunTO NpcX, 0, NpcY, MapID
        End If
    Else
        ScriptNo = ScriptNo + 1
    End If
End Sub
''买红药
Sub BuyRed()
On Error Resume Next
    Dim NpcX As Single, NpcY As Single
    Dim NPCID As Long
    Dim s1() As String, BuyNum As Integer

    '如果需要买，并且数量少于要买的数量
    Main.TimeReBag.Enabled = False
    ReadPartBag
    BuyNum = Val(Main.TextSafe(12).Text) - Val(Main.LabMedi(0).Caption)
    If (Main.CheSafe(4).Value = 1 Or Main.CheSafe(10).Value = 1) And Len(Trim(Main.TextSafe(10).Text)) > 0 And BuyNum > 0 Then
        NpcX = CSng(SeleNpcInfo("名医", "X"))
        NpcY = CSng(SeleNpcInfo("名医", "Y"))
        If Int(Abs(PartX - NpcX)) <= 2 And Int(Abs(PartY - NpcY)) <= 2 Then
            '此处开始买物
            NPCID = CDbl(SeleNpcInfo("名医", "ID"))
            CallNPCOpen NPCID
            Wait 200
            '买物
            s1 = Split(Main.TextSafe(10).Text, "|")
            CallBuy CDbl(s1(1)), CDbl(s1(2)), CDbl(BuyNum)
            Erase s1
        Else
            If NpcWinStat = 1 Then
                CallNPCClose
            End If
            CallRunTO NpcX, 0, NpcY, MapID
        End If
    Else
        ScriptNo = ScriptNo + 1
    End If
    Main.TimeReBag.Enabled = True
End Sub
''买蓝药
Sub BuyBlue()
On Error Resume Next
    Dim NpcX As Single, NpcY As Single
    Dim NPCID As Long
    Dim s1() As String, BuyNum As Integer

    '如果需要买，并且数量少于要买的数量
    Main.TimeReBag.Enabled = False
    ReadPartBag
    BuyNum = Val(Main.TextSafe(13).Text) - Val(Main.LabMedi(1).Caption)
    If (Main.CheSafe(5).Value = 1 Or Main.CheSafe(11).Value = 1) And Len(Trim(Main.TextSafe(11).Text)) > 0 And BuyNum > 0 Then
        NpcX = CSng(SeleNpcInfo("名医", "X"))
        NpcY = CSng(SeleNpcInfo("名医", "Y"))
        If Int(Abs(PartX - NpcX)) <= 2 And Int(Abs(PartY - NpcY)) <= 2 Then
            '此处开始买物
            NPCID = CDbl(SeleNpcInfo("名医", "ID"))
            CallNPCOpen NPCID
            Wait 200
            '买物
            s1 = Split(Main.TextSafe(11).Text, "|")
            CallBuy CDbl(s1(1)), CDbl(s1(2)), CDbl(BuyNum)
            Erase s1
        Else
            If NpcWinStat = 1 Then
                CallNPCClose
            End If
            CallRunTO NpcX, 0, NpcY, MapID
        End If
    Else
        ScriptNo = ScriptNo + 1
    End If
    Main.TimeReBag.Enabled = True
End Sub
''组队
Sub DoParty()
On Error Resume Next
    Dim i As Integer, ii As Integer
    Dim WillAccept As String, WillAcceptId As Long
    Dim LeaderName As String
    Dim itmX As ListItem, WillAcceptLine As Integer
    Dim FriendID As Long, FriendName As String, FriendLine As Long
    
    Main.TimeParty.Enabled = False
    ''邀请别人
    If Main.OptTeam(1).Value = True Then
        Main.TimeParty.Interval = 30000
        If TeamNum < 6 And TeamNum < Main.ListTeam.ListCount + 1 Then
            ReadFriend
            For i = 0 To Main.ListTeam.ListCount - 1
                WillAccept = Trim(Main.ListTeam.List(i))
                For ii = 1 To Main.LVFriend(0).ListItems.Count
                    Set itmX = Main.LVFriend(0).ListItems(ii)
                    FriendID = CDbl(itmX.SubItems(Main.LVFriend(0).ColumnHeaders("Id").SubItemIndex))
                    FriendName = Trim(itmX.SubItems(Main.LVFriend(0).ColumnHeaders("Name").SubItemIndex))
                    FriendLine = Trim(itmX.SubItems(Main.LVFriend(0).ColumnHeaders("Line").SubItemIndex))
                    If WillAccept = FriendName And PartLine = FriendLine And _
                        FriendID <> CDbl(Main.LabTeam2(0).ToolTipText) And _
                        FriendID <> CDbl(Main.LabTeam2(2).ToolTipText) And _
                        FriendID <> CDbl(Main.LabTeam2(4).ToolTipText) And _
                        FriendID <> CDbl(Main.LabTeam2(6).ToolTipText) And _
                        FriendID <> CDbl(Main.LabTeam2(8).ToolTipText) And _
                        FriendID <> CDbl(Main.LabTeam2(10).ToolTipText) Then
                        InviteCall (FriendID)
                    End If
                Next ii
            Next i
        End If
    End If
    ''别人邀请
    If Main.OptTeam(2).Value = True Then
        Main.TimeParty.Interval = 5000
        If AskStat > 0 And TeamNum = 0 Then
            ReadFriend
            WillAcceptId = AskStatId
            For i = 1 To Main.LVFriend(0).ListItems.Count
                Set itmX = Main.LVFriend(0).ListItems(i)
                FriendID = CDbl(itmX.SubItems(Main.LVFriend(0).ColumnHeaders("Id").SubItemIndex))
                FriendName = Trim(itmX.SubItems(Main.LVFriend(0).ColumnHeaders("Name").SubItemIndex))
                If FriendID = AskStatId Then
                    For ii = 0 To Main.ListTeam.ListCount - 1
                        If FriendName = Trim(Main.ListTeam.List(ii)) Then
                            AcceptCall (WillAcceptId)
                            Main.TimeParty.Enabled = True
                            Exit Sub
                        End If
                    Next ii
                    Main.TimeParty.Enabled = True
                    Exit Sub
                End If
            Next i
        End If
    End If
    Main.TimeParty.Enabled = True
End Sub