Attribute VB_Name = "modFuncs"
Global SettingINI As String
Global Timestamp As String
Global IPAddy As String
Global HUsername As String
Global Regkey As String
Global FSO As New FileSystemObject
Global DBP As String
Global CFG As String
Public Const RGN_DIFF = 4
Public Const SC_CLICKMOVE = &HF012& ' This setting is not in your API viewer, not sure why.
' If you use SC_MOVE then the mouse moves to the title bar
' and then moves the form, which makes forms with no title bar
' to not work.
Public Const WM_SYSCOMMAND = &H112
Private Declare Function SendMessage Lib "user32" Alias "SendMessageA" (ByVal hwnd As Long, ByVal wMsg As Long, ByVal wParam As Long, lParam As Any) As Long

Public Function TextBoxLinesCount(Textbox As Textbox) As Long
  Const EM_GETLINECOUNT = &HBA

  TextBoxLinesCount = SendMessage(Textbox.hwnd, EM_GETLINECOUNT, 0, 0)
End Function

Public Function FileExists(ByVal sFilename As String) As Boolean
    Dim sFile As String
    On Error Resume Next
    FileExists = False
    sFile = Dir$(sFilename)
    If (Len(sFile) > 0) And (Err = 0) Then
        FileExists = True
    End If
End Function

Public Function DirExists(ByVal sDirname As String) As Boolean
     Dim sDir As String
    On Error Resume Next
    DirExists = False
    sDir = Dir$(sDirname, vbDirectory)
    If (Len(sDir) > 0) And (Err = 0) Then
        DirExists = True
    End If
End Function

Public Function CountStr(ByVal sIn As String, ByVal sFind As String)
    Dim nIn As String, nFind As String, nCount As Long, _
    nPart As String
    
    nIn = sIn
    nFind = sFind
    Dim a As Long
    For a = 1 To Len(nIn)
    nPart = Mid(nIn, a, Len(nFind))
    If nPart = nFind Then
    nCount = nCount + 1
    End If
    Next a


    CountStr = nCount
End Function

