2 Replies - 1569 Views - Last Post: 12 September 2010 - 06:37 PM Rate Topic: -----

#1 tiwiwataru   User is offline

  • New D.I.C Head

Reputation: 0
  • View blog
  • Posts: 1
  • Joined: 25-July 10

How to Make my Client game to Webase online!

Posted 23 August 2010 - 03:26 AM

I have a source files and i found out that the client have a script that can put in a web base but the problem is i dont know how to make a files maker.

here some Pic of the client and Script..

Posted Image

Client Script.

#define <C_BLACK> <0>
#define <C_BLUE> <1>
#define <C_GREEN> <2>
#define <C_CYAN> <3>
#define <C_RED> <4>
#define <C_MAGENTA> <5>
#define <C_BROWN> <6>
#define <C_GREY> <7>
#define <C_DARKGREY> <8>
#define <C_BRIGHTBLUE> <9>
#define <C_BRIGHTGREEN> <10>
#define <C_BRIGHTCYAN> <11>
#define <C_BRIGHTRED> <12>
#define <C_PINK> <13>
#define <C_YELLOW> <14>
#define <C_WHITE> <15>
#define <C_ORANGE> <16>
#define <C_BRIGHTORANGE> <17>
#define <MORAL_NONE> <0>
#define <MORAL_SAFE> <1>
#define <MORAL_ARENA> <2>
#define <MORAL_SAVAGE> <3>
#define <MORAL_EXP> <4>
#define <MORAL_NOSPELL> <5>



Sub JoinGame(index) ' Called when players join the server

    GAME_WEBSITE = "XtremeWorlds.com"
   
    Call PlayerMsg(index, "Welcome to " & GetServerName & " Please visit the offical website at " & GAME_WEBSITE & ".", C_BRIGHTBLUE)
   
    If GetPlayerLevel(index) < 5 Then
        Call PlayerMsg(index, "Type /help for help on commands.  Use arrow keys to move, hold down shift to run, and use ctrl to attack.", C_CYAN)
    End If
   
    Call SendMOTD(index)
    Call SendWhosOnline(index)
   
    If GetPlayerAccess(index) < 1 Then
        Call GlobalMsg(GetPlayerName(index) & " (" & GetClassName(GetPlayerClassID(index)) & ") has joined " & GetServerName & "!", C_WHITE)
        Call AdminMsg("IP: " & GetPlayerIP(index), C_WHITE)
    Else
        Call GlobalMsg(GetPlayerName(index) & " (" & GetPlayerAccessName(index) & ") has joined " & GetServerName & "!", C_WHITE)
    End If

End Sub



Sub LeftGame(index) ' Called when players leave the server

    If GetPlayerAccess(index) < 1 Then
        Call GlobalMsg(GetPlayerName(index) & " (" & GetClassName(GetPlayerClassID(index)) & ") has left " & GetServerName & "!", C_GREY)
    Else
        Call GlobalMsg(GetPlayerName(index) & " (" & GetPlayerAccessName(index) & ") has left " & GetServerName & "!", C_GREY)
    End If

End Sub



Sub OnLevelUp(index) ' Called to check for player levelup

    If GetPlayerExp(index) >= GetPlayerNextLevel(index) Then
        If (GetPlayerLevel(index) + 1) <= GetServerMaxLevel Then
            i = Int(GetPlayerSPEED(index) / 10)
            If i < 1 Then i = 1
            If i > 3 Then i = 3
            Call SetPlayerLevel(index, GetPlayerLevel(index) + 1)
            Call SetPlayerPOINTS(index, GetPlayerPOINTS(index) + i)
            Call SetPlayerExp(index, 0)
            Call PlayerMsg(index, "You have gained a level!  You now have " & GetPlayerPOINTS(index) & " stat points to distribute.", C_GREY)
            Call GetStats(index)
        Else
            Call PlayerMsg(index, "Sorry " & GetPlayerName(index) & " but " & GetServerMaxLevel & " is the level cap.", C_WHITE)
            Call SetPlayerExp(index, 0)
        End If
    End If

End Sub



Sub OnScriptedTile(index, Movement) ' Called when players move

Dim X
Dim Y
Dim Map
   
    X = GetPlayerX(index)
    Y = GetPlayerY(index)
    Map = GetPlayerMap(index)
   
    Select Case Map
        Case 1
            If X = 5 And Y = 10 Then
                'Code
            End If
           
        Case 2
            If X = 4 And Y = 1 Then
                If GetPlayerDir(index) = 0 Then
               
                End If
            End If
   
    End Select

End Sub



Sub OnDeath(Index, Attacker)
Dim Exp

If IsNumeric(Attacker) Then
    Call GlobalMsg(GetPlayerName(Index) & " has been killed by " & GetPlayerName(Attacker) & ".", C_BRIGHTRED)
   
    If GetMapMoral(Index) = 0 Then
        Call DropWornEquip(Index)
   
        If GetPlayerPK(Attacker) = 0 Then
            If GetPlayerPK(Index) = 0 Then
                Call SetPlayerPK(Attacker, 1)
                Call GlobalMsg(GetPlayerName(Attacker) & " has been deemed a Player Killer!", C_BRIGHTRED)
            End If
        End If
    End If
   
    If GetPlayerPK(Index) = 1 Then
         Call SetPlayerPK(Index, 0)
         Call GlobalMsg(GetPlayerName(Index) & " has payed the price for Player Killing!", C_BRIGHTRED)
    End If

    If GetMapMoral(Index) = MORAL_NONE Or GetMapMoral(Index) = MORAL_EXP Or GetPlayerPK(Index) = 1 Then
        Exp = Int(GetPlayerExp(Index) / 10)
        If Exp < 0 Then
            Exp = 0
        End If
        If Exp = 0 Then
            Call PlayerMsg(Index, "You lost no experience points.", C_BRIGHTRED)
            Call PlayerMsg(Attacker, "You received no experience points from that weak insignificant Player.", C_BRIGHTRED)
        Else
            Call SetPlayerExp(Index, GetPlayerExp(Index) - Exp)
            Call PlayerMsg(Index, "You lost " & Exp & " experience points.", C_BRIGHTRED)
            Call SetPlayerExp(Attacker, GetPlayerExp(Attacker) + Exp)
            Call PlayerMsg(Attacker, "You got " & Exp & " experience points for killing " & GetPlayerName(Index) & ".", C_BRIGHTRED)
        End If
    End If
