Jump to content
Search In
  • More options...
Find results that contain...
Find results in...

Valentine90

Members
  • Posts

    115
  • Joined

  • Last visited

    Never

Posts posted by Valentine90

  1. I managed to update, the problem is that when I try to client enter the appears:

    > Unable to intialize DirectX8\. You may be missing dx8vb.dll or have incompatible hardware to use Directx8.

    Again I repeat that I work with engines in that using vb6 directx 8, all dlls are properly installed and registered, you need to redo the engine initialization, I advise the use initialization of crystal shire. The crystal shire, mirage creation, essence engine… works perfectly here.

    I tried putting Device 1,2,3

    It's weird because my computer works with Device **software**

    ```
    D3DCREATE_SOFTWARE_VERTEXPROCESSING
    ```
  2. **Sorry my english**

    Hello friends, I think we all know how a system of rank, something essential for a true MMORPG, know that there are some systems rank around and perhaps many of you already have, but this is a simple and complete do- so, system fully tested and approved.

    **Open Client**

    **1 -** In frmMain, create a Picturebox called **picRank**

    ![](http://img824.imageshack.us/img824/4513/57744486.png)

    **2 -** Within the picRank create a ListBox called **lstRank**

    ![](http://img811.imageshack.us/img811/9121/60970805.png)

    **3 -** Create a button called **cmdRefresh**

    ![](http://img543.imageshack.us/img543/7374/54104775.png)

    **Obs.:** It should stay like this:

    ![](http://img5.imageshack.us/img5/3637/imgahp.png)

    **4 -** Select the Option Visible False in the picRank

    ![](http://img442.imageshack.us/img442/3285/69569137.png)

    **5 -** In same button **cmdRefresh**, double-click and replace:

    ```
    Private Sub cmdRefresh_Click()

    End Sub
    ```
    **6 -** By:

    ```
    Private Sub cmdRefresh_Click()

    ' If debug mode, handle error then exit out

    If Options.Debug = 1 Then On Error GoTo errorhandler

    SendRequestRank

    ' Error handler

    Exit Sub

    errorhandler:

    HandleError "cmdRefresh_Click", "frmMain", Err.Number, Err.Description, Err.Source, Err.HelpContext

    Err.Clear

    Exit Sub

    End Sub
    ```
    **7 -** In **modConstants**, search for:

    ```
    Public Const MAX_PARTY_MEMBERS As Long = 4
    ```
    **8 -** Below add:

    ```
    Public Const MAX_RANK As Long = 10
    ```
    **9 -** At the end of **modClientTCP**, add:

    ```
    Public Sub SendRequestRank()

    Dim Buffer As clsBuffer

    ' If debug mode, handle error then exit out

    If Options.Debug = 1 Then On Error GoTo errorhandler

    Set Buffer = New clsBuffer

    Buffer.WriteLong CRequestRank

    SendData Buffer.ToArray()

    Set Buffer = Nothing

    ' Error handler

    Exit Sub

    errorhandler:

    HandleError "SendRequestRank", "modClientTCP", Err.Number, Err.Description, Err.Source, Err.HelpContext

    Err.Clear

    Exit Sub

    End Sub
    ```
    **10 -** In **modEnumerations**, search for:

    ```
    ' Make sure CMSG_COUNT is below everything else
    ```
    **11 -** Above this line and below of:

    ```
    CPartyLeave
    ```
    **12 -** Add:

    ```
    CRequestRank
    ```
    **Obs.:**It should stay like this:

    ![](http://img826.imageshack.us/img826/4250/27115231.png)

    **13 -** Still in **modEnumerations**, search for:

    ```
    ' Make sure SMSG_COUNT is below everything else
    ```
    **14 -** Above this line and below of:

    ```
    SPartyVitals
    ```
    **15 -** Add:

    ```
    SRankUpdate
    ```
    **16 -** In **modHandleData**, search for:

    ```
    HandleDataSub(SPartyVitals) = GetAddress(AddressOf HandlePartyVitals)
    ```
    **17 -** Below add:

    ```
    HandleDataSub(SRankUpdate) = GetAddress(AddressOf HandleRankUpdate)
    ```
    **18 -** At the end of **modHandleData**, add:

    ```
    Private Sub HandleRankUpdate(ByVal Index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

    Dim Buffer As clsBuffer, i As Byte

    ' If debug mode, handle error then exit out

    If Options.Debug = 1 Then On Error GoTo errorhandler

    Set Buffer = New clsBuffer

    Buffer.WriteBytes Data()

    frmMain.lstRank.Clear

    For i = 1 To MAX_RANK

    frmMain.lstRank.AddItem i & ":Level: " & Buffer.ReadLong & ", Name: " & Trim$(Buffer.ReadString)

    Next i

    Set Buffer = Nothing

    ' Error handler

    Exit Sub

    errorhandler:

    HandleError "HandleRankUpdate", "modHandleData", Err.Number, Err.Description, Err.Source, Err.HelpContext

    Err.Clear

    Exit Sub

    End Sub
    ```
    **19 -** In **modInput**, search for:

    ```
    ' Whos Online

    Case "/who"

    SendWhosOnline
    ```
    **20 -** Below add:

    ```
    ' Request Rank

    Case "/rank"

    SendRequestRank

    frmMain.picRank.Visible = Not frmMain.picRank.Visible
    ```
    **21 -** In **modGeneral**, search for:

    ```
    frmMain.picParty.Visible = False
    ```
    **22 -** Below add:

    ```
    frmMain.picRank.Visible = False
    ```

    **Open Server**

    **1 -** In **modConstants**, search for:

    ```
    Public Const MAX_PARTY_MEMBERS As Long = 4
    ```
    **2 -** Below add:

    ```
    Public Const MAX_RANK As Long = 10
    ```
    **3 -** In **modEnumerations**,search for:

    ```
    ' Make sure SMSG_COUNT is below everything else
    ```
    **4 -** Above this line and below of:

    ```
    SPartyVitals
    ```
    **5 -** Add:

    ```
    SRankUpdate
    ```
    **6 -** Still in **modEnumerations**, search for:

    ```
    ' Make sure CMSG_COUNT is below everything else
    ```
    **7 -** Above this line and below of:

    ```
    CPartyLeave
    ```
    **8 -** Add:

    ```
    CRequestRank
    ```
    **9 -** In **modHandleData**, search for:

    ```
    HandleDataSub(CPartyLeave) = GetAddress(AddressOf HandlePartyLeave)
    ```
    **10** - Below Add:

    ```
    HandleDataSub(CRequestRank) = GetAddress(AddressOf HandleRequestRank)
    ```
    **11 -** At the end of **modHandleData**, add:

    ```
    Sub HandleRequestRank(ByVal index As Long, ByRef Data() As Byte, ByVal StartAddr As Long, ByVal ExtraVar As Long)

    SendRankUpdate index

    End Sub
    ```
    **12 -** At the end of **modServerTCP**, add:

    ```
    Sub SendRankUpdate(ByVal index As Long)

    Dim i As Byte

    Dim Buffer As clsBuffer

    Set Buffer = New clsBuffer

    Buffer.WriteLong SRankUpdate

    For i = 1 To MAX_RANK

    Buffer.WriteLong Rank(i).Level

    Buffer.WriteString Trim$(Rank(i).Name)

    Next i

    SendDataTo index, Buffer.ToArray()

    Set Buffer = Nothing

    End Sub
    ```
    **13 -** In **modPlayer**, search for

    ```
    Sub CheckPlayerLevelUp(ByVal index As Long)
    ```
    **14 -** Beneath of:

    ```
    Dim level_count As Long
    ```
    **15 -** Add:

    ```
    Dim RankPos As Byte
    ```
    **16 -** Beneath of:

    ```
    SendPlayerData index
    ```
    **17 -** Add:

    ```
    ' check rank

    RankPos = CheckRank(index)

    If RankPos > 0 Then

    ChangeRank index, RankPos

    End If
    ```
    **18 -** At the end of **modPlayer**, add:

    ```
    Private Function CheckRank(ByVal index As Long) As Byte

    Dim i As Byte

    For i = 1 To MAX_RANK

    If GetPlayerLevel(index) > Rank(i).Level Then

    CheckRank = i

    Exit Function

    End If

    Next i

    End Function

    Private Sub ChangeRank(ByVal index As Long, RankPos As Byte)

    Dim i As Long, ClearPos As Byte

    ' if not change position in rank

    If GetPlayerName(index) = Trim$(Rank(RankPos).Name) Then

    Rank(RankPos).Level = GetPlayerLevel(index)

    SaveRank

    Exit Sub

    End If

    ' search player in rank

    For i = 1 To MAX_RANK

    If GetPlayerName(index) = Trim$(Rank(i).Name) Then

    Rank(i).Name = vbNullString

    Rank(i).Level = 0

    ClearPos = i

    Exit For

    End If

    Next i

    ' down clear position

    If ClearPos > 0 Then

    For i = ClearPos To MAX_RANK

    If i = MAX_RANK Then

    Rank(i).Name = vbNullString

    Rank(i).Level = 0

    Else

    Rank(i).Name = Rank(i + 1).Name

    Rank(i).Level = Rank(i + 1).Level

    End If

    Next i

    End If

    ' open space in rank to player

    For i = MAX_RANK To RankPos Step -1

    If i > RankPos Then

    Rank(i).Name = Rank(i - 1).Name

    Rank(i).Level = Rank(i - 1).Level

    End If

    Next i

    ' put player in rank

    Rank(RankPos).Name = GetPlayerName(index)

    Rank(RankPos).Level = GetPlayerLevel(index)

    SaveRank

    End Sub
    ```
    **19 -** At the end of **modDatabase**, add:

    ```
    Public Sub SaveRank()

    Dim filename As String, i As Byte

    filename = App.Path & "\data\rank.ini"

    For i = 1 To MAX_RANK

    PutVar filename, "RANK", "Name" & i, Trim$(Rank(i).Name)

    PutVar filename, "RANK", "Level" & i, Val(Rank(i).Level)

    Next i

    End Sub

    Public Sub LoadRank()

    Dim filename As String, i As Byte

    filename = App.Path & "\data\rank.ini"

    If FileExist(filename, True) Then

    For i = 1 To MAX_RANK

    Rank(i).Name = GetVar(filename, "RANK", "Name" & i)

    Rank(i).Level = Val(GetVar(filename, "RANK", "Level" & i))

    Next i

    Else

    SaveRank

    End If

    End Sub
    ```
    **20 -** In **modTypes**, search for:

    ```
    Public Party(1 To MAX_PARTYS) As PartyRec
    ```
    **21 -** Below add:

    ```
    Public Rank(1 To MAX_RANK) As RankRec
    ```
    **22 -** Beneath of:

    ```
    Private Type OptionsRec

    Game_Name As String

    MOTD As String

    Port As Long

    Website As String

    End Type
    ```
    **23 -** Add:

    ```
    Private Type RankRec

    Name As String * ACCOUNT_LENGTH

    Level As Long

    End Type
    ```
    **24 -** In **modPlayer**, search for:

    ```
    ' Send Resource cache

    For i = 0 To ResourceCache(GetPlayerMap(index)).Resource_Count

    SendResourceCacheTo index, i

    Next
    ```
    **25 -** Below add:

    ```
    ' Check Rank

    For i = 1 To MAX_RANK

    If Trim$(Rank(i).Name) = GetPlayerName(index) Then

    Exit For

    End If

    If GetPlayerLevel(index) > Rank(i).Level Then

    Rank(i).Name = GetPlayerName(index)

    Rank(i).Level = GetPlayerLevel(index)

    SaveRank

    Exit For

    End If

    Next i
    ```
    **26 -**In **modGeneral**,search for:

    ```
    Call SetStatus("Loading animations...")

    Call LoadAnimations
    ```
    **27 -** Below Add:

    ```
    Call SetStatus("Loading rank...")

    Call LoadRank
    ```

    **Credits:**

    Valentine
  3. - Random spell damage:

    >! **Open Server**
    >! In **modCombat**, look for:
    >! ```
    Vital = Spell(spellnum).Vital
    ```
    >! Replace by:
    >! ```
    Vital = RAND(1, Spell(spellnum).Vital)
    ```
    >! - Two handed weapons
    >! >! [http://www.touchofde…weapon-2-hands/](http://www.touchofdeathforums.com/community/index.php?/topic/129460-creating-weapon-2-hands/)
  4. This shows how vulnerable system the speed of player and NPC, any hacker can hack the game and change the speed you want, would be interesting to create something on the server that impessa high speeds ….
  5. You can improve your code, Instead of:

    ```
    Case "/hide"

    If GetPlayerAccess(MyIndex) < ADMIN_CREATOR Then GoTo Continue

    If Player(MyIndex).Invisible = True Then

    Player(MyIndex).Invisible = False

    Else

    Player(MyIndex).Invisible = True

    End If
    ```

    Use

    ```
    Case "/hide"

    If GetPlayerAccess(MyIndex) < ADMIN_CREATOR Then GoTo Continue

    Player(MyIndex).Invisible = Not Player(MyIndex).Invisible
    ```

    Never use it

    ```
    If Player(Index).Invisible = True Then

    Name = ""

    Else

    Name = Trim$(Player(Index).Name)

    End If
    ```

    ALWAYS use **vbNullString**, because the **""** leaves a space of 6 bytes in memory, while **vbNullString** leaves 0 bytes in memory

    So let the code this way

    ```
    If Player(Index).Invisible Then

    Name = vbNullString

    Else

    Name = Trim$(Player(Index).Name)

    End If

    ```
  6. **Sorry my english**

    In trade you can exchange an amount of money 0\. At the bank you can deposit or withdraw an amount of money 0\. No error in the client or server, but it would not be a very good thing to let that happen.

    **Open Server**

    **1 -** In **modHandleData**, within

    ```
    Sub HandleTradeItem
    ```

    **2 -** Look for:

    ```
    ' make sure they have the amount they offer

    If amount < 0 Or amount > GetPlayerInvItemValue(index, invSlot) Then

    Exit Sub

    End If
    ```

    **3 -** Below add:

    ```
    If Item(itemNum).Type = ITEM_TYPE_CURRENCY Then

    If amount < 1 Then Exit Sub

    End If
    ```

    **4 -** In **modPlayer**, within

    ```
    Sub GiveBankItem
    ```

    **5 -** Look for:

    ```
    If amount < 0 Or amount > GetPlayerInvItemValue(index, invSlot) Then

    Exit Sub

    End If
    ```

    **6 -** Below add:

    ```
    If Item(GetPlayerInvItemNum(index, invSlot)).Type = ITEM_TYPE_CURRENCY Then

    If amount < 1 Then Exit Sub

    End If
    ```

    **7 -** Also in **modPlayer**, within

    ```
    Sub TakeBankItem
    ```

    **8 -** Look for:

    ```
    If amount < 0 Or amount > GetPlayerBankItemValue(index, BankSlot) Then

    Exit Sub

    End If
    ```

    **9 -** Below add:

    ```
    If Item(GetPlayerBankItemNum(index, BankSlot)).Type = ITEM_TYPE_CURRENCY Then

    If amount < 1 Then Exit Sub

    End If
    ```

    **Credits:**

    Valentine
  7. That's why I created tutorials to fix this problem

    http://www.touchofdeathforums.com/community/index.php?/topic/129445-bug-fix-fixing-serious-errors-in-trade/

    Still, I appreciate you trying to help your shape
  8. It would be interesting to find out something that you can take to not limit the stay of DirectX8 using graphics potency of 2, I still could not do it, nor advise using GDI has loss of performance, but I know it is possible, I've seen engines that closed source creator had achieved it.
  9. Relmente I was grateful to see people interested in improving the desepenho DirectX8, is a good initiative. But this may not be the best, you'll probably have to redo, for some reason I quoted the above.
  10. Could you tell what is being corrected? I was a little confused by this code, you mainly use

    ```
    TryCreateDirectX8Device Function () As Boolean
    ```

    Why The Function of CS is better than this new sub it is you saying to replace, since **TryCreateDirectX8Device** is not complete.

    You are saying to use **CheckTilesets, CheckCharacters** … besides others, but the way it is in the CS is faster because it loads the amount and puts in the DX8 memory only once.
  11. **Sorry my english**

    I realized that the client version is not sent to the record, enabling a player can register for a customer out of date.

    **Open Client**

    **1 -** In **modClientTCP**, look for:

    ```
    Public Sub SendNewAccount
    ```

    **2 -** Beneath:

    ```
    Buffer.WriteString Password
    ```

    **3 -** Add:

    ```
    Buffer.WriteLong App.Major

    Buffer.WriteLong App.Minor

    Buffer.WriteLong App.Revision
    ```

    **Open Server**

    **1 -** In **modHandleData**, look for:

    ```
    Private Sub HandleNewAccount
    ```

    **2 -** Beneath:

    ```
    Password = Buffer.ReadString
    ```

    **3 -** Below add:

    ```
    ' Check versions

    If Buffer.ReadLong < CLIENT_MAJOR Or Buffer.ReadLong < CLIENT_MINOR Or Buffer.ReadLong < CLIENT_REVISION Then

    Call AlertMsg(index, "Version outdated, please visit " & Options.Website)

    Exit Sub

    End If
    ```

    **Credits:**

    Valentine
×
×
  • Create New...