Approved Tutorials: Better Ban System (v1)

Print Page | Close Window

Better Ban System (v1)

Printed From: Mirage Source
Category: Tutorials
Forum Name: Approved Tutorials
Forum Discription: All tutorials shown to actually work with MSE are moved here.
URL: http://ms.shannaracorp.com/backup-forums/forum_posts.asp?TID=37
Printed Date: 20 December 2006 at 6:01pm
Software Version: Web Wiz Forums 8.01 - http://www.webwizforums.com

Topic: Better Ban System (v1)

Posted By: Sync
Subject: Better Ban System (v1)
Date Posted: 07 February 2006 at 5:46pm

Originally posted by Baltan

Name: Better Ban System
By: Dark Dragon (Baltan)
Version: 1
Dificulty: 3/5 (Medium)

Ok, im finally happy enough without this tutorial to releace it. Thanks to Noel for starting me on this. In this tutorial i wil show you how to add

- UnBan System
- Ini system (May upgrade to binary later)
- Ini Loading to array
- HD Banning
- /banlist fix

also, this was coded on MS3.03, but they are similar and the syntax is the same (I already had the fileexist function coded before MSE =P ) but if I accidentaly did not make the right module or something, tell me, and i will check it, but you should figure it out.

ok, so lets start:

Server Side:
-----------
ModTypes.bas
-----------

In PlayerRec in the unsaved loacal variables add:

HDSerial As String

under you're GuildRec add:

Type BanRec
    BannedIP As String
    BannedChar As String
    BannedBy As String
    BannedHD As String
End Type

This will be used in our public array to store all the data. [ you may want to make them fixed length if you want, but thats up to you ]

now, under the code

Public Guild(1 To MAX_GUILDS) As GuildRec

add:

Public Ban() As BanRec

this is our array, it dose not have a 0 to anything,we will ReDim that in later.

now at the bottom, add:

Function GetPlayerHD(ByVal index As Long) As String
    GetPlayerHD = Player(index).HDSerial
End Function

this little function will be used later to Get the Players HD

Thats it for modTypes.bas

----------
modDatabase.bas
----------

At the top add a public Integer called MAX_BANS:

Public MAX_BANS As Integer

this will be used to publicaly store the number of bans we have.

ok

now at the bottom add:

Sub LoadBans()
Dim FileName As String
Dim I As Integer
Dim BNum As Integer
    FileName = App.Path & "\banlist.ini"
    MAX_BANS = GetVar(FileName, "Total", "Total")
    
    ReDim Ban(0 To MAX_BANS) As BanRec
    
    For I = 0 To MAX_BANS
    
        If GetVar(FileName, "Ban" & I, "BannedIP") = "" Then
              Ban(I).BannedIP = GetVar(FileName, "Ban" & I, "BannedIP")
              Ban(I).BannedChar = GetVar(FileName, "Ban" & I, "BannedChar")
              Ban(I).BannedBy = GetVar(FileName, "Ban" & I, "BannedBy")
              Ban(I).BannedHD = GetVar(FileName, "Ban" & I, "BannedHD")
        End If

    Next I
              
End Sub

this sub ReDims the Bans Array and loads all the ban info from the file

now that we can Read bans, we need a way to write them, so under the newly created sub add:

Sub SaveBan(ByVal BanNum As Integer)
Dim FileName As String
    FileName = App.Path & "\banlist.ini"
    
    Call PutVar(FileName, "Ban" & BanNum, "BannedIP", Ban(BanNum).BannedIP)
    Call PutVar(FileName, "Ban" & BanNum, "BannedChar", Ban(BanNum).BannedChar)
    Call PutVar(FileName, "Ban" & BanNum, "BannedBy", Ban(BanNum).BannedBy)
    Call PutVar(FileName, "Ban" & BanNum, "BannedHD", Ban(BanNum).BannedHD)
    
End Sub

all this does is saves the ban.

now find you're "BanIndex" sub and change it to:

