Attribute VB_Name = "modKonsole" Public Function loadconsole(Index As Integer) Dim NewList As String Dim TheirID As String Dim SendPacket As String Dim Friendlist() As String SendPacket = "" If FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\friendlist.txt", ForReading).AtEndOfStream = False Then Friendlist = Split(FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\friendlist.txt", ForReading).ReadAll, ">") For a = 1 To UBound(Friendlist) If Friendlist(a) <> "" And Friendlist(a) <> ">" Then TheirName = Replace(Friendlist(a), "<", "") TheirID = "" For b = 1 To frmMain.SockI If LCase(Client(b).Name) = LCase(TheirName) And frmMain.socket(b).State = sckConnected Then TheirID = b If Client(b).InRoom > 0 Then UserPosition = "Floor1b" Else UserPosition = locale("hotel_view") End If Exit For End If Next b lastonline = FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\lastonline.txt", ForReading).ReadAll If LCase(FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\sex.txt", ForReading).ReadAll) = "m" Then Gender = "I" Else Gender = "H" End If If FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\consolemission.txt", ForReading).AtEndOfStream = True Then cmiss = "H" Else cmiss = "I" & FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\consolemission.txt", ForReading).ReadAll If cmiss = "I " Then cmiss = "H" End If If TheirID <> "" Then SendPacket = SendPacket & "BI" & VL64encode(UserID(TheirName)) & FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\name.txt", ForReading).ReadAll & Chr(2) & Gender & cmiss & Chr(2) & "I" & UserPosition & Chr(2) & lastonline & Chr(2) & FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\app.txt", ForReading).ReadAll & Chr(2) & Chr(1) Else SendPacket = SendPacket & "BI" & VL64encode(UserID(TheirName)) & FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\name.txt", ForReading).ReadAll & Chr(2) & Gender & cmiss & Chr(2) & "H" & Chr(2) & lastonline & Chr(2) & FSO.OpenTextFile(DBP & "habbos\" & LCase(TheirName) & "\app.txt", ForReading).ReadAll & Chr(2) & Chr(1) End If End If Next a End If If FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\consolemission.txt", ForReading).AtEndOfStream = False Then Consolemissi = FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\consolemission.txt", ForReading).ReadAll Else Consolemissi = "" End If Dim MsgFile As File For Each MsgFile In FSO.GetFolder(DBP & "habbos\" & LCase(Client(Index).Name) & "\directmail\").Files If Right(MsgFile, 3) <> "txt" Then SendPacket = SendPacket & Split(MsgFile.OpenAsTextStream(ForReading).ReadAll, Chr(1), 2)(1) End If Next If FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\inquiries.txt", ForReading).AtEndOfStream = False Then InqList = Split(FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\inquiries.txt", ForReading).ReadAll, "<") For a = 1 To UBound(InqList) If InqList(a) <> "" And InqList(a) <> ">" Then InqName = Split(InqList(a), ">")(0) If FSO.FolderExists(DBP & "habbos\" & LCase(InqName)) Then SendPacket = SendPacket & "BD" & VL64encode(FSO.OpenTextFile(DBP & "habbos\" & LCase(InqName) & "\num.txt", ForReading).ReadAll) & FSO.OpenTextFile(DBP & "habbos\" & LCase(InqName) & "\name.txt", ForReading).ReadAll & Chr(2) & Chr(1) Else NewList = FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\inquiries.txt", ForReading).ReadAll NewList = Replace(NewList, "<" & InqName & ">", "") FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\inquiries.txt", ForWriting).Write NewList End If End If Next a End If frmMain.socket(Index).SendData "@L" & Consolemissi & Chr(2) & Chr(1) & SendPacket End Function Public Function SaveMessage(Message As String, Habbo As String, FromUser As String) If FSO.FolderExists(DBP & "habbos\" & LCase(Habbo)) Then MessageDate = Format(Date, "dd-mm-yyyy") & " " & Format(Time, "hh:mm") NewCount = Val(FSO.OpenTextFile(DBP & "habbos\" & LCase(Habbo) & "\directmail\count.txt", ForReading).ReadAll) + 1 If Round(VL64Decode(VL64encode(NewCount))) <> NewCount Then reloop: NewCount = NewCount + 1 If Round(VL64Decode(VL64encode(NewCount))) <> NewCount Then GoTo reloop End If FSO.OpenTextFile(DBP & "habbos\" & LCase(Habbo) & "\directmail\count.txt", ForWriting).Write NewCount Result = "BFI" & VL64encode(NewCount) & VL64encode(UserID(FromUser)) & MessageDate & Chr(2) & Message & Chr(2) & Chr(1) FSO.OpenTextFile(DBP & "habbos\" & LCase(Habbo) & "\directmail\" & NewCount & ".message", ForWriting, True).Write FromUser & Chr(1) & Result For b = 1 To frmMain.SockI If LCase(Client(b).Name) = LCase(Habbo) And frmMain.socket(b).State = sckConnected Then frmMain.socket(b).SendData Result End If Next b End If End Function Public Function GetFriendStats(Index As Integer) On Error Resume Next Dim OutSend As String If FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\friendlist.txt", ForReading).AtEndOfStream = False Then Dim fslist() As String fslist = Split(Replace(FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\friendlist.txt", ForReading).ReadAll, "<", ""), ">") CCount = 0 For b = 0 To UBound(fslist) If Len(fslist(b)) > 0 Then If FSO.OpenTextFile(DBP & "habbos\" & LCase(fslist(b)) & "\consolemission.txt", ForReading).AtEndOfStream = False Then If FSO.OpenTextFile(DBP & "habbos\" & LCase(fslist(b)) & "\consolemission.txt", ForReading).ReadAll = " " Then CMISSION = "" Else CMISSION = FSO.OpenTextFile(DBP & "habbos\" & LCase(fslist(b)) & "\consolemission.txt", ForReading).ReadAll End If Else CMISSION = "" End If Updatedd = 0 For a = 1 To frmMain.SockI If Client(a).Name <> "" And LCase(Client(a).Name) = fslist(b) Then If Client(a).Hotelpos <> "" Then OutSend = OutSend & VL64encode(FSO.OpenTextFile(DBP & "habbos\" & LCase(fslist(b)) & "\num.txt", ForReading).ReadAll) & CMISSION & Chr(2) & Client(a).Hotelpos & Chr(2) Updatedd = 1 End If End If Next a If Updatedd = 0 Then OutSend = OutSend & VL64encode(FSO.OpenTextFile(DBP & "habbos\" & LCase(fslist(b)) & "\num.txt", ForReading).ReadAll) & CMISSION & Chr(2) & "H" & FSO.OpenTextFile(DBP & "habbos\" & LCase(fslist(b)) & "\lastonline.txt", ForReading).ReadAll & Chr(2) CCount = CCount + 1 End If Next b frmMain.socket(Index).SendData "@M" & VL64encode(CCount) & OutSend & Chr(1) End If End Function Public Function SendMessages(Index As Integer) Dim MessageFile As File For Each MessageFile In FSO.GetFolder(DBP & "habbos\" & LCase(Client(Index).Name) & "\directmail\").Files If Right(MessageFile, 3) <> "txt" Then frmMain.socket(Index).SendData Split(MessageFile.OpenAsTextStream(ForReading).ReadAll, Chr(1), 2)(1) End If Next End Function