Public Function StripSlash(what As String) As String
StripSlash = Replace(what, "\", Chr(1))
StripSlash = Replace(what, "'", "\'")
StripSlash = Replace(what, Chr(1), "\\")
End Function

Public Function Decode(ToDecode As String)
Dim f As String
Dim l As Integer
Dim Chrs As Integer
Dim Chh As String
Dim Resu As Integer
f = ToDecode
If ToDecode = "" Then
Exit Function
End If
For l = 1 To Len(f)
    For Chrs = 1 To 255
        If Chr(Chrs) = Mid(f, l, 1) Then
            If l = Len(f) Then
                Chh = Chrs - 64
                Resu = Resu + Chh
            ElseIf l = Len(f) - 1 Then
                trmp = Chrs - 64
                Chh = trmp * 64
                Resu = Resu + Chh
            End If
        End If
    Next
Next
Decode = Resu
End Function
Public Function Encode(numb As Integer)
Dim Neb As Integer
Dim Fir As Integer
Dim Lst As Integer
If numb < 4 Then
    If numb = 0 Then
        Encode = "H"
        Exit Function
    End If
    If numb = 1 Then
        Encode = "I"
        Exit Function
    End If
    If numb = 2 Then
        Encode = "J"
        Exit Function
    End If
    If numb = 3 Then
        Encode = "K"
        Exit Function
    End If
Else
    Neb = numb - 3
    Lst = 65
    Fir = 80
redo:
    DoEvents
    If Neb = 1 Then
        Encode = Chr(Fir) & Chr(Lst)
        Exit Function
    End If
    Neb = Neb - 1
    Fir = Fir + 1
    If Fir = 84 Then
        Fir = 80
        Lst = Lst + 1
    End If
    GoTo redo
End If
End Function

Public Function sendAll(ByVal ToSend As String, ByVal Room As Long)
If Room > 0 And IsNumeric(Room) = True Then
For b = 1 To frmMain.SockI
If Client(b).InRoom = Room Then
If frmMain.socket(b).State = sckConnected Then frmMain.socket(b).SendData ToSend
End If
Next b
End If
End Function

Public Function sendAllP(ByVal ToSend As String, ByVal Room As Long)
On Error Resume Next
If Room > 0 And IsNumeric(Room) = True Then
For b = 1 To frmMain.SockI
If Client(b).publicnum = Room Then
If frmMain.socket(b).State = sckConnected Then frmMain.socket(b).SendData ToSend
End If
Next b
End If
End Function

Public Function ReverseString(ByVal InputString As String) _
  As String

Dim lLen As Long, lCtr As Long
Dim sChar As String
Dim sAns As String

lLen = Len(InputString)
For lCtr = lLen To 1 Step -1
    sChar = Mid(InputString, lCtr, 1)
    sAns = sAns & sChar
Next

ReverseString = sAns

End Function

Public Function Contains(str, ToFind As Integer)
Result = False
If Left(str, 1) = ToFind Then
    Result = True
    GoTo ContainsEnd
End If
For a = 1 To Len(str)
    If Mid(str, a, 1) = ToFind Then
        Result = True
        GoTo ContainsEnd
    End If
Next a
ContainsEnd:
Contains = Result
End Function

Public Function isOnline(Habbo As Integer) As String

For a = 1 To frmMain.SockI
    If LCase(Client(a).name) = LCase(Habbo) And frmMain.socket(a).State = sckConnected Then
        Result = True
    Else
        Result = False
    End If
Next a

isOnline = Result

End Function

Public Function UserID(ByVal Habbo As String) As String
UserID = MySQLQuery("SELECT num FROM habbos WHERE name = '" & Habbo & "'")
End Function

Public Function unUserID(ByVal ID As String) As String
On Error Resume Next
Dim Result As String
Dim Theirname As String
Result = 0
For fol = 1 To MySQLQuery("SELECT regusers FROM other")
    Theirname = MySQLQuery("SELECT name FROM habbos WHERE num = '" & fol & "'")
    If UserID(Theirname) = ID Then
        Result = Theirname
        Exit For
    End If
Next
unUserID = Result
End Function

Public Function GetID(ByVal Habbo As String) As String
Dim i As Long
Dim found As Integer
found = 0
For i = 1 To frmMain.SockI
    If LCase(Client(i).name) = LCase(Habbo) And frmMain.socket(i).State = sckConnected Then
        found = i
    End If
Next i
GetID = found
End Function

Public Function SendTo(Habbo As String, ToSend As String) As String
For a = 1 To frmMain.SockI
    If LCase(Client(a).name) = LCase(Habbo) And frmMain.socket(a).State = sckConnected Then
        frmMain.socket(a).SendData ToSend
    End If
Next a
End Function

Public Function Diff(ByVal Num1, ByVal Num2) As String
If Num1 > Num2 Then
    N1 = Num1
    N2 = Num2
Else
    N1 = Num2
    N2 = Num1
End If
Diff = N1 - N2
End Function

Public Function SendPub(ByVal ToSend As String, ByVal PubRoom As String)
'If PubRoom = "" Then Exit Function
'For a = 1 To frmMain.SockI
'    If frmMain.socket(a).State = sckConnected Then
'        If Client(a).InPub = PubRoom Then
'            frmMain.socket(a).SendData ToSend
''            frmdebug.debug locale("debug_1") & " " & a & " " & Client(a).name, publics
'        End If
'    End If
'Next a
End Function

Public Function RankHeight(ByVal Rank1 As String, ByVal Rank2 As String) As Boolean
Select Case Rank1
Case "habbo"
Levela = 0
Case "habbox"
Levela = 1
Case "silver"
Levela = 2
Case "gold"
Levela = 3
Case "moderator"
Levela = 4
Case "admin"
Levela = 5
Case Else
Levela = 0
End Select
Select Case Rank2
Case "habbo"
Levelb = 0
Case "habbox"
Levelb = 1
Case "silver"
Levelb = 2
Case "gold"
Levelb = 3
Case "moderator"
Levelb = 4
Case "admin"
Levelb = 5
Case Else
Levelb = 0
End Select
If Val(Levela) >= Val(Levelb) Then
    RankHeight = True
Else
    RankHeight = False
End If
End Function

Public Function Printlog(ByVal ToLog As String)
If FSO.FolderExists(App.Path & "\logfiles") = False Then FSO.CreateFolder (App.Path & "\logfiles")
If FSO.FileExists(App.Path & "\logfiles\" & Date & ".log") = False Then FSO.OpenTextFile(App.Path & "\logfiles\" & Date & ".log", ForWriting, True).Write "## " & Date & " ##"
FSO.OpenTextFile(App.Path & "\logfiles\" & Date & ".log", ForAppending).Write vbCrLf & ToLog
End Function

Public Function Send(ByVal SocketNumber As Integer, ByVal ToSend As String)
On Error Resume Next
frmMain.socket(SocketNumber).SendData ToSend
End Function

Public Function CheckBotsReaction(ByVal Index As Integer, ByVal Saying As String)
For u = 1 To frmMain.BotI
    If Bot(u).publicnum = Client(Index).publicnum Then
        idx = u
        GoTo BotIsThere
    End If
Next u
Exit Function
BotIsThere:
If Bot(idx).InUse = True Then Exit Function
If Diff(Bot(idx).PosX, Client(Index).PosX) > 8 Or Diff(Bot(idx).PosY, Client(Index).PosY) > 8 Then Exit Function
Saying = LCase(Saying)
FSO.OpenTextFile(App.Path & "\misc_files\temp_files\tempini.ini", ForWriting).Write MySQLQuery("SELECT data FROM public WHERE id = '" & Client(Index).publicnum & "'")
DAP = FSO.OpenTextFile(App.Path & "\misc_files\temp_files\tempini.ini", ForReading).ReadAll
For u = 1 To 10
Callwords = LCase(ReadINI("bot", "call_words_" & u, App.Path & "\misc_files\temp_files\tempini.ini"))
If Callwords <> "" And Callwords <> "0" And InStr(Callwords, ",") <> 0 Then
    Callword = Split(Callwords, ",")
    For i = 0 To UBound(Callword)
        If Callword(i) <> "" Then
        If InStr(Callword(i), "+") = 0 Then
            If InStr(Saying, Callword(i)) <> 0 Then
            ReactionNumb = u
            GoTo otherReaction
            End If
        Else
            If InStr(Saying, Split(Callword(i), "+")(0)) <> 0 And InStr(Saying, Split(Callword(i), "+")(1)) <> 0 Then
                ReactionNumb = u
                GoTo BotReacts
            End If
        End If
        End If
    Next i
End If
otherReaction:
Next u
BotReacts:
For u = 1 To 3
    BotReaction = ReadINI("bot", "reaction_" & ReactionNumb & "_" & u, App.Path & "\misc_files\temp_files\tempini.ini")
    If BotReaction <> "" And BotReaction <> "0" Then
    If InStr(BotReaction, Chr(2)) <> 0 Then
        eventname = Split(BotReaction, Chr(2))(0)
        Select Case eventname
        Case "say"
        For a = 1 To frmMain.SockI
        If frmMain.socket(a).State = sckConnected And Client(a).publicnum = Bot(idx).publicnum And Diff(Client(a).PosX, Bot(idx).PosX) < 8 And Diff(Client(a).PosY, Bot(idx).PosY) < 8 Then
        Send a, "@X" & VL64encode(Bot(idx).Num) & Split(BotReaction, Chr(2))(1) & Chr(2) & Chr(1)
        End If
        Next a
        Tijd = Len(Split(BotReaction, Chr(2))(1)) * 100
        If Tijd < 500 Then Tijd = 500
        Bot(idx).Talking = True
        frmMain.TimerBotTalk(idx).Interval = Tijd
        frmMain.TimerBotTalk(idx).Enabled = True
        Botdo = 1
        Case "shout"
        sendAllP "@Z" & VL64encode(Bot(idx).Num) & Split(BotReaction, Chr(2))(1) & Chr(2) & Chr(1), (Bot(idx).publicnum)
        Tijd = Len(Split(BotReaction, Chr(2))(1)) * 100
        If Tijd < 500 Then Tijd = 500
        Bot(idx).Talking = True
        frmMain.TimerBotTalk(idx).Interval = Tijd
        frmMain.TimerBotTalk(idx).Enabled = True
        Botdo = 1
        Case "whisper"
        Send Index, "@Y" & VL64encode(Bot(idx).Num) & Split(BotReaction, Chr(2))(1) & Chr(2) & Chr(1)
        Tijd = Len(Split(BotReaction, Chr(2))(1)) * 100
        If Tijd < 500 Then Tijd = 500
        Bot(idx).Talking = True
        frmMain.TimerBotTalk(idx).Interval = Tijd
        frmMain.TimerBotTalk(idx).Enabled = True
        Botdo = 1
        Case "drink"
        Hab_AP "AP" & Split(BotReaction, Chr(2))(1), Index
        Botdo = 1
        End Select
    End If
    End If
Next u
If Botdo = 1 Then
    Bot(idx).InUse = True
    Bot(idx).DestX = Client(Index).PosX
    Bot(idx).DestY = Client(Index).PosY
    Bot(idx).Update = True
End If
End Function