Else
    If GetMapMoral(Index) = 0 Then
        Call DropWornEquip(Index)
    End If                                 
    Exp = Int(GetPlayerExp(Index) / 3)
    If Exp < 0 Then
        Exp = 0
    End If
    If Exp = 0 Then
        PlayerMsg Index, "You lost no experience points.", C_GREY
    Else
        SetPlayerExp Index, GetPlayerExp(Index) - Exp
        PlayerMsg Index, "You lost " & Exp & " experience points.", C_GREY
        SendExp Index
    End If
End If

    If GetBootMap(Index) < 1 Then
        Call PlayerWarp(Index, 1, 6, 6)
    Else
        Call PlayerWarp(Index, GetBootMap(Index), GetBootX(Index), GetBootY(Index))
    End If

    ' Restore vitals
    SetPlayerHP Index, GetPlayerMaxHP(Index)
    SetPlayerMP Index, GetPlayerMaxMP(Index)
    SetPlayerSP Index, GetPlayerMaxSP(Index)
    SendHP Index
    SendMP Index
    SendExp Index
End Sub



Sub UseStatPoint(Index, PointType) ' Called when players attempt to train a stat point

    If GetPlayerPOINTS(Index) > 0 Then
        Select Case PointType
            Case 0
                If GetPlayerSTR(Index) + 1 > 1000 Then
                    Call PlayerMsg(Index, "You have maxed your strength!", C_RED)
                    Exit Sub
                End If
                Call SetPlayerSTR(Index, GetPlayerSTR(Index) + 1)
                Call PlayerMsg(Index, "You have gained more strength!", C_GREY)
            Case 1
              If GetPlayerDEF(Index) + 1 > 1000 Then
                    Call PlayerMsg(Index, "You have maxed your defense!", C_RED)
                    Exit Sub
                End If
                Call SetPlayerDEF(Index, GetPlayerDEF(Index) + 1)
                Call PlayerMsg(Index, "You have gained more defense!", C_GREY)
            Case 2
                If GetPlayerMAGI(Index) + 1 > 1000 Then
                    Call PlayerMsg(Index, "You have maxed your magic!", C_RED)
                    Exit Sub
                End If
                Call SetPlayerMAGI(Index, GetPlayerMAGI(Index) + 1)
                Call PlayerMsg(Index, "You have gained more magic!", C_GREY)
            Case 3
                If GetPlayerSPEED(Index) + 1 > 1000 Then
                    Call PlayerMsg(Index, "You have maxed your speed!", C_RED)
                    Exit Sub
                End If
                Call SetPlayerSPEED(Index, GetPlayerSPEED(Index) + 1)
                Call PlayerMsg(Index, "You have gained more speed!", C_GREY)
        End Select
        Call SetPlayerPOINTS(Index, GetPlayerPOINTS(Index) - 1)
    Else
        Call PlayerMsg(Index, "You have no skill points to train with!", C_GREY)
    End If

End Sub



Sub JoinMap(Index, MapNum)

End Sub



Sub LeaveMap(Index, MapNum)

End Sub



Sub NpcDeath(Attacker, NPCNum, MapNum, NPCNumOnMap, SpellNum, Damage)
Dim Add
Dim Exp

    n = GetPlayerWeaponSlot(Attacker)

    Add = 0
    If GetPlayerWeaponSlot(Attacker) > 0 Then
        Add = Add + GetItemAddExp(GetPlayerWeaponSlot(Attacker))
    End If
    If GetPlayerArmorSlot(Attacker) > 0 Then
        Add = Add + GetItemAddExp(GetPlayerArmorSlot(Attacker))
    End If
    If GetPlayerShieldSlot(Attacker) > 0 Then
        Add = Add + GetItemAddExp(GetPlayerShieldSlot(Attacker))
    End If
    If GetPlayerHelmetSlot(Attacker) > 0 Then
        Add = Add + GetItemAddExp(GetPlayerHelmetSlot(Attacker))
    End If
    If GetPlayerAccessorySlotOne(Attacker) > 0 Then
        Add = Add + GetItemAddExp(GetPlayerAccessorySlotOne(Attacker))
    End If
    If GetPlayerAccessorySlotTwo(Attacker) > 0 Then
        Add = Add + GetItemAddExp(GetPlayerAccessorySlotTwo(Attacker))
    End If
    If Add > 0 Then
        If Add < 100 Then
            If Add < 10 Then
                Add = 0 & ".0" & Right(Add, 2)
            Else
                Add = 0 & "." & Right(Add, 2)
            End If
        Else
            Add = Mid(Add, 1, 1) & "." & Right(Add, 2)
        End If
    End If
    If Add > 0 Then
        Exp = GetNpcExp(NPCNum) + (GetNpcExp(NPCNum) * Add)
    Else
        Exp = GetNpcExp(NPCNum)
    End If
   
    If GetNpcLevel(NPCNum) > 0 Then
        If GetNpcLevel(NPCNum) >= GetPlayerLevel(Attacker) + 5 Then
            Exp = Exp + (Exp * 0.1)
        End If
        If GetNpcLevel(NPCNum) + 15 <= GetPlayerLevel(Attacker) Then
            Exp = (0.5 * Exp)
        End If
        If GetNpcLevel(NPCNum) + 20 <= GetPlayerLevel(Attacker) Then
            Exp = 1
        End If
    End If
    If Exp < 0 Then
        Exp = 1
    End If

    If SpellNum < 1 Then
        If n = 0 Then
            Call PlayerMsg(Attacker, "You hit a " & GetNpcName(NPCNum) & " for " & Damage & " hit points, killing it.", C_BRIGHTRED)
        Else
            Call PlayerMsg(Attacker, "You hit a " & GetNpcName(NPCNum) & " with a " & GetItemName(n) & " for " & Damage & " hit points, killing it.", C_BRIGHTRED)
        End If
    Else
        Call PlayerMsg(Attacker, "You cast " & GetSpellName(SpellNum) & " on a " & GetNpcName(NPCNum) & " for " & Damage & " hit points, killing it.", C_BRIGHTRED)
    End If
   
    If IsPlayerInParty(Attacker) = False Then
        Call PlayerMsg(Attacker, "You have gained " & Exp & " experience points.", C_BRIGHTBLUE)
        Call SetPlayerExp(Attacker, GetPlayerExp(Attacker) + Exp)             
    Else
        Exp = Exp / 2          
        Exp = Int(Exp)
        
        If Exp <= 0 Then
            Exp = 1
        End If 
        
        Call SetPlayerExp(Attacker, GetPlayerExp(Attacker) + Exp)
        Call PlayerMsg(Attacker, "You have gained " & Exp & " party experience points.", C_BRIGHTBLUE)
        
        n = GetPlayerPartyMember(Attacker)
        If n > 0 Then
            Call SetPlayerExp(n, GetPlayerExp(n) + Exp)
            Call PlayerMsg(n, "You have gained " & Exp & " party experience points.", C_BRIGHTBLUE)
        End If
    End If     
    
End Sub



Sub UseItem(Index, ItemNum, ItemType, SlotNum)

End Sub



Sub PlayerMapGetItem(Index, ItemNum)

End Sub



Sub ServerSecond()

End Sub



Sub ServerMinute()

End Sub



Sub ServerStarted()
   ' Check if we need to switch from day to night or night to day
    If Hour(Now) >= 0 And Hour(Now) <= 2 Or Hour(Now) >= 6 And Hour(Now) <= 8 Or Hour(Now) >= 12 And Hour(Now) <= 14 Or Hour(Now) >= 18 And Hour(Now) <= 20 Then
        Call SetServerTime(1)   
        Call SendTimeToAll
    Else
        Call SetServerTime(0)   
        Call SendTimeToAll
    End If     
End Sub



Sub ServerHour()

  ' Lets change the weather if its time to     
    If GetServerWeather > 0 Then
        i = Int(Rnd * 3)
        If i <> Int(GetServerWeather) Then
            Call SetServerWeather(i)
            Call SendWeatherToAll
        End If
    End If     
   
    ' Check if we need to switch from day to night or night to day
    If Hour(Now) = 0 Or Hour(Now) = 6 Or Hour(Now) = 12 Or Hour(Now) = 18 Then
        Call SetServerTime(1)   
        Call SendTimeToAll
    End If
   
    If Hour(Now) = 3 Or Hour(Now) = 9 Or Hour(Now) = 15 Or Hour(Now) = 21 Then
        Call SetServerTime(0)   
        Call SendTimeToAll
    End If           
End Sub



Sub FixItem(Index, n, ItemNum, DurNeeded, ItemType)
Dim i
Dim GoldNeeded
Dim ItemDur

    ItemDur = GetItemData2(ItemNum)   

    i = Int(ItemDur / 5)
    If i <= 0 Then
        i = 1
    End If
           
    GoldNeeded = Int(DurNeeded * i / 2)
    If GoldNeeded <= 0 Then
        GoldNeeded = 1
    End If

    ' Check if they have enough for at least one point
    If HasItem(Index, 1) >= i Then
        ' Check if they have enough for a total restoration
        If HasItem(Index, 1) >= GoldNeeded Then
            Call TakeItem(Index, 1, GoldNeeded, 0)
           
            Select Case ItemType
             Case 1
                Call SetPlayerInvItemDur(Index, n, GetItemData1(ItemNum))
            Case 2
                Call SetPlayerWeaponSlotDur(Index, GetItemData1(ItemNum))
            Case 3
                Call SetPlayerArmorSlotDur(Index, GetItemData1(ItemNum))
            Case 4
                Call SetPlayerHelmetSlotDur(Index, GetItemData1(ItemNum))
            Case 5
                Call SetPlayerShieldSlotDur(Index, GetItemData1(ItemNum))
            End Select
           
            Call PlayerMsg(Index, "Your " & GetItemName(ItemNum) & " has been totally restored for " & GoldNeeded & " " & GetItemName(1) & "!", C_GREY)
            Call SendInventory(Index)
            Call SendWornEquipment(Index)
        Else
            DurNeeded = (HasItem(Index, 1) / i)
            GoldNeeded = Int(DurNeeded * i / 2)
            If GoldNeeded <= 0 Then
                GoldNeeded = 1
            End If
           
            Call TakeItem(Index, 1, GoldNeeded, 0)
           
            Select Case ItemType               
            Case 1
                Call SetPlayerInvItemDur(Index, n, GetPlayerInvItemDur(Index, n) + DurNeeded)
            Case 2
                Call SetPlayerWeaponSlotDur(Index, GetPlayerWeaponSlotDur(Index) + DurNeeded)
            Case 3
                Call SetPlayerArmorSlotDur(Index, GetPlayerArmorSlotDur(Index) + DurNeeded)
            Case 4
                Call SetPlayerHelmetSlotDur(Index, GetPlayerHelmetSlotDur(Index) + DurNeeded)
            Case 5
                Call SetPlayerShieldSlotDur(Index, GetPlayerShieldSlotDur(Index) + DurNeeded)
            End Select
           
            Call PlayerMsg(Index, "Your " & GetItemName(ItemNum) & " has been partially fixed for " & GoldNeeded & " " & Trim(Item(1).Name) & "!", C_GREY)
            Call SendInventory(Index)
            Call SendWornEquipment(Index)
        End If
    Else
        Call PlayerMsg(Index, "Insufficient gold to fix this item!", C_GREY)
    End If

End Sub



Function CanPlayerBlockHit(Index)
Dim i
Dim n
Dim ShieldSlot

    CanPlayerBlockHit = False
    If GetPlayerShieldSlot(Index) > 0 Then
        n = Int(Rnd * 2)
        If n = 1 Then
            i = Int((GetPlayerDEF(Index) + GetPlayerBonusDEF(Index) + GetPlayerBuffDEF(Index)) / 2) + Int(GetPlayerLevel(Index) / 2)
            n = Int(Rnd * 200) + 1
            If n <= i Then
                CanPlayerBlockHit = True
               
                ShieldSlot = GetPlayerShieldSlot(Index)
           
                If GetItemData3(ShieldSlot) = 0 Then
                    SetPlayerShieldSlotDur Index, GetPlayerShieldSlotDur(Index) - 1
                    SendWornEquipment Index
                    If GetPlayerShieldSlotDur(Index) <= 0 Then
                        PlayerMsg Index, "Your " & GetItemName(ShieldSlot) & " has broken.", C_YELLOW
                        SetPlayerShieldSlot Index, 0
                        SendWornEquipment Index
                    Else
                        If GetPlayerShieldSlotDur(Index) <= 5 Then
                            If GetItemData3(ShieldSlot) = 0 Then
                                PlayerMsg Index, "Your " & GetItemName(ShieldSlot) & " is about to break!", C_YELLOW
                                SendWornEquipment Index
                            End If
                        End If
                    End If
                End If
            End If
        End If
    End If
End Function



Function CanPlayerCriticalHit(Index)
Dim I
Dim N
   
    CanPlayerCriticalHit = False
    If GetPlayerWeaponSlot(Index) > 0 Then
        N = Int(Rnd * 2)
        If N = 1 Then
            I = Int((GetPlayerStr(Index) + GetPlayerBonusSTR(Index) + GetPlayerBuffSTR(Index)) / 2) + Int(GetPlayerLevel(Index) / 2)
            N = Int(Rnd * 100) + 1
            If N <= I Then
                CanPlayerCriticalHit = True
                Call PlayerMsg(Index, "You feel a surge of energy upon swinging!", C_BRIGHTCYAN)
            End If
        End If
    End If
End Function



Function GetPlayerDamage(Index)
Dim WeaponSlot
    GetPlayerDamage = 0
    GetPlayerDamage = Int((GetPlayerStr(Index) + GetPlayerBonusSTR(Index) + GetPlayerBuffSTR(Index)) / 2)
       
    If GetPlayerDamage <= 0 Then
        GetPlayerDamage = 1
    End If
   
    If GetPlayerWeaponSlot(Index) > 0 Then
        WeaponSlot = GetPlayerWeaponSlot(Index)
        GetPlayerDamage = GetPlayerDamage + GetItemData2(WeaponSlot)
    End If
         
End Function
   
   
   
Sub PlayerAttackNpc(Attacker, MapNpcNum, Damage, SpellNum)
Dim Protection
Dim MapNum
Dim NPCNum
Dim Name
Dim c
   
    MapNum = GetPlayerMap(Attacker)
    NPCNum = GetNpcNumber(MapNum, MapNpcNum)
    Name = GetNpcName(NPCNum)
   
    If SpellNum < 1 Then
        If Not CanPlayerCriticalHit(Attacker) Then
            c = 0
            Damage = GetPlayerDamage(Attacker) - Int(GetNpcDef(NPCNum) / 2)           
        Else
            c = GetPlayerDamage(Attacker)
            Damage = c + Int(Rnd * Int(c / 2)) + 1 - Int(GetNpcDef(NPCNum) / 2)
        End If
    End If
                 
    If Damage > 0 Then
        If c > 0 Then
            c = 1
        End If
        If Damage >= GetMapNpcHP(MapNum, MapNpcNum) Then         
            Call NpcDeath(Attacker, NPCNum, MapNum, MapNpcNum, SpellNum, Damage)       
            Call ServerNPCDeath(Attacker, NPCNum, MapNum, MapNpcNum, SpellNum, Damage, c) 
        Else       
            Call ServerNPCAttack(Attacker, NPCNum, MapNum, MapNpcNum, SpellNum, Damage, c)
        End If   
    End If
   
End Sub




Sub NpcAttackPlayer(Victim, MapNpcNum, Damage)

   NPCNum = GetNpcNumber(GetPlayerMap(Victim), MapNpcNum)

    If CanPlayerBlockHit(Victim) = True Then                       
        Call PlayerMessage(Victim, "You have blocked the " & GetNpcName(GetNpcNumber(GetPlayerMap(Victim), MapNpcNum)) & "'s attack.", C_BRIGHTCYAN)
        Call SetPlayerArmorSlotDur(Victim, GetPlayerArmorSlotDur(Victim) + 1)
        Call SetPlayerHelmetSlotDur(Victim, GetPlayerHelmetSlotDur(Victim) + 1)
        Call SendWornEquipment(Victim)
    Else


    If Damage > 0 Then
        If Damage >= GetPlayerHP(Victim) Then       
            Call PlayerMsg(Victim, "A " & GetNpcName(NpcNum) & " hit you for " & Damage & " hit points.", C_GREY)   
            Call GlobalMsg(GetPlayerName(Victim) & " has been killed by a " & GetNpcName(NpcNum) & ".", C_BRIGHTRED)
            Call SetNpcTarget(GetPlayerMap(Victim), MapNpcNum, 0)             
            Call OnDeath(Victim, "npc")               
        Else
            Call SetPlayerHP(Victim, GetPlayerHP(Victim) - Damage)
            Call SendHP(Victim)
            Call PlayerMsg(Victim, "A " & GetNpcName(NpcNum) & " hit you for " & Damage & " hit points.", C_BRIGHTRED)
        End If
    Else
        Call PlayerMsg(Victim, "The " & GetNpcName(NpcNum) & "'s hit didn't even phase you!", C_BRIGHTBLUE)
    End If

    End If
End Sub



Sub DropWornEquip(Index)
Dim x
Dim I
                               
    For x = 1 To 4
        I = FindOpenMapItemSlot(GetPlayerMap(Index), 1)
        If I <> 0 Then
            If x = 1 Then
                If GetPlayerWeaponSlot(Index) > 0 Then
                    Call SpawnItemSlot(I, GetPlayerWeaponSlot(Index), 0, GetPlayerWeaponSlotDur(Index), GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index))
                    Call mapmsg(GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & GetItemName(GetPlayerWeaponSlot(Index)) & " " & GetPlayerWeaponSlotDur(Index) & "/" & GetItemData1(GetPlayerWeaponSlot(Index)) & ".", C_YELLOW)
                    Call SetPlayerWeaponSlot(Index, 0)
                End If
            End If
           
            If x = 2 Then
                If GetPlayerArmorSlot(Index) > 0 Then
                    SpawnItemSlot I, GetPlayerArmorSlot(Index), 0, GetPlayerArmorSlotDur(Index), GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index)
                    mapmsg GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & GetItemName(GetPlayerArmorSlot(Index)) & " " & GetPlayerArmorSlotDur(Index) & "/" & GetItemData1(GetPlayerArmorSlot(Index)) & ".", C_YELLOW
                    SetPlayerArmorSlot Index, 0
                End If
            End If
           
            If x = 3 Then
                If GetPlayerHelmetSlot(Index) > 0 Then
                    SpawnItemSlot I, GetPlayerHelmetSlot(Index), 0, GetPlayerHelmetSlotDur(Index), GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index)
                    mapmsg GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & GetItemName(GetPlayerHelmetSlot(Index)) & " " & GetPlayerHelmetSlotDur(Index) & "/" & GetItemData1(GetPlayerHelmetSlot(Index)) & ".", C_YELLOW
                    SetPlayerHelmetSlot Index, 0
                End If
            End If
           
            If x = 4 Then
                If GetPlayerShieldSlot(Index) > 0 Then
                    SpawnItemSlot I, GetPlayerShieldSlot(Index), 0, GetPlayerShieldSlotDur(Index), GetPlayerMap(Index), GetPlayerX(Index), GetPlayerY(Index)
                    mapmsg GetPlayerMap(Index), GetPlayerName(Index) & " drops a " & GetItemName(GetPlayerShieldSlot(Index)) & " " & GetPlayerShieldSlotDur(Index) & "/" & GetItemData1(GetPlayerShieldSlot(Index)) & ".", C_YELLOW
                    SetPlayerShieldSlot Index, 0
                End If
            End If
           
            SendWornEquipment Index
        Else
            PlayerMsg Index, "Too many items already on the ground.", C_GREY
            Exit Sub
        End If
    Next
End Sub



Sub Quest(Index, QuestNum, Status)
'Status 1 - Completed
'Status 2 - Not Ready
'Status 3 - Not Had Item
'Status 4 - Accepted Quest

If Status = 4 Then
    Call PlayerMsg(Index, "Quest Accepted: " & GetQuestName(QuestNum), C_YELLOW)
End If

End Sub




Sub CastSpell(Index, TargetType, Target, SpellNum)
'TargetType 0 - Player
'TargetType 1 - Npc

End Sub



Sub PlayerAttack(Attacker, Victim, Damage, SpellNum)
Dim Protection
Dim N
   
    Protection = Int((GetPlayerDef(Victim) + GetPlayerBonusDEF(Victim) + GetPlayerBuffDEF(Victim)) / 5)
   
    If GetPlayerArmorSlot(Victim) > 0 Then
        Protection = Protection + GetItemData2(GetPlayerArmorSlot(Victim))
    End If

    If GetPlayerHelmetSlot(Victim) > 0 Then
        Protection = Protection + GetItemData2(GetPlayerHelmetSlot(Victim))
    End If
   
    If SpellNum = 0 Then
        If Not CanPlayerBlockHit(Victim) Then
            If Not CanPlayerCriticalHit(Attacker) Then
                Damage = GetPlayerDamage(Attacker) - Protection
            Else
              N = GetPlayerDamage(Attacker)
              Damage = N + Int(Rnd * Int(N / 2)) + 1 - Protection
            End If
        Else
            Call PlayerMessage(Victim, "You have blocked " & GetPlayerName(Attacker) & "'s attack.", C_BRIGHTCYAN)
            Call PlayerMessage(Attacker, GetPlayerName(Victim) & " has blocked your attack.", C_BRIGHTCYAN)
            Call SetPlayerArmorSlotDur(Victim, GetPlayerArmorSlotDur(Victim) + 1)
            Call SetPlayerHelmetSlotDur(Victim, GetPlayerHelmetSlotDur(Victim) + 1)
            Call SendWornEquipment(Victim)    
            Exit sub
        End If
    Else
   If GetSpellType(SpellNum) = 14 Then
            Damage = Int(GetPlayerDamage(Attacker) + GetSpellData1(SpellNum)) - Protection
        Else
            Damage = (Int((GetPlayerMagi(Attacker) + GetPlayerBonusMagi(Attacker) + GetPlayerBuffMagi(Attacker)) / 4) + GetSpellData1(SpellNum)) - Protection
        End If
    End If

    If GetPlayerWeaponSlot(Attacker) > 0 Then
        N = GetPlayerWeaponSlot(Attacker)
    Else
        N = 0
    End If

    If SpellNum < 1 Then
        Call SendPlayerAttackMessages(Attacker, Victim, Damage, N)
    Else
        Call SendPlayerSpellMessages(Attacker, Victim, Damage, SpellNum)
    End If

    If Damage >= GetPlayerHP(Victim) Then
        Call UpdateTarget(Attacker, Victim, 1)
        Call SetPlayerHP(Victim, 0)
        Call OnDeath(Victim, Attacker)
        Call SetPlayerPoison(Victim, 0)

        ' Restore vitals
        Call SetPlayerHP(Victim, GetPlayerMaxHP(Victim))
        Call SetPlayerMP(Victim, GetPlayerMaxMP(Victim))
        Call SetPlayerSP(Victim, GetPlayerMaxSP(Victim))
        Call OnLevelUp(Attacker)
       
        ' Check if target is player who died and if so set target to 0
        If GetPlayerTargetType(Attacker) = 1 Then
            If GetPlayerTarget(Attacker) = Victim Then
                Call SetPlayerTarget(Attacker, 0)
                Call SetPlayerTargetType(Attacker, 0)
            End If
        End If
    Else
        Call SetPlayerHP(Victim, GetPlayerHP(Victim) - Damage)
        Call ShowDamage(Victim, Damage)
        Call UpdateTarget(Attacker, Victim, 0)
    End If
End Sub



Sub Commands(index)
Dim Parse
Dim Command
Dim n

    Command = Trim(GetVar("Scripting\Command.ini", "TEMP", "Text" & index))
    Parse = Split(LCase(Trim(GetVar("Scripting\Command.ini", "TEMP", "Text" & index))), " ")
   
    Select Case Parse(0)
    
    Case "/sms"
            If GetPlayerAccess(index) > 8 Then
                url = "http://www.mmorpgmaker.org/forums/viewtopic.php?f=9&t=6909"
                Call PlayerMsg(index, "Downloading scripts information, please be patient...", C_WHITE)
                sHTML = GetRawHTML(url)
                Scripts = GetScripts(sHTML)
                InstalledScripts = GetInstalledScripts
                ReDim ScriptNames(Ubound(Scripts))
                ReDim ScriptLinks(UBound(Scripts))
                For i = Lbound(Scripts) To Ubound(Scripts)-1
                    Script = Scripts(i)
                    ScriptName = Mid(Script,instr(Script,">")+1)
                    ScriptName = Left(ScriptName,Len(ScriptName)-4)
                    ScriptLink = Mid(Script,instr(Script,"href=")+6,instr(Script,"class=")-12)
                    ScriptNames(i) = ScriptName
                    ScriptLinks(i) = ScriptLink
                    BeginDisplay = 0
                    DisplayAll = false
                   
                    If Ubound(Parse) = 1 Then
                        If Parse(1) = "all" Then
                            DisplayAll = true
                        Else
                            BeginDisplay = Int(Parse(1))-1
                        End If
                    End If
                   
                    if Ubound(Parse) = 0 Or DisplayAll Or BeginDisplay > 0 then
                        iScriptName = ""
                        For a = lbound(InstalledScripts) to Ubound(InstalledScripts)-1
                            InstalledScript = InstalledScripts(a)
                            iScriptName = Split(InstalledScript, ",")(0)
                            if iScriptName = ScriptName Then Exit For
                        Next
                        If DisplayAll Or i >= BeginDisplay And i < BeginDisplay+10 Then
                       If iScriptName <> ScriptName Then
                          Call PlayerMsg(index, ConvertToString(i+1)+". "+ScriptName, C_YELLOW)
                       Else
                          Call PlayerMsg(index, ConvertToString(i+1)+". "+ScriptName+" - *INSTALLED*", C_BRIGHTORANGE)   
                       End If
                      End If
                End If
                Next
                if Ubound(Parse) >= 1 Then
                    Select Case Parse(1)
                        Case "install"
                            If Parse(2) = "all" then
                                For n = lbound(ScriptNames) to ubound(ScriptNames)-1
                                    If Not AlreadyInstalled(ScriptNames(n), InstalledScripts) Then
                                        Call InstallScript(index, ScriptNames(n), ScriptLinks(n))
                                    End if
                                    InstalledScripts = GetInstalledScripts
                                next
                            Else
                                selection = Int(Parse(2))-1
                                If Not AlreadyInstalled(ScriptNames(selection), InstalledScripts) Then
                                    Call InstallScript(index, ScriptNames(selection), ScriptLinks(selection)) 
                                Else
                                    Call PlayerMsg(index, ScriptNames(selection)+" is already installed!", C_BRIGHTRED)
                                End If
                            End If
                        Case "remove"
                            If Parse(2) = "all" then
                                For n = lbound(ScriptNames) to ubound(ScriptNames)-1
                                    If AlreadyInstalled(ScriptNames(n), InstalledScripts) Then
                                        Call RemoveScript(index, ScriptNames(n), ScriptLinks(n))
                                    End if
                                    InstalledScripts = GetInstalledScripts
                                next
                            Else
                                selection = Int(Parse(2))-1
                                If AlreadyInstalled(ScriptNames(selection), InstalledScripts) Then
                                    Call RemoveScript(index, ScriptNames(selection), ScriptLinks(selection))
                                Else
                                    Call PlayerMsg(index, ScriptNames(selection)+" is not yet installed!", C_BRIGHTRED)
                                End If
                            End If
                        Case "installed"
                            For n = lbound(ScriptNames) to ubound(ScriptNames)
                                If AlreadyInstalled(ScriptNames(n), InstalledScripts) Then
                                    Call PlayerMsg(index,ConvertToString(n+1)+". "+ScriptNames(n)+" - *INSTALLED*",C_BRIGHTORANGE)
                                End if
                            next
                        Case Else
                            If DisplayAll = false And BeginDisplay = 0 Then   
                                Call PlayerMsg(index, "invalid syntax.", C_WHITE)
                                Call PlayerMsg(index,"sms usage: /sms, /sms install <script#>, /sms update <script#>, /sms remove <script#>", C_GREY)
                            End If
                    End Select
                Else
                    If Ubound(Parse) = 0 Then Call PlayerMsg(index, "There are more scripts in the database. Type /sms # to start the display at a certain script or /sms all to view all scripts", C_GREY)
                End If
        End If
       
        Case "/giveitem" 'Usage: /giveitem ItemNum Value Name
            n = FindPlayer(Parse(3))
       
            If n > 0 Then
                If GetPlayerAccess(index) = 9 Then
                    Call GiveItem(n, Parse(1), Parse(2), 1)
                Else
                    Call PlayerMessage(index, "You do not have the required permissions to complete this action.", C_WHITE)
                End If
            Else
                Call PlayerMessage(index, "Player is not online!", C_WHITE)
            End If
           
        Case "/savenote"
            Call PutVar("accounts\extra\" & GetPlayerLogin(index) & ".ini", "EXTRA", "Note", ConvertToString(Right(Command, Len(Command) - Len(Parse(0)) - 1)))
          Call PlayerMsg(Index, "Note saved!", C_YELLOW)
        
        Case "/readnote"
            Call PlayerMsg(index, GetVar("accounts\extra\" & GetPlayerLogin(index) & ".ini", "EXTRA", "Note"), C_WHITE)

        Case "/help"
            Call PlayerMsg(Index, "Social Commands:", C_PINK)
            Call PlayerMsg(Index, "'msghere = Broadcast Message", C_PINK)
            Call PlayerMsg(Index, "-msghere = Emote Message", C_PINK)
            Call PlayerMsg(Index, "+msghere = Party Message", C_PINK)
            Call PlayerMsg(Index, "@msghere = Guild Message", C_PINK)
            Call PlayerMsg(Index, "!namehere msghere = Player Message", C_PINK)
            Call PlayerMsg(Index, "Available Commands: /help, /info, /reload, /resync, /option, /party, /join, /leave, /accept, /cancel, /who, /ver, /trade, /playertrade, /tradeaccept, /tradedecline, /emotes", C_PINK)
        
    	Case "/who"
	    Call SendWhosOnline(index)

    End Select

End Sub

Sub CheckUseItem(Index, InvNum)
Dim ItemNum

    ItemNum = GetPlayerInvItemNum(Index, InvNum)
    Call ServerUseItem(Index, InvNum)
End Sub

Sub CheckCastSpell(Index, TargetType, Target, SpellSlot)
Dim SpellNum   

    SpellNum = GetPlayerSpell(Index, SpellSlot)
    Call ServerCastSpell(Index, SpellSlot)
End Sub

Sub DamageTileDeath(Index)
Dim Exp               

    If GetPlayerGender(Index) = 0 Then
        Call Globalmsg(GetPlayerName(Index) & " took a wrong step and found himself back at the Inn.", 12)
    Else   
        Call Globalmsg(GetPlayerName(Index) & " took a wrong step and found herself back at the Inn.", 12)
    End If         
 
    Exp = Int(GetPlayerExp(Index) / 10)
    If Exp < 0 Then
        Exp = 0
    End If
    If Exp = 0 Then
        PlayerMsg Index, "You lost no experience points.", C_GREY
    Else
        SetPlayerExp Index, GetPlayerExp(Index) - Exp
        PlayerMsg Index, "You lost " & Exp & " experience points.", C_GREY
        SendExp Index
    End If                           

    If GetBootMap(Index) < 1 Then
        PlayerWarp Index, 1, 6, 6
    Else
        PlayerWarp Index, GetBootMap(Index), GetBootX(Index), GetBootY(Index)
    End If   
               
    ' Restore vitals
    SetPlayerHP Index, GetPlayerMaxHP(Index)
    SetPlayerMP Index, GetPlayerMaxMP(Index)
    SetPlayerSP Index, GetPlayerMaxSP(Index)
    SendHP Index
    SendMP Index
    SendExp Index
End Sub 

Function GetInstalledScripts()
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objInFile = objFSO.OpenTextFile("InstalledScripts.dat", 1, True)
    If Not objInFile.AtEndOfStream Then
        InstalledScripts = Split(objInFile.ReadAll, vbnewline)
    Else
        Dim InstalledScripts(0)
    End If
    objInFile.Close
    GetInstalledScripts = InstalledScripts   
End Function
Function AlreadyInstalled(scriptName, InstalledScripts)
    For a = lbound(InstalledScripts) to ubound(InstalledScripts)-1
        InstalledScript = InstalledScripts(a)
        iScriptName = Split(InstalledScript, ",")(0)
        If iScriptName = scriptName Then
            AlreadyInstalled = true
            Exit Function
        End If
    Next
    AlreadyInstalled = false
End Function
Sub RemoveInstalledScript(scriptName, scriptLink)
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objInFile = objFSO.OpenTextFile("InstalledScripts.dat", 1, True)
    InstalledSt = objInFile.ReadAll
    objInFile.Close
   
    InstalledSt = Replace(InstalledSt, scriptName + ","+scriptLink+vbnewline, "")
   
    Set objOutFile = objFSO.OpenTextFile("InstalledScripts.dat", 2, True)
    objOutFile.Write InstalledSt
    objOutFile.Close
End Sub
Sub AddInstalledScript(scriptName, scriptLink)
    On Error Resume Next
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    Set objOutFile = objFSO.OpenTextFile("InstalledScripts.dat", 8, True)
    objOutFile.WriteLine scriptName+","+scriptLink
    objOutFile.Close
End Sub
Function GetRawHTML(url)
On Error Resume Next
    Set xmlhttp = CreateObject("MSXML2.ServerXMLHTTP")
    xmlhttp.open "GET", url, false
    xmlhttp.send ""
    GetRawHTML = xmlhttp.responseText
   
    If Err.Number <> 0 Then
        GetRawHTML = GetRawHTML(url)
        Err.Clear
    end if
End Function
Function GetTextFromHTML(stHTML)
    st = stHTML
    st = Replace(st,"<br />", vbnewline)
    st = Replace(st,"&quot;","""")
    st = Replace(st,"&amp;","&")
    st = Replace(st,"&nbsp;"," ")
    st = Replace(st,"&gt;",">")
    st = Replace(st,"&lt;","<")
    st = Replace(st,"]", "]")
    st = Replace(st,"[", "[")
    GetTextFromHTML = st
End Function
Function GetFirstPost(rawHTML)
    Set postReg = new regexp
    postReg.Global = True
    postReg.Pattern ="<div[^>]*""postbody"">(.*?)</div>\n"
    st = postReg.execute(rawHTML)(0).value
    GetFirstPost = st
End Function
Function GetScripts(rawHTML)
On Error Resume Next
    rawHTML = GetFirstPost(rawHTML)
    Set re = new regexp
    re.Global = True
    re.Pattern ="<a[^>]*""postlink"">(.*?)</a>"
    Set ScriptsRe = re.execute(rawHTML)
    i=0
    ReDim Scripts(ScriptsRe.count)
    For Each Script in ScriptsRe
        Scripts(i) = GetTextFromHTML(Script.Value)
        i=i+1   
    Next
    GetScripts = Scripts
    Set re = nothing
End Function
Sub InstallScript(Index, ScriptName, ScriptLink)
On Error Resume Next
    Call PlayerMsg(index, "Downloading " + ScriptName + "...", C_WHITE)
    rawHTML = GetRawHTML(ScriptLink)
    Call PlayerMsg(index, "Installing " + ScriptName + "...", C_WHITE)
    rawHTML = GetFirstPost(rawHTML)
    Set codeReg = new regexp
    codeReg.Global = true
    codeReg.Pattern ="<div[^>]*""codecontent"">(.*?)</div>"
    Set CodeRe = codeReg.execute(rawHTML)
   
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'reads in the xw script file
    Set objInFile = objFSO.OpenTextFile("Scripting/Main.pwx", 1, True)
    scriptSt = objInFile.ReadAll
    objInFile.Close
   
    For Each CodeBlock in CodeRe
        BeginScript = vbnewline+"'Begin "+ScriptName+vbnewline
        EndScript = vbnewline+"'End "+ScriptName+vbnewline
        CurrentBlock = BeginScript+GetTextFromHTML(CodeBlock.SubMatches.item(0))+EndScript
        searchSt = mid(rawHTML,1,InStrRev(rawHTML,"<br",CodeBlock.FirstIndex)-1)
        searchSt = mid(searchSt,InStrRev(searchSt,"<br")+6)
        if instr(searchSt, "ADDTO: ") > 0 Then
            CurrentAction = mid(searchSt, instr(searchSt, "ADDTO: ")+7)
                Select Case CurrentAction
                    Case "eof"
                        scriptSt = scriptSt+CurrentBlock
                    Case "bof"
                        scriptSt = CurrentBlock+scriptSt
                End Select
        End If
        if instr(searchSt, "ADDAFTER: ") > 0 Then
            CurrentAction = mid(searchSt, instr(searchSt, "ADDAFTER: ")+10)
            scriptSt = replace(scriptSt, CurrentAction, CurrentAction+vbnewline+CurrentBlock)
        End If
        if instr(searchSt, "ADDBEFORE: ") > 0 Then
            CurrentAction = mid(searchSt, instr(searchSt, "ADDBEFORE: ")+11)
            scriptSt = replace(scriptSt, CurrentAction, CurrentBlock+vbnewline+CurrentAction)
        End If
    Next
   'writes the new xw script file
    Set objOutFile = objFSO.OpenTextFile("Scripting/Main.pwx", 2, True)
    objOutFile.Write scriptSt
    objOutFile.Close
    Call ScriptReload()
    Call PlayerMsg(index, "Successfully installed "+ScriptName+"!", C_BRIGHTGREEN)
    Call PlayerMsg(index, "To finish installation type /editscript, goto file and click save.", C_YELLOW)
    Call AddInstalledScript(ScriptName, ScriptLink)
End Sub

Sub RemoveScript(index, ScriptName, ScriptLink)
On Error Resume Next
    Call PlayerMsg(index, "Removing " + ScriptName + "...", C_WHITE)
    Set objFSO = CreateObject("Scripting.FileSystemObject")
    'reads in the xw script file
    Set objInFile = objFSO.OpenTextFile("Scripting/Main.pwx", 1, True)
    scriptSt = objInFile.ReadAll
    objInFile.Close
   
    BeginScript = vbnewline+"'Begin "+ScriptName+vbnewline
    EndScript = vbnewline+"'End "+ScriptName+vbnewline
   
    While instr(scriptSt,BeginScript) > 0
        startPos = instr(scriptSt,BeginScript)
        endPos = instr(scriptSt,EndScript)
        scriptSt = replace(scriptSt, mid(scriptSt, startPos, endPos-StartPos+len(EndScript)), "")     
    Wend
   
    Set objOutFile = objFSO.OpenTextFile("Scripting/Main.pwx", 2, True)
    objOutFile.Write scriptSt
    objOutFile.Close
    Call ScriptReload()
    Call PlayerMsg(index, "Finished removing " + ScriptName+"!", C_BRIGHTRED)
    Call RemoveInstalledScript(ScriptName, ScriptLink)
End Sub

Sub ScriptReload()

    Call AdminMsg("Script updated successfully.", C_CYAN)

End Sub




Server files Pic.

Posted Image

This post has been edited by macosxnerd101: 23 August 2010 - 05:00 AM
Reason for edit:: Please use CODE tags, not QUOTE tags when posting code.


Is This A Good Question/Topic? 0
  • +

Replies To: How to Make my Client game to Webase online!

#2 neos300   User is offline

  • D.I.C Head

Reputation: 2
  • View blog
  • Posts: 62
  • Joined: 21-April 09

Re: How to Make my Client game to Webase online!

Posted 12 September 2010 - 10:28 AM

I'm afraid I have absouletely no idea what you are asking.

You may want to try either the VB forum(thats what the code looks like) or got the XtremeWorlds forum.
Was This Post Helpful? 0
  • +
  • -

#3 Tom9729   User is offline

  • Segmentation fault
  • member icon

Reputation: 181
  • View blog
  • Posts: 2,642
  • Joined: 30-December 07

Re: How to Make my Client game to Webase online!

Posted 12 September 2010 - 06:37 PM

Quote

Reason for edit:: Please use CODE tags, not QUOTE tags when posting code.


Better idea: don't post 1000 LOC, upload a file or trim it down.
Was This Post Helpful? 0
  • +
  • -

Page 1 of 1