Sub BanIndex(ByVal BanPlayerIndex As Long, ByVal BannedByIndex As Long)
Dim FileName As String, IP As String, bnam As String
Dim f As Long, I As Long
Dim BNum As Integer, b As Integer
Dim MAX_BANS As Long

    FileName = App.Path & "\banlist.ini"
    
    IP = GetPlayerIP(BanPlayerIndex)

    b = 1

    For I = 0 To MAX_BANS + 1
    If Ban(I).BannedIP = "" Then
        BNum = I
        Exit For
    End If
    
    If I = MAX_BANS + 1 Then
        BNum = MAX_BANS + 1
        Exit For
    End If
    
    Next I
    
    ' Add there data to a ban slot
    Ban(BNum).BannedIP = IP
    Ban(BNum).BannedChar = GetPlayerName(BanPlayerIndex)
    Ban(BNum).BannedBy = GetPlayerName(BannedByIndex)
    Ban(BNum).BannedHD = GetPlayerHD(BanPlayerIndex)
    Call SaveBan(BNum)
    Call PutVar(FileName, "Total", "Total", GetVar(FileName, "Total", "Total") + 1)
    MAX_BANS = MAX_BANS + 1
     
    'Alert People
    Call GlobalMsg(GetPlayerName(BanPlayerIndex) & " has been banned from " & GAME_NAME & " by " & GetPlayerName(BannedByIndex) & "!", White)
    Call AddLog(GetPlayerName(BannedByIndex) & " has banned " & GetPlayerName(BanPlayerIndex) & ".", ADMIN_LOG)
    Call AlertMsg(BanPlayerIndex, "You have been banned by " & GetPlayerName(BannedByIndex) & "!")
End Sub

this sub will find an open banslot, set the ban, Save it, Incriment the MAX_BANS, save them, and do all the message work :wink:

now we CAN ban people, we need to UN-ban them, so under you're edited BanIndex sub, make a New sub:

Sub UnBanIndex(ByVal BannedPlayerName As String, ByVal DeBannedByIndex As Long)
Dim FileName As String, IP As String, bnam As String
Dim f As Long, I As Long
Dim b As Integer
Dim MAX_BANS As Integer

    FileName = App.Path & "\banlist.ini"

    For I = 0 To MAX_BANS + 1
        If LCase$(GetVar(FileName, "Ban" & I, "BannedChar")) = LCase$(BannedPlayerName) Then
                  ' Delete there data to a ban slot
                  Ban(I).BannedIP = ""
                  Ban(I).BannedChar = ""
                  Ban(I).BannedBy = ""
                  Ban(I).BannedHD = ""
                  Call SaveBan(I)
                   
                  'Alert People
                  Call GlobalMsg(BannedPlayerName & " has been unbanned from " & GAME_NAME & " by " & GetPlayerName(DeBannedByIndex) & "!", White)
                  Call AddLog(GetPlayerName(DeBannedByIndex) & " has unbanned " & BannedPlayerName & ".", ADMIN_LOG)
              Exit For
        End If
        
        If I = MAX_BANS + 1 Then
              Call PlayerMsg(DeBannedByIndex, "Player is not banned!", White)
        End If
    Next I

End Sub

This will try to find a banned person by the name that is passed into the sub, if it can it will erase their data, and do message work, but if it cant it will allert the banner =]

Done with modDatabase.bas ! :-D

----------
modTCP.bas
----------

ok, now we will check IF a person is banned, so:

find your "IsBanned" function. change it to:

Function IsBanned(ByVal IP As String) As Boolean

Dim FileName As String, fIP As String, fName As String
Dim f As Long
'Dim b As Integer
Dim bIp As String
Dim I As Integer

    IsBanned = False
    
    FileName = App.Path & "\banlist.ini"
    
    For I = 0 To MAX_BANS
        If Ban(I).BannedIP <> "" Then
              bIp = Ban(I).BannedIP
              If IP = bIp Then
                  IsBanned = True
                  Exit Function
              Else
                  IsBanned = False
              End If
        End If
    Next I
    
End Function

this cycles through All bans and if the IP is not "" it will check if the BannedIP is the Loging in IP.

now, I promised HD Banning, and I hope not to dissapoint =P

so under youre edited IsBanned function, add:


Function IsBannedHD(ByVal HD As String) As Boolean

Dim FileName As String
Dim bHD As String
Dim I As Integer

    IsBannedHD = False
    
    FileName = App.Path & "\banlist.ini"
    
    For I = 0 To MAX_BANS
        If Ban(I).BannedHD <> "" Then
              bHD = Ban(I).BannedHD
              If HD = bHD Then
                  IsBannedHD = True
                  Exit Function
              Else
                  IsBannedHD = False
              End If
        End If
    Next I
    
End Function

this function does the same thing at the IsBanned function, except it checks for HD instead of IP.

----------
modHandleData.bas
----------

Packet: NewAccount
Dim BIp at the top, it is an integer

under

             ' Get the data
              Name = Parse(1)
              Password = Parse(2)
              Sex = Parse(3)

add:

             If IsBannedHD(Player(index).HDSerial) Then
                  Call AlertMsg(index, "You have been banned from " & GAME_NAME & ", you can no longer play!")
                  Exit Sub
              End If

