Attribute VB_Name = "modFuncs"
Global SettingIni As String
Global FSO As New FileSystemObject
Global DBP As String

Public Declare Function SetCursorPos Lib "user32" (ByVal X As Long, ByVal Y As Long) As Long
Public Declare Function GetCursorPos Lib "user32" (lpPoint As POINTAPI) As Long
Public Declare Function GetAsyncKeyState Lib "user32" (ByVal vKey As Long) As Integer
Public Declare Sub mouse_event Lib "user32" (ByVal dwFlags As Long, ByVal dx As Long, ByVal dy As Long, ByVal cButtons As Long, ByVal dwExtraInfo As Long)

Public Const MOUSEEVENTF_LEFTDOWN = &H2
Public Const MOUSEEVENTF_LEFTUP = &H4
Public Const MOUSEEVENTF_RIGHTDOWN = &H8
Public Const MOUSEEVENTF_RIGHTUP = &H10
Public Const MOUSEEVENTF_MIDDLEDOWN = &H20
Public Const MOUSEEVENTF_MIDDLEUP = &H40
Public Const MOUSEEVENTF_MOVE = &H1

Public Type POINTAPI
X As Long
Y As Long
End Type

Declare Function Shell_NotifyIcon Lib "shell32.dll" (ByVal dwMessage As Long, lpData As NOTIFYICONDATA) As Long

Public Const NIM_ADD = &H0
Public Const NIM_DELETE = &H2
Public Const NIM_MODIFY = &H1

Public Const NIF_ICON = &H2
Public Const NIF_MESSAGE = &H1
Public Const NIF_TIP = &H4

Public Const WM_LBUTTONDBLCLK = &H203
Public Const WM_LBUTTONDOWN = &H201
Public Const WM_LBUTTONUP = &H202
Public Const WM_MOUSEMOVE = &H200
Public Const WM_RBUTTONDBLCLK = &H206
Public Const WM_RBUTTONDOWN = &H204
Public Const WM_RBUTTONUP = &H205

Type NOTIFYICONDATA
        cbSize As Long
        hwnd As Long
        uID As Long
        uFlags As Long
        uCallbackMessage As Long
        hIcon As Long
        szTip As String * 64
End Type

Public IconData As NOTIFYICONDATA

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 = FSO.OpenTextFile(DBP & "habbos\" & LCase(Habbo) & "\num.txt", ForReading).ReadAll
End Function

Public Function unUserID(ByVal ID As String) As String
On Error Resume Next
Dim fol As Folder
Dim Result As String
Dim TheirName As String
Result = 0
For Each fol In FSO.GetFolder(DBP & "habbos").SubFolders
    TheirName = FSO.OpenTextFile(fol & "\name.txt", ForReading).ReadAll
    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 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)
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)
DAP = DBP & "pub\" & Client(Index).Publicnum & "\data.ini"
For u = 1 To 10
Callwords = LCase(ReadINI("bot", "call_words_" & u, DAP))
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, DAP)
    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