DirextX编程

开发平台：
Visual Basic

脚本模块.bas：源码内容
							Attribute VB_Name = "脚本模块"
Option Explicit
Public Type ScriptType  '脚本属性
    ScriptName As String
    ScriptStr As String
End Type
Public Type NpcType 'NPC属性
    X As Integer
    Y As Integer
    Name_名称 As String
    Image As Integer
    Pic As Integer
    PicSpeed As Integer
    PTime As Long
    ScriptCount As Integer
    Script() As ScriptType
    ScriptFileName As String
End Type
Public SelNpcNum As Integer
Public NpcCount As Integer
Public NPCInfo() As NpcType
Public mScript As String
'#####################################################  此函数作者:junny ################################################################################################
Public Function ActScript(ByVal mPlayer As Integer, ByVal mNpc As Integer, ByVal mScript As String, Optional ByVal inValue As String) As String
    Dim IFstr, ACTstr, ELSEstr, ELSESAYstr As String
    Dim IFvalue As Boolean
    Dim mWord, mData, mVal As Variant
    Dim i, j, k As Long
    Dim tmpStr, mStr As String
    Dim tmpNum, MonID As Long
    Dim N1 As Integer, N2 As Integer
    Dim S1 As String, S2 As String
    Dim mSay As String
    '系统变量
    mScript = SysVariable(mPlayer, mNpc, mScript, inValue)
    IFvalue = True
    
    '去掉TAB字符
    mScript = Replace(mScript, vbTab & vbTab, " ")
    mScript = Replace(mScript, vbTab, " ")
    '去掉多余的空格
    For i = 9 To 2 Step -1
        mScript = Replace(mScript, String(i, " "), " ")
    Next i
    mScript = Replace(mScript, " " & vbCrLf, vbCrLf)
    IFstr = TakeStr(mScript, "#IF" & vbCrLf, vbCrLf & "#ACT")
    If IFstr = "" Then IFstr = TakeStr(mScript, "#if" & vbCrLf, vbCrLf & "#act")
    If IFstr = "" Then IFstr = TakeStr(mScript, "#IF" & vbCrLf, vbCrLf & "#SAY")
    If IFstr = "" Then IFstr = TakeStr(mScript, "#if" & vbCrLf, vbCrLf & "#say")
    '#ACT后面可能是#ELSE也可能是#ELSESAY
    ACTstr = TakeStr(mScript, "#ACT" & vbCrLf, vbCrLf & "#ELSE")
    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#act" & vbCrLf, vbCrLf & "#else")
    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#ACT" & vbCrLf, vbCrLf & "")
    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#act" & vbCrLf, vbCrLf & "")
    
    '如果没有ELSE语句
    If ACTstr = "" Then ACTstr = TakeStr(mScript, "#ACT" & vbCrLf, "")
    ELSEstr = TakeStr(mScript, "#ELSE" & vbCrLf, "")
    If ELSEstr = "" Then ELSEstr = TakeStr(mScript, "#else" & vbCrLf, "")
    ELSESAYstr = TakeStr(mScript, "#ELSESAY" & vbCrLf, "")
    If ELSESAYstr = "" Then ELSESAYstr = TakeStr(mScript, "#elsesay" & vbCrLf, "")
    If ELSESAYstr = "" Then ELSESAYstr = TakeStr(mScript, "#SAY" & vbCrLf, "")
    
    '如果脚本中不含有IF ACT成分，那么呈现整个脚本给客户端
    If (IFstr = "") And (ACTstr = "") And (ELSESAYstr = "") Then IFvalue = False: ELSESAYstr = mScript
    
    '如果只包含ACT语句，则执行
    If (IFstr = "") And (ACTstr <> "") Then IFvalue = True
    '执行判断语句
    mWord = Split(IFstr, vbCrLf)
    For i = 0 To UBound(mWord)
        mData = Split(mWord(i), " ")
        If UBound(mData) >= 0 Then
            Select Case UCase(mData(0))
                Case "CHECKLEVEL"
                    IFvalue = IFvalue And Player(mPlayer).Level >= mData(1)
                Case "CHECKPK"
                    IFvalue = IFvalue And Player(mPlayer).PK值 >= mData(1)
                Case "CHECKJOB"
                    IFvalue = IFvalue And (Player(mPlayer).Job_职业 = mData(1))
                Case "CHECKSEX"
                    IFvalue = IFvalue And (Player(mPlayer).Sex_性别 = mData(1))
                Case "CHECKGOLD"
                    IFvalue = IFvalue And (Player(mPlayer).Gold_金币 >= mData(1))
'                Case "CHECKITEM"
'                    Dim AA As String
'                    AA = mData(1)
''                    tmpNum = GetItemCount(AA)
'                    If UBound(mData) >= 2 Then
'                        N1 = mData(2)
'                        IFvalue = IFvalue And (tmpNum) >= N1
'                    Else
'                        IFvalue = IFvalue And 1
'                    End If
                
            End Select
        End If
    Next i
    '根据上面的判断，生成相应的字符串
    If Not IFvalue Then ACTstr = ELSEstr
    If ACTstr <> "" Then
        mWord = Split(Replace(ACTstr, vbCrLf & vbCrLf, vbCrLf), vbCrLf)
        For i = 0 To UBound(mWord)
            If mWord(i) <> "" Then
                tmpStr = ""
                mData = Split(mWord(i), " ")
                Select Case UCase(mData(0))
                    Case "MSG"
'                        MsgBox Player(mPlayer).PK值, , "PK"
                    Case "SAY"
                        mSay = TakeStr(mWord(i), "say ", "")
                        If mSay = "" Then mSay = TakeStr(mWord(i), "Say ", "")
                        If mSay = "" Then mSay = TakeStr(mWord(i), "SAY ", "")
                        tmpStr = NPCInfo(mNpc).Name_名称 & "/" & mSay
                    Case "ADDFAME" '声望
                        Player(mPlayer).Fame_声望值 = Player(mPlayer).Fame_声望值 + mData(1)
                    Case "TAKE" '拿走包裹装备
                        S1 = mData(1)
                        
                        If mData(1) = "金币" Then
                            If UBound(mData) >= 2 Then
                                N1 = mData(2)
                                Player(mPlayer).Gold_金币 = Player(mPlayer).Gold_金币 - N1
                            End If
                        Else
                            If UBound(mData) >= 2 Then
                                N1 = mData(2)
                            Else
                                N1 = 1
                            End If
'                            ShouItemCount S1, N1
                            
                        End If
                    Case "FAMEUP"
                        Player(mPlayer).Fame_声望值 = Player(mPlayer).Fame_声望值 + mData(1)
                    Case "MAPMOVE"
                        Player(mPlayer).Map_地图 = mData(1)
                    Case "GIVE" '给物品
                        If mData(1) = "金币" Then
                            Player(mPlayer).Gold_金币 = Player(mPlayer).Gold_金币 + mData(2)
                            FrmMain.Server(mPlayer).SendData PLAYERGOLD & KONGDATA & mPlayer & KONGDATA & Player(mPlayer).Name_名字 & KONGDATA & Player(mPlayer).Gold_金币 & NETKONGDATA
                            
                        Else
                            S1 = mData(1)
                            If UBound(mData) >= 2 Then
                                N1 = mData(2)
                            Else
                                N1 = 1
                            End If
                            tmpNum = GetItemNum(S1)
                            If tmpNum > 0 Then
'                                GiveItem Items(tmpNum), N1
                                FrmMain.Server(mPlayer).SendData GIVEITEMDATA & KONGDATA & mPlayer & KONGDATA & Player(mPlayer).Name_名字 & KONGDATA & ItemStr(ItemDB(tmpNum)) & KONGDATA & N1 & NETKONGDATA
                            End If
                        End If
                    Case "SEX"
                        Player(mPlayer).Sex_性别 = mData(1)
                        For j = 1 To playercount
                            If Player(j).Connected = True Then
                                If FrmMain.Server(j).State = sckConnected Then
                                    FrmMain.Server(j).SendData PLAYERSEX & KONGDATA & mPlayer & KONGDATA & Player(mPlayer).Name_名字 & KONGDATA & Player(mPlayer).Sex_性别 & NETKONGDATA
                                End If
                            End If
                        Next
                        
                    Case "LEVELUP"  '升级
                        Player(mPlayer).Level = Player(mPlayer).Level + mData(1)
                        If Player(mPlayer).Level > 255 Then Player(mPlayer).Level = 1
                        FrmMain.Server(mPlayer).SendData PLAYERLEVEL & KONGDATA & mPlayer & KONGDATA & Player(mPlayer).Name_名字 & KONGDATA & Player(mPlayer).Level & NETKONGDATA
                        
                    Case "LEVELDOWN"  '降级
                        Player(mPlayer).Level = Player(mPlayer).Level - mData(1)
                        If Player(mPlayer).Level < 1 Then Player(mPlayer).Level = 1
                        FrmMain.Server(mPlayer).SendData PLAYERLEVEL & KONGDATA & mPlayer & KONGDATA & Player(mPlayer).Name_名字 & KONGDATA & Player(mPlayer).Level & NETKONGDATA
                        
                End Select
            End If
        Next i
    Else
        tmpStr = ELSESAYstr
        
    End If
    
    '字符串变量
    tmpStr = SysVariable(mPlayer, mNpc, tmpStr, inValue)
'    tmpStr = JiaMiC(tmpStr)
    
    '要向客户端发送的字符串
    ActScript = tmpStr '执行结果已加密
End Function
Public Function SysVariable(ByVal mPlayer As Integer, ByVal mNpc As Integer, ByVal mScript As String, Optional ByVal inValue As String) As String
    Dim mStr As String
    Dim i As Long
    '系统变量
    mScript = Replace(mScript, "<$NPCNAME>", NPCInfo(mNpc).Name_名称)
    mScript = Replace(mScript, "<$USERNAME>", Player(mPlayer).Name_名字)
    mScript = Replace(mScript, "<$USERLEVEL>", Player(mPlayer).Level)
'    mScript = Replace(mScript, "<$USERLUCKY>", player(mplayer).Lucky)
    mScript = Replace(mScript, "<$USERPK>", Player(mPlayer).PK值)
'    mScript = Replace(mScript, "<$USERIP>", P7200.sckPost(player(mplayer).SocksID).RemoteHostIP)
    mScript = Replace(mScript, "<$USERFAME>", Player(mPlayer).Fame_声望值)
'    mScript = Replace(mScript, "<$USEGUILD>", player(mplayer).Guild)
'    mScript = Replace(mScript, "<$USERSUBHUMAN>", player(mplayer).SubHuman)
    mScript = Replace(mScript, "<$USERMAP>", Player(mPlayer).Map_地图)
    mScript = Replace(mScript, "<$USERX>", Player(mPlayer).X)
    mScript = Replace(mScript, "<$USERY>", Player(mPlayer).Y)
    mScript = Replace(mScript, "<$USERHOMEMAP>", Player(mPlayer).HomeMap)
    mScript = Replace(mScript, "<$USERHOMEX>", Player(mPlayer).HomeX)
    mScript = Replace(mScript, "<$USERHOMEY>", Player(mPlayer).HomeY)
    mScript = Replace(mScript, "<$YEAR>", Year(Now))
    mScript = Replace(mScript, "<$DATE>", Date)
    mScript = Replace(mScript, "<$TIME>", Time)
    mScript = Replace(mScript, "<$LOGINLONG>", Player(mPlayer).LoginTime)
'    mScript = Replace(mScript, "<$RUNTIME>", Sec2Min(timeGetTime  1000))
'    mScript = Replace(mScript, "<$SABUKGUILD>", SABUK.OwnerGuild)
'    mScript = Replace(mScript, "<$SABUKGUILDBOSS>", SABUK.OwnerBoss)
'    mScript = Replace(mScript, "<$SABUKGOLD>", SABUK.Gold)
    mScript = Replace(mScript, "<$INPUTVAL>", inValue)
    SysVariable = mScript
End Function
'############################################################################################################################
Function TakeStr(Str As Variant, StartStr As String, EndStr As String) As String
    Dim Len1 As Integer
    Dim Len2 As Integer
    Dim SS As String
    Len1 = InStr(Str, StartStr)
    If Len1 = 0 Then Exit Function
    Len2 = InStr(Len1, Str, EndStr)
    If Len2 > Len1 + Len(StartStr) Then
        SS = Mid(Str, Len1 + Len(StartStr), Len2 - Len1 - Len(StartStr))
    Else
        SS = Mid(Str, Len1 + Len(StartStr), Len(Str) - Len1 - Len(StartStr))
    End If
    TakeStr = SS
    
End Function
Public Function GetFunNum(mNpc As Integer, FunName As String) As Integer
    Dim i As Integer
    For i = 1 To NPCInfo(mNpc).ScriptCount
        If UCase(NPCInfo(mNpc).Script(i).ScriptName) = UCase(FunName) Then
            GetFunNum = i
            Exit For
            Exit Function
        End If
    Next
End Function
Public Sub LoadScriptFile(mNpc As Integer, FileName As String)
    Dim i As Integer
    Dim Str As String
    Dim Work1 As Boolean
    Open FileName For Input As #1
        Do While Not EOF(1)
            Line Input #1, Str
            If Left(Str, 1) = "[" Then
                NPCInfo(mNpc).ScriptCount = NPCInfo(mNpc).ScriptCount + 1
                ReDim Preserve NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount)
                NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount).ScriptName = Mid(Str, 2, Len(Str) - 2)
            Else
                NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount).ScriptStr = NPCInfo(mNpc).Script(NPCInfo(mNpc).ScriptCount).ScriptStr & Str & vbCrLf
            End If
            DoEvents
        Loop
    Close #1
End Sub

						