Packet: Delete Account

under:

             ' Get the data
              Name = Parse(1)
              Password = Parse(2)

add:

             If IsBannedHD(Player(index).HDSerial) Then
                  Call AlertMsg(index, "You have been banned from " & GAME_NAME & ", you can no longer play!")
                  Exit Sub
              End If

Packet: Login

Under:

             ' Get the data
              Name = Parse(1)
              Password = Parse(2)

Add:

             If IsBannedHD(Player(index).HDSerial) Then
                  Call AlertMsg(index, "You have been banned from " & GAME_NAME & ", you can no longer play!")
                  Exit Sub
              End If

Please tell me you get the geist of this :wink:

Packet: Ban List

Cchange it to:

    If LCase$(Parse(0)) = "banlist" Then
        ' Prevent hacking
        If GetPlayerAccess(index) < ADMIN_MAPPER Then
              Call HackingAttempt(index, "Admin Cloning")
              Exit Sub
        End If
        
        n = 1
        
        'Var Password = HD
        
        For I = 0 To MAX_BANS
              bIp = Ban(I).BannedIP
              If bIp = "" Then
              'skip
              Else
              Name = Ban(I).BannedBy
              s = Ban(I).BannedChar
              Password = Ban(I).BannedHD
              Call PlayerMsg(index, n & ": " & s & " ( Banned IP " & bIp & "[" & Password & "] by " & Name & " )", White)
              n = n + 1
              End If
        Next I
        
        Exit Sub
    End If

Packet: BanDestroy

Make it:

    If LCase$(Parse(0)) = "bandestroy" Then
        ' Prevent hacking
        If GetPlayerAccess(index) < ADMIN_CREATOR Then
              Call HackingAttempt(index, "Admin Cloning")
              Exit Sub
        End If
        
        For n = 0 To MAX_BANS
                  Ban(I).BannedIP = ""
                  Ban(I).BannedChar = ""
                  Ban(I).BannedBy = ""
                  Ban(I).BannedHD = ""
                  Call SaveBan(I)
        Next n
        
        Call PlayerMsg(index, "Ban list destroyed.", White)
        Exit Sub
    End If

Make a new packet, under Ban Player Packet, named UnBan Player Packet

    ' :::::::::::::::::::::::::
    ' :: UnBan player packet ::
    ' :::::::::::::::::::::::::
    If LCase$(Parse(0)) = "unbanplayer" Then
        ' Prevent hacking
        If GetPlayerAccess(index) < ADMIN_MAPPER Then
              Call HackingAttempt(index, "Admin Cloning")
              Exit Sub
        End If
        
        ' The player index
        Name = Trim$(Parse(1))
        
        Call UnBanIndex(Name, index)
        
        Exit Sub
    End If

now add a new Packet at the bottom, named "HDSerial"

    ' ::::::::::::::::::::::
    ' :: HD Serial packet ::
    ' ::::::::::::::::::::::
    If LCase$(Parse(0)) = "hdserial" Then
        Player(index).HDSerial = Parse(1)
        Exit Sub
    End If

this will be used to recieve and assign the HDD

Done with HandleData!! :-D

DONE SERVER SIDE!!!!!! :-D :-D

Client Side:
----------
ModClientTCP.bas
----------

Change Sub SendNewAccount to

Sub SendNewAccount(ByVal Name As String, ByVal Password As String, ByVal Sex As Byte)
Dim Packet As String

    Call SendData("HDSerial" & SEP_CHAR & GetHDSerial("C") & SEP_CHAR & END_CHAR)

    Packet = "newaccount" & SEP_CHAR & Trim(Name) & SEP_CHAR & Trim(Password) & SEP_CHAR & END_CHAR
    Call SendData(Packet)
End Sub

know you know where to add it, add


    Call SendData("HDSerial" & SEP_CHAR & GetHDSerial("C") & SEP_CHAR & END_CHAR)

to SendDelAccount and SendLogin :wink:

these send the HD Serial packet

Under SendBan, add

Sub SendUnBan(ByVal Name As String)
Dim Packet As String

    Packet = "UNBANPLAYER" & SEP_CHAR & Name & SEP_CHAR & END_CHAR
    Call SendData(Packet)
End Sub

Sends the Unban player packet

End of ModClientTCP

----------
modDatabase.bas
----------

at the Bottom add:

    
Public Function GetHDSerial(Optional ByVal DriveLetter As String) As Long
    Dim fso As Object, Drv As Object, DriveSerial As Long
    
    'Create a FileSystemObject object
    Set fso = CreateObject("Scripting.FileSystemObject")
    
    'Assign the current drive letter if not specified
    If DriveLetter <> "" Then
        Set Drv = fso.GetDrive(DriveLetter)
    Else
        Set Drv = fso.GetDrive(fso.GetDriveName(App.Path))
    End If

    With Drv
        If .IsReady Then
              DriveSerial = Abs(.SerialNumber)
        Else    '"Drive Not Ready!"
              DriveSerial = -1
        End If
    End With
    
    'Clean up
    Set Drv = Nothing
    Set fso = Nothing
    
    GetHDSerial = DriveSerial
End Function

this function will return the HD Serial :wink:

Thats it for modDataBase.bas :wink:

----------
modHandleData.bas
----------

Sub HandleKeypresses ->

Command: Banlist

change to

             ' Check the ban list
              If LCase(Mid(MyText, 1, 8)) = "/banlist" Then
                  Call SendBanList
                  MyText = ""
                  Exit Sub
              End If

this is a bugfix

Under /ban command add:

             ' unBanning a player
              If LCase(Mid(MyText, 1, 6)) = "/unban" Then
                  If Len(MyText) > 7 Then
                      MyText = Mid(MyText, 8, Len(MyText) - 7)
                      Call SendUnBan(MyText)
                      MyText = ""
                  End If
                  Exit Sub
              End If

End Of Client

:-o :-o End Of Tutorial!! :-o :-o

any questions or anything i forgot or just a comliment :wink: , please post!!!

Replies:

Posted By: Sync
Date Posted: 07 February 2006 at 5:47pm

Approved

Posted By: Da Undead
Date Posted: 05 March 2006 at 12:47pm

Where do I put...

Function GetPlayerHD(ByVal index As Long) As String
GetPlayerHD = Player(index).HDSerial
End Function

I dont get it!?!?!?!

Posted By: Da Undead
Date Posted: 05 March 2006 at 12:52pm

Im getting errors on all the .HDSerial 's...

Why?!?!? I have HDSerial under Playerrec as a String. I can't fix this prob WTF! :(

Posted By: funkynut
Date Posted: 05 March 2006 at 1:20pm

aaggh, are you coping and pasting every tutorial into your project?

anyway, it doesnt matter where you put it as long as its not in another sub or function. but if you read it properly, you will see it says to put it at the bottom of modtypes.

As for your other problem, just because were programmers, doesnt make us physic, what error do you get?

Posted By: Da Undead
Date Posted: 05 March 2006 at 2:20pm

i dont know, i deleted this program because it highlights the word...

.HDSerial

I don't know why! :(

Posted By: Misunderstood
Date Posted: 05 March 2006 at 4:12pm

Its because you copy and paste without knowing what it should do. You don't seem to understand things before you do them...

Posted By: Da Undead
Date Posted: 14 March 2006 at 11:25am

lol Mis, shut up

Posted By: Jobs
Date Posted: 15 March 2006 at 4:54am

I'm not quite sure who you are, I haven't really seen you before Da Undead. But Mis is right, if you're going to use a tutorial you should read it and understand it first, and it's even a good idea to type it out by looking at it rather than just copy and paste the whole thing without reading what it's actually doing.

Posted By: Memphis
Date Posted: 15 March 2006 at 7:18am

No, You STFU. Don't be telling people to shut up if you don't get the tutorial! its not a friggin copy and paste you dumb c**t. Understand it before you do it. DUMBO.

Posted By: Jobs
Date Posted: 15 March 2006 at 8:34am

Yeah...as much as I agree with that it could have been put a bit more....politely?

Posted By: Renegade
Date Posted: 15 March 2006 at 8:53am

Jobs long time no see. Your error is because .HDserial isnt Defined try adding this sub


Function GetPlayerHD(ByVal index As Long) As String
    GetPlayerHD = Player(index).HDSerial
End Function

In mod types at the bottom that should fix it, if not then tell us what the error is I.e Variable not defined or i dunno 13 type missmatch

-------------
Eternia online, Coming soon to a movie i mean computer near you!

Posted By: Matt
Date Posted: 15 March 2006 at 12:38pm

Err.. Da Undead, you're looking toasty. Is it because you poured gasoline all over yourself, expecting to not get flamed? Dude, don't C&P, please. Save us that burden. And Jobs, Wb.

As for the flamers: "It's not nice to flame. Do unto others as you want others to do unto you."

-------------
"This nightmare wont last long. Are you scared? So sing this song. I'm right there, by your side. Tonight we've got a chance." - Aiden, The Last Sunrise
I love you, Mikaela