VERSION 5.00 Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX" Begin VB.Form frmMain AutoRedraw = -1 'True BackColor = &H00E0E0E0& BorderStyle = 1 'Fixed Single Caption = "ShoeLace v0.1" ClientHeight = 4905 ClientLeft = 150 ClientTop = 540 ClientWidth = 4500 Icon = "frmMain.frx":0000 LinkTopic = "Form1" MaxButton = 0 'False ScaleHeight = 4905 ScaleWidth = 4500 StartUpPosition = 2 'CenterScreen Begin VB.Timer TimerDice Enabled = 0 'False Index = 0 Interval = 2000 Left = 720 Top = 3120 End Begin VB.Timer ConnectionTimer Interval = 60000 Left = 720 Top = 4080 End Begin VB.Timer TimerBotAction Enabled = 0 'False Index = 0 Interval = 10000 Left = 1200 Top = 4080 End Begin VB.Timer TimerBotUpdate Enabled = 0 'False Index = 0 Interval = 500 Left = 240 Top = 3120 End Begin VB.Timer TimerBotTalk Enabled = 0 'False Index = 0 Interval = 5000 Left = 240 Top = 4080 End Begin VB.TextBox furniture Height = 4215 Left = 2760 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 12 Text = "frmMain.frx":0CCA Top = 2880 Visible = 0 'False Width = 5775 End Begin VB.TextBox FILT Height = 285 Left = 120 TabIndex = 11 Top = 6600 Width = 2415 End Begin VB.TextBox Text2 BackColor = &H80000006& BeginProperty Font Name = "Lucida Console" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000004& Height = 285 Left = 120 TabIndex = 10 Top = 2040 Visible = 0 'False Width = 3950 End Begin VB.TextBox filterword Height = 285 Left = 120 TabIndex = 9 Text = "bobba" Top = 5880 Width = 2415 End Begin VB.ListBox ListRooms2 Height = 255 Index = 0 Left = 120 Sorted = -1 'True TabIndex = 8 Top = 6120 Visible = 0 'False Width = 2415 End Begin VB.CheckBox Check1 Appearance = 0 'Flat BackColor = &H00E0E0E0& Caption = "Foreground" ForeColor = &H80000006& Height = 195 Left = 2040 TabIndex = 7 Top = 120 Width = 1935 End Begin VB.CheckBox chkSaveChatLog Appearance = 0 'Flat BackColor = &H00E0E0E0& Caption = "Save Chatlogs" ForeColor = &H80000006& Height = 255 Left = 2040 TabIndex = 6 Top = 2520 Width = 2055 End Begin VB.TextBox chatLog BackColor = &H80000006& BeginProperty Font Name = "Lucida Console" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000005& Height = 1815 Left = 120 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 5 Top = 2880 Width = 4215 End Begin VB.CheckBox chkChatlog Appearance = 0 'Flat BackColor = &H00E0E0E0& Caption = "Chatlog" ForeColor = &H80000006& Height = 255 Left = 120 TabIndex = 4 Top = 2520 Width = 2055 End Begin VB.CheckBox chckLog Appearance = 0 'Flat BackColor = &H00E0E0E0& Caption = "Packetlog" ForeColor = &H80000006& Height = 255 Left = 120 TabIndex = 3 Top = 120 Width = 1935 End Begin VB.Timer UpdateFurni Index = 0 Interval = 1000 Left = 2160 Top = 2640 End Begin VB.Timer RollerTimer Interval = 2000 Left = 720 Top = 3600 End Begin VB.Timer PetTimer Index = 0 Interval = 500 Left = 2160 Tag = "0" Top = 3600 End Begin MSWinsockLib.Winsock socket Index = 0 Left = 240 Top = 3600 _ExtentX = 741 _ExtentY = 741 _Version = 393216 End Begin VB.Timer UseTimer Enabled = 0 'False Index = 0 Left = 240 Top = 2640 End Begin VB.Timer TimerVanish Enabled = 0 'False Index = 0 Interval = 60000 Left = 1200 Tag = "0" Top = 2640 End Begin VB.Timer TimerDrink Enabled = 0 'False Index = 0 Interval = 15000 Left = 1200 Top = 3120 End Begin VB.Timer TimerTeleport3 Enabled = 0 'False Index = 0 Interval = 1500 Left = 1680 Top = 2640 End Begin VB.Timer TimerTeleport2 Enabled = 0 'False Index = 0 Interval = 1500 Left = 2160 Top = 3120 End Begin VB.Timer TimerTeleport1 Enabled = 0 'False Index = 0 Interval = 2000 Left = 1680 Top = 4080 End Begin VB.Timer TimerGesture Enabled = 0 'False Index = 0 Interval = 5000 Left = 720 Top = 2640 End Begin VB.Timer TimerTalk Enabled = 0 'False Index = 0 Left = 1680 Top = 3120 End Begin VB.Timer TimerWave Enabled = 0 'False Index = 0 Interval = 3000 Left = 1200 Top = 3600 End Begin VB.Timer TimerUpdate Enabled = 0 'False Index = 0 Interval = 500 Left = 1680 Top = 3600 End Begin VB.ListBox ListRooms Height = 255 Index = 0 Left = 120 Sorted = -1 'True TabIndex = 0 Top = 6840 Visible = 0 'False Width = 2415 End Begin VB.TextBox txtLog BackColor = &H80000006& BeginProperty Font Name = "Lucida Console" Size = 8.25 Charset = 0 Weight = 400 Underline = 0 'False Italic = 0 'False Strikethrough = 0 'False EndProperty ForeColor = &H80000005& Height = 1815 Left = 120 Locked = -1 'True MultiLine = -1 'True ScrollBars = 2 'Vertical TabIndex = 2 Top = 480 Width = 4215 End Begin VB.TextBox CFH Height = 285 Index = 0 Left = 120 MultiLine = -1 'True TabIndex = 1 Top = 6360 Visible = 0 'False Width = 2415 End Begin VB.Menu mnuServer Caption = "Server" Begin VB.Menu mnuEnd Caption = "End" End End Begin VB.Menu mnuTools111 Caption = "Tools" Begin VB.Menu mnuTools1 Caption = "Tools" End Begin VB.Menu mnuSettings Caption = "Settings" End End Begin VB.Menu mnuInfo Caption = "?" End End Attribute VB_Name = "frmMain" Attribute VB_GlobalNameSpace = False Attribute VB_Creatable = False Attribute VB_PredeclaredId = True Attribute VB_Exposed = False Public Online As Integer Public SockI As Long Public BotI As Long Public SocketQueue As String Public FreeSockets As String Public Hpets As String Public LoadedRollers As String Public CFHs As Long Public PickedUpCalls As String Public DebugActive As Boolean Public dices As String Public Wanted As Double Private Declare Function SetWindowPos Lib "user32" (ByVal hwnd As Long, ByVal hWndInsertAfter As Long, ByVal X As Long, ByVal Y As Long, ByVal cx As Long, ByVal cy As Long, ByVal wFlags As Long) As Long Private Sub chatLog_Change() If Len(chatLog.Text) > 32000 Then chatLog.Text = "" End Sub Private Sub chckLog_Click() If frmMain.chckLog.Value = "1" Then WriteINI "server", "packetlog", "Y", SettingIni Else WriteINI "server", "packetlog", "N", SettingIni End If End Sub Private Sub chkChatlog_Click() If frmMain.chkChatlog.Value = "1" Then WriteINI "server", "chatlog", "Y", SettingIni Else WriteINI "server", "chatlog", "N", SettingIni End If End Sub Private Sub chkSaveChatLog_Click() If frmMain.chkSaveChatLog.Value = "1" Then WriteINI "server", "savechatlog", "Y", SettingIni Else WriteINI "server", "savechatlog", "N", SettingIni End If End Sub Private Sub ConnectionTimer_Timer() If SockI < 1 Then Exit Sub For u = 1 To SockI If socket(u).State = sckConnected Then If Client(u).Close = 1 Then If Client(u).InRoom > 0 Or Client(u).Publicnum > 0 Then Hab_Kick u End If Client(u).Hotelpos = "H" socket(u).Close If Client(u).Name <> "" Then Client(u).Name = "" If chckLog.Value = 1 Then If frmMain.chckLog.Value = 1 Then txtLog.Text = txtLog.Text & vbCrLf & "[" & u & "] ›› Closed" If frmMain.chckLog.Value = 1 Then txtLog.SelStart = Len(txtLog.Text) End If Else Client(u).Close = 1 socket(u).SendData "@r" & Chr(1) End If End If Next u End Sub Private Sub Form_Load() frmFirstRun.loading.Caption = "Loading interface..." Wanted = 1 DoEvents SettingIni = Replace(App.Path & "\database\configuration\settings.ini", "\\", "\") DBP = Replace(App.Path & "\database\", "\\", "\") frmFirstRun.loading.Caption = "Check database..." DoEvents If FileExists(SettingIni) = False Then MsgBox "Settings.ini konnte nicht gefunden werden, der Server wird nun beendet.", vbCritical, "Rekordis Server" End End If If ReadINI("server", "update", SettingIni) <> "3.2" Then Load frmUpdate Unload frmUpdate WriteINI "server", "update", "3.2", SettingIni End If frmFirstRun.loading.Caption = "Loading locale Texts..." If ReadINI("server", "packetlog", SettingIni) = "Y" Then frmMain.chckLog.Value = "1" Else frmMain.chckLog.Value = "0" End If If ReadINI("server", "chatlog", SettingIni) = "Y" Then frmMain.chkChatlog.Value = "1" Else frmMain.chkChatlog.Value = "0" End If If ReadINI("server", "savechatlog", SettingIni) = "Y" Then frmMain.chkSaveChatLog.Value = "1" Else frmMain.chkSaveChatLog.Value = "0" End If If ReadINI("server", "foreground", SettingIni) = "Y" Then frmMain.Check1.Value = "1" Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3) Else frmMain.Check1.Value = "0" Call SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3) End If DoEvents Call RefreshLocale ReDim Pet(0) frmFirstRun.loading.Caption = "Loading Bots and Public rooms..." DoEvents Dim fok As Folder For Each fok In FSO.GetFolder(DBP & "pub").SubFolders If IsNumeric(Dir(fok, vbDirectory)) = True And FSO.FileExists(fok & "\data.ini") = True Then If ReadINI("bot", "enabled", fok & "\data.ini") = "1" Then dat = fok & "\data.ini" nmb = BotI + 1 ReDim Preserve Bot(nmb) Bot(nmb).Num = "0" Bot(nmb).Publicnum = Dir(fok, vbDirectory) Bot(nmb).Name = ReadINI("bot", "name", dat) Bot(nmb).Mission = ReadINI("bot", "mission", dat) Bot(nmb).Figure = ReadINI("bot", "figure", dat) Bot(nmb).Look = ReadINI("bot", "look", dat) Bot(nmb).Standartlook = Bot(nmb).Look Bot(nmb).PosX = Split(Split(ReadINI("bot", "walkspace", dat), ",")(0), " ")(0) Bot(nmb).PosY = Split(Split(ReadINI("bot", "walkspace", dat), ",")(0), " ")(1) Bot(nmb).DestX = Bot(nmb).PosX Bot(nmb).DestY = Bot(nmb).PosY Bot(nmb).He = Mid(Split(FSO.OpenTextFile(fok & "\heightmap.map", ForReading).ReadAll, Chr(13))(Bot(nmb).PosY), Bot(nmb).PosX + 1, 1) If IsNumeric(Bot(nmb).He) = False Then MsgBox "Bot cant walk on the first of your 'walkspace' coordinates. Bot from Publicroom " & Bot(nmb).Publicnum & " not loaded.", vbCritical, "Server" Bot(nmb).Name = "" GoTo BotError End If Bot(nmb).Update = False Bot(nmb).Talking = False Bot(nmb).Otheraction = False Load TimerBotAction(nmb) Load TimerBotUpdate(nmb) Load TimerBotTalk(nmb) TimerBotAction(nmb).Enabled = True TimerBotUpdate(nmb).Enabled = True BotI = nmb End If End If BotError: Next frmFirstRun.loading.Caption = "Loading Winsock..." If FSO.OpenTextFile(DBP & "configuration\bobbafilter.ini", ForReading).AtEndOfStream = False Then FILT.Text = ReadINI("config", "replacement", SettingIni) & Chr(1) & FSO.OpenTextFile(DBP & "configuration\bobbafilter.ini", ForReading).ReadAll DoEvents dices = "" On Error GoTo SCKERR socket(0).LocalPort = Val(ReadINI("server", "port", SettingIni)) socket(0).Listen frmMain.txtLog.Text = frmMain.txtLog.Text + "[0] ›› " & locale("server_started_msg") & " " & socket(0).LocalPort frmMain.chatLog.Text = frmMain.chatLog.Text + "[0] ›› " & locale("server_started_msg") & " " & socket(0).LocalPort Exit Sub SCKERR: MsgBox locale("socket_error") & vbNewLine & vbNewLine & "--------" & vbNewLine & vbNewLine & Err.Description, vbCritical, "Server" End End Sub Private Sub Form_Unload(Cancel As Integer) Unload frmMain Unload frmTools Unload frmInfo End Sub Private Sub mnuDE_Click() mnuDE.Checked = True mnuUS.Checked = False mnuSe.Checked = False mnuNL.Checked = False mnuFR.Checked = False mnuES.Checked = False mnuIT.Checked = False mnuPT.Checked = False mnuExtraLang.Checked = False WriteINI "server", "lang", "DE", SettingIni Call RefreshLocale End Sub Private Sub mnuES_Click() mnuDE.Checked = False mnuUS.Checked = False mnuSe.Checked = False mnuNL.Checked = False mnuFR.Checked = False mnuES.Checked = True mnuIT.Checked = False mnuPT.Checked = False mnuExtraLang.Checked = False WriteINI "server", "lang", "ES", SettingIni Call RefreshLocale End Sub Private Sub mnuExtraLang_Click() mnuDE.Checked = False mnuUS.Checked = False mnuSe.Checked = False mnuNL.Checked = False mnuFR.Checked = False mnuES.Checked = False mnuIT.Checked = False mnuPT.Checked = False mnuExtraLang.Checked = True WriteINI "server", "lang", "EXTRA", SettingIni Call RefreshLocale End Sub Private Sub mnuFR_Click() mnuDE.Checked = False mnuUS.Checked = False mnuSe.Checked = False mnuNL.Checked = False mnuFR.Checked = True mnuES.Checked = False mnuIT.Checked = False mnuPT.Checked = False mnuExtraLang.Checked = False WriteINI "server", "lang", "FR", SettingIni Call RefreshLocale End Sub Private Sub mnuInfo_Click() frmInfo.Show End Sub Private Sub mnuIT_Click() mnuDE.Checked = False mnuUS.Checked = False mnuSe.Checked = False mnuNL.Checked = False mnuFR.Checked = False mnuES.Checked = False mnuIT.Checked = True mnuPT.Checked = False mnuExtraLang.Checked = False WriteINI "server", "lang", "IT", SettingIni Call RefreshLocale End Sub Private Sub mnuNL_Click() mnuDE.Checked = False mnuUS.Checked = False mnuSe.Checked = False mnuNL.Checked = True mnuFR.Checked = False mnuES.Checked = False mnuIT.Checked = False mnuPT.Checked = False mnuExtraLang.Checked = False WriteINI "server", "lang", "NL", SettingIni Call RefreshLocale End Sub Private Sub mnuPT_Click() mnuDE.Checked = False mnuUS.Checked = False mnuSe.Checked = False mnuNL.Checked = False mnuFR.Checked = False mnuES.Checked = False mnuIT.Checked = False mnuPT.Checked = True mnuExtraLang.Checked = False WriteINI "server", "lang", "PT", SettingIni Call RefreshLocale End Sub Private Sub mnuSE_Click() mnuDE.Checked = False mnuUS.Checked = False mnuSe.Checked = True mnuNL.Checked = False mnuFR.Checked = False mnuES.Checked = False mnuIT.Checked = False mnuPT.Checked = False mnuExtraLang.Checked = False WriteINI "server", "lang", "SE", SettingIni Call RefreshLocale End Sub Private Sub mnuSettings_Click() frmSettings.Show End Sub Private Sub mnuTools_Click() frmTools.Show End Sub Private Sub mnuTools1_Click() frmTools.Show End Sub Private Sub mnuUS_Click() mnuDE.Checked = False mnuUS.Checked = True mnuSe.Checked = False mnuNL.Checked = False mnuFR.Checked = False mnuES.Checked = False mnuIT.Checked = False mnuPT.Checked = False mnuExtraLang.Checked = False WriteINI "server", "lang", "US", SettingIni Call RefreshLocale End Sub Private Sub mnuEnd_Click() End End Sub Private Sub Check1_Click() If Check1.Value = 1 Then Call SetWindowPos(Me.hwnd, -1, 0, 0, 0, 0, 3) WriteINI "server", "foreground", "Y", SettingIni Else Call SetWindowPos(Me.hwnd, -2, 0, 0, 0, 0, 3) WriteINI "server", "foreground", "N", SettingIni End If End Sub Private Sub PetTimer_Timer(Index As Integer) On Error GoTo lol FirstHe = Pet(Index).He If PetTimer(Index).Interval > 500 Then PetTimer(Index).Interval = 500 If Pet(Index).RollerUpdate = True Then Pet(Index).RollerUpdate = False If Pet(Index).Actiontype <> "" And Pet(Index).Sleep = False And Pet(Index).Sit = False And Pet(Index).Lay = False Then extbt = extbt & Pet(Index).Actiontype & "/" End If If Pet(Index).Sit = True Then Hoogte = Replace(Pet(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "sit " & Hoogte & "/" End If If Pet(Index).Lay = True Then Hoogte = Replace(Pet(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "lay " & Hoogte & " null/" End If If Pet(Index).Sleep = True Then Hoogte = Replace(Pet(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "slp " & Hoogte & " null/" End If If Pet(Index).Gesture <> "" Then Pet(Index).Actiontype = "" extbt = extbt & "gst " & Pet(Index).Gesture & "/" End If Pet(Index).He = Replace(Pet(Index).He, ",", ".") If InStr(Pet(Index).He, ".") = 0 Then Pet(Index).He = Pet(Index).He & ".0" sendAll "@b" & Index & " " & Pet(Index).PosX & "," & Pet(Index).PosY & "," & Pet(Index).He & "," & Pet(Index).Look & "/" & extbt & Chr(13) & Chr(1), (Pet(Index).InRoom) Exit Sub End If Dim FurniLijst() As String If Pet(Index).InRoom > 0 Then Randomize Timer Pet(Index).Alive = Pet(Index).Alive + 1 Pet(Index).DrinkTimer = Pet(Index).DrinkTimer + 1 Pet(Index).EatTimer = Pet(Index).EatTimer + 1 Randomize Timer Pet(Index).TalkVal = Pet(Index).TalkVal + Int(Rnd * 5) + 1 If Pet(Index).TalkVal >= 240 Then Pet(Index).TalkVal = Int(Rnd * 20) If Split(Pet(Index).App, " ")(0) = "0" Then ' dog If Pet(Index).Sleep = False Then 'msg Berichten = Split("woof..woof;hooooowl;wooooof!;woof woof woof!!!;*sighs*;snuh...SNUUUUUH;snuuh..snuuh", ";") 'msg Else 'msg Berichten = Split("zzZZZzzz;bzz.. bzzzzz;hrrr.. hrrr;bzz.. oof oof;hrrrrr...murrmm..;Zzzzz wuff! zzzzz;*dreaming*", ";") 'msg End If ElseIf Split(Pet(Index).App, " ")(0) = "1" Then ' cat If Pet(Index).Sleep = False Then 'msg Berichten = Split("Purrrrr oow;Purrrrrrrrrr;muew..muew;meow...meOW;meow", ";") 'msg Else 'msg Berichten = Split("mrrrr...muew..mrr;hurrr..hurrr;Purrr... rrrr;mrrrr..rrrr..;hrrrrr....Mrrrrr.", ";") 'msg End If Else 'croco If Pet(Index).Sleep = False Then 'msg Berichten = Split("Tick tock tick....;*Mellow*;Rrrr....Grrrrrg....;*Buurrrrp*;*Chomp chomp*", ";") 'msg Else 'msg Berichten = Split("Mmmm... Hooks...;Rawwwwwwwwrrrm...;*Snuh snuh*;:);Frgh... Frgh...", ";") 'msg End If End If Randomize Timer Berichtnum = Int(Rnd * (UBound(Berichten) + 1)) sendAll "@X" & VL64encode(Index) & Berichten(Berichtnum) & Chr(2) & Chr(1), (Pet(Index).InRoom) End If htmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\walk.txt").ReadAll Hoogte = Replace(Pet(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" If Mid(Split(Walkmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) <> "R" And Mid(Split(htmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) & ".0" <> Hoogte And Pet(Index).Sit = False Then If Mid(Split(htmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) <> "x" Then Pet(Index).He = Mid(Split(htmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) & ".0" FirstHe = Pet(Index).He Pet(Index).Update = True End If End If If Mid(Split(Walkmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) = "R" And Replace(0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Pet(Index).PosY)), Val(Pet(Index).PosX) + 1, 1)), ",", ".") <> Hoogte And Pet(Index).Sit = False Then Pet(Index).He = Replace(0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1)), ",", ".") FirstHe = Pet(Index).He Pet(Index).Update = True End If 'roller If Mid(Split(Walkmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) = "R" Then FurniOP = ReadINI("furnies", Pet(Index).PosX & "," & Pet(Index).PosY, DBP & "privaterooms\" & Pet(Index).InRoom & "\rotation.txt") If FurniOP <> "" Then FurniType = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\type.txt", ForReading).ReadAll 'sit If FurniType = "sit" And Pet(Index).Sit = False Then Pet(Index).Sit = True Pet(Index).Lay = False Pet(Index).Update = True End If 'sit Else If Pet(Index).Sit = True Then Pet(Index).Sit = False Pet(Index).Update = True End If End If End If 'roller If Pet(Index).Sit = False And (Mid(Split(Walkmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) = "S" Or Mid(Split(Walkmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) = "L") Then Pet(Index).Sit = True Pet(Index).Update = True Pet(Index).He = Val(ReadINI("offset", Pet(Index).PosX & "," & Pet(Index).PosY, DBP & "privaterooms\" & Pet(Index).InRoom & "\rotation.txt")) ElseIf Pet(Index).Sit = False And Mid(Split(Walkmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) <> "R" Then Pet(Index).He = Mid(Split(htmp, Chr(13))(Pet(Index).PosY), Pet(Index).PosX + 1, 1) End If End If If Pet(Index).InRoom > 0 And Pet(Index).Update = False Then If Pet(Index).Eating = False And Pet(Index).Drinking = False And Pet(Index).Playing = False Then If Pet(Index).Sleep = False Then If Pet(Index).NewAction = False Then Randomize Timer PetTimer(Index).Tag = Val(PetTimer(Index).Tag) + Int((2 - 1 + 1) * Rnd) + 1 If Val(PetTimer(Index).Tag) > 10 Then Pet(Index).NewAction = True PetTimer(Index).Tag = 0 End If End If If Pet(Index).NewAction = True Then Pet(Index).NewAction = False If Pet(Index).Action = True Then Pet(Index).Action = False If Pet(Index).FindDrink = False And Pet(Index).FindFood = False And Pet(Index).FindPlay = False Then htmp = Split(FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\shtmp.txt").ReadAll, Chr(13)) PosYen = UBound(htmp) PosXen = Len(htmp(0)) + 1 htmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\walk.txt").ReadAll Randomize Timer Do PX = Int((PosXen - 1 + 1) * Rnd) + 1 PX = PX - 1 PY = Int(((PosYen + 1) - 1 + 1) * Rnd) + 1 PY = PY - 1 Loop Until Mid(Split(htmp, Chr(13))(PY), PX + 1, 1) <> "x" ElseIf Pet(Index).FindFood = True Then PX = Pet(Index).FoodX PY = Pet(Index).FoodY ElseIf Pet(Index).FindDrink = True Then PX = Pet(Index).DrinkX PY = Pet(Index).DrinkY ElseIf Pet(Index).FindPlay = True Then PX = Pet(Index).PlayX PY = Pet(Index).PlayY End If Pet(Index).DestX = PX Pet(Index).DestY = PY Pet(Index).Update = True Else Pet(Index).Gesture = "" Pet(Index).Lay = False Pet(Index).Sit = False If Split(Pet(Index).App, " ")(0) = "0" Then ' dog Randomize Timer Actie = Int((14 - 1 + 1) * Rnd) + 1 If Actie = 1 Then Pet(Index).Actiontype = "snf" Pet(Index).Action = True End If If Actie = 2 Then Pet(Index).Actiontype = "scr" Pet(Index).Action = True End If If Actie = 3 Then Pet(Index).Actiontype = "wav" Pet(Index).Action = True End If If Actie = 4 Then Pet(Index).Gesture = "sml" Pet(Index).Action = True End If If Actie = 5 Then Pet(Index).Sit = True Pet(Index).Action = True End If If Actie = 6 Then Pet(Index).Lay = True Pet(Index).Action = True End If If Actie = 7 Then Pet(Index).Gesture = "joy" Pet(Index).Action = True End If If Actie = 8 Then Pet(Index).Actiontype = "rdy" Pet(Index).Action = True End If If Actie = 9 Then Pet(Index).Actiontype = "jmp" Pet(Index).Action = True End If If Actie = 10 Then Pet(Index).Gesture = "sad" Pet(Index).Action = True End If If Actie = 11 Then Pet(Index).Gesture = "tng" Pet(Index).Action = True End If If Actie = 12 Then 'find ball :) BallIds = "" furni = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\furni.txt").ReadAll FurniLijst() = Split(furni, ";") For a = 0 To UBound(FurniLijst) If FurniLijst(a) <> "" Then Fname = FSO.OpenTextFile(DBP & "furni\" & FurniLijst(a) & "\name.txt", ForReading).ReadAll If InStr(Fname, "toy1") = 1 Then BallIds = BallIds & ";" & FurniLijst(a) End If End If Next a If BallIds <> "" Then BallIds = Split(BallIds, ";") Dichtsbij = 0 Afstand = 9999 'find nearest ball For Q = 1 To UBound(BallIds) Fx = Split(FSO.OpenTextFile(DBP & "furni\" & BallIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & BallIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(1) Af2stand = Int(Math.Sqr(((Fx - Pet(Index).PosX) ^ 2) + ((Fy - Pet(Index).PosY) ^ 2))) If Af2stand < Afstand Then Afstand = Af2stand Dichtsbij = Q End If Next Q 'find nearest ball BallID = BallIds(Dichtsbij) If FSO.FolderExists(DBP & "furni\" & BallID) Then Fx = Split(FSO.OpenTextFile(DBP & "furni\" & BallID & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & BallID & "\loc.txt", ForReading).ReadAll, " ")(1) Fvar = FSO.OpenTextFile(DBP & "furni\" & BallID & "\var.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & BallID & "\name.txt", ForReading).ReadAll Pet(Index).NewAction = True Pet(Index).Action = True Pet(Index).FindPlay = True Pet(Index).PlayX = Val(Fx) Pet(Index).PlayY = Val(Fy) Pet(Index).PlayID = Val(BallID) Pet(Index).Update = True End If End If 'fghfgh End If If Actie > 12 Then Pet(Index).Sit = True Pet(Index).Action = True End If Else ' cat Randomize Timer Actie = Int((13 - 1 + 1) * Rnd) + 1 If Actie = 1 Then Pet(Index).Sit = True Pet(Index).Action = True End If If Actie = 2 Then Pet(Index).Gesture = "sml" Pet(Index).Action = True End If If Actie = 3 Then Pet(Index).Sit = True Pet(Index).Action = True End If If Actie = 4 Then Pet(Index).Lay = True Pet(Index).Action = True End If If Actie = 5 Then Pet(Index).Gesture = "joy" Pet(Index).Action = True End If If Actie = 6 Then Pet(Index).Actiontype = "rdy" Pet(Index).Action = True End If If Actie = 7 Then Pet(Index).Gesture = "sad" Pet(Index).Action = True End If If Actie = 8 Then Pet(Index).Gesture = "tng" Pet(Index).Action = True End If If Actie = 9 Then Pet(Index).Actiontype = "bnd" Pet(Index).Action = True End If If Actie = 10 Then Pet(Index).Gesture = "puz" Pet(Index).Action = True End If If Actie = 11 Then 'find ball :) BallIds = "" furni = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\furni.txt").ReadAll FurniLijst() = Split(furni, ";") For a = 0 To UBound(FurniLijst) If FurniLijst(a) <> "" Then Fname = FSO.OpenTextFile(DBP & "furni\" & FurniLijst(a) & "\name.txt", ForReading).ReadAll If InStr(Fname, "toy1") = 1 Then BallIds = BallIds & ";" & FurniLijst(a) End If End If Next a If BallIds <> "" Then BallIds = Split(BallIds, ";") Dichtsbij = 0 Afstand = 9999 'find nearest ball For Q = 1 To UBound(BallIds) Fx = Split(FSO.OpenTextFile(DBP & "furni\" & BallIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & BallIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(1) Af2stand = Int(Math.Sqr(((Fx - Pet(Index).PosX) ^ 2) + ((Fy - Pet(Index).PosY) ^ 2))) If Af2stand < Afstand Then Afstand = Af2stand Dichtsbij = Q End If Next Q 'find nearest ball BallID = BallIds(Dichtsbij) If FSO.FolderExists(DBP & "furni\" & BallID) Then Fx = Split(FSO.OpenTextFile(DBP & "furni\" & BallID & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & BallID & "\loc.txt", ForReading).ReadAll, " ")(1) Fvar = FSO.OpenTextFile(DBP & "furni\" & BallID & "\var.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & BallID & "\name.txt", ForReading).ReadAll Pet(Index).NewAction = True Pet(Index).Action = True Pet(Index).FindPlay = True Pet(Index).PlayX = Val(Fx) Pet(Index).PlayY = Val(Fy) Pet(Index).PlayID = Val(BallID) Pet(Index).Update = True End If End If 'fghfgh End If If Actie > 11 Then Pet(Index).Sit = True Pet(Index).Action = True End If End If If Pet(Index).Alive > 1200 Then Pet(Index).Sleep = True Pet(Index).SleepTimer = 0 Pet(Index).Action = False Pet(Index).Gesture = "" Pet(Index).SleepDuration = Int((600 - 240 + 1) * Rnd) + 240 Pet(Index).Update = True End If WaterIds = "" FoodIds = "" 'find food If Pet(Index).EatTimer > 600 Then 'find food furni = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\furni.txt").ReadAll FurniLijst() = Split(furni, ";") For a = 0 To UBound(FurniLijst) If FurniLijst(a) <> "" Then Fname = FSO.OpenTextFile(DBP & "furni\" & FurniLijst(a) & "\name.txt", ForReading).ReadAll If Split(Pet(Index).App, " ")(0) = "0" Then ' dog If Fname = "petfood1" Or Fname = "petfood3" Or InStr(Fname, "goodie1") = 1 Then FoodIds = FoodIds & ";" & FurniLijst(a) End If Else 'cat If Fname = "petfood2" Or Fname = "petfood3" Or Fname = "goodie2" Then FoodIds = FoodIds & ";" & FurniLijst(a) End If End If End If Next a 'find food If FoodIds <> "" Then FoodIds = Split(FoodIds, ";") Dichtsbij = 0 Afstand = 9999 'find nearest food For Q = 1 To UBound(FoodIds) Fx = Split(FSO.OpenTextFile(DBP & "furni\" & FoodIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & FoodIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(1) Af2stand = Int(Math.Sqr(((Fx - Pet(Index).PosX) ^ 2) + ((Fy - Pet(Index).PosY) ^ 2))) If Af2stand < Afstand Then Afstand = Af2stand Dichtsbij = Q End If Next Q 'find nearest food FoodID = FoodIds(Dichtsbij) If FSO.FolderExists(DBP & "furni\" & FoodID) Then Fx = Split(FSO.OpenTextFile(DBP & "furni\" & FoodID & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & FoodID & "\loc.txt", ForReading).ReadAll, " ")(1) Fvar = FSO.OpenTextFile(DBP & "furni\" & FoodID & "\var.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & FoodID & "\name.txt", ForReading).ReadAll If Fvar <> "PA" Or Fname <> "petfood2" Then Pet(Index).FindFood = True Pet(Index).FoodX = Val(Fx) Pet(Index).FoodY = Val(Fy) Pet(Index).FoodID = Val(FoodID) Pet(Index).Update = True End If End If End If End If 'find food 'find drink If Pet(Index).DrinkTimer > 600 Then WaterIds = "" 'find food furni = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\furni.txt").ReadAll FurniLijst() = Split(furni, ";") For a = 0 To UBound(FurniLijst) If FurniLijst(a) <> "" Then Fname = FSO.OpenTextFile(DBP & "furni\" & FurniLijst(a) & "\name.txt", ForReading).ReadAll If InStr(Fname, "waterbowl") = 1 Then Fx = Split(FSO.OpenTextFile(DBP & "furni\" & FurniLijst(a) & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & FurniLijst(a) & "\loc.txt", ForReading).ReadAll, " ")(1) Fvar = FSO.OpenTextFile(DBP & "furni\" & FurniLijst(a) & "\var.txt", ForReading).ReadAll If Fvar <> "H" Then WaterIds = WaterIds & ";" & FurniLijst(a) End If End If End If Next a 'find food If WaterIds <> "" Then WaterIds = Split(WaterIds, ";") Dichtsbij = 0 Afstand = 9999 'find nearest food For Q = 1 To UBound(WaterIds) Fx = Split(FSO.OpenTextFile(DBP & "furni\" & WaterIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & WaterIds(Q) & "\loc.txt", ForReading).ReadAll, " ")(1) Af2stand = Int(Math.Sqr(((Fx - Pet(Index).PosX) ^ 2) + ((Fy - Pet(Index).PosY) ^ 2))) If Af2stand < Afstand Then Afstand = Af2stand Dichtsbij = Q End If Next Q 'find nearest food WaterID = WaterIds(Dichtsbij) Fx = Split(FSO.OpenTextFile(DBP & "furni\" & WaterID & "\loc.txt", ForReading).ReadAll, " ")(0) Fy = Split(FSO.OpenTextFile(DBP & "furni\" & WaterID & "\loc.txt", ForReading).ReadAll, " ")(1) Pet(Index).FindDrink = True Pet(Index).DrinkX = Val(Fx) Pet(Index).DrinkY = Val(Fy) Pet(Index).DrinkID = Val(WaterID) Pet(Index).Update = True End If 'find drink End If End If End If Else Pet(Index).SleepTimer = Pet(Index).SleepTimer + 1 If Pet(Index).SleepTimer >= Pet(Index).SleepDuration Then Pet(Index).Sleep = False Pet(Index).Alive = 0 Pet(Index).Update = True Pet(Index).NewAction = True End If End If Else 'drink If Pet(Index).Drinking = True Then Frr = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).DrinkID & "\loc.txt", ForReading).ReadAll, " ")(2) Pet(Index).Look = Frr & "," & Frr Pet(Index).Update = True Pet(Index).DrinkVal = Pet(Index).DrinkVal + 1 If Pet(Index).DrinkVal = 6 Then Pet(Index).Drinking = False Pet(Index).DrinkTimer = 0 Pet(Index).Gesture = "" Pet(Index).Update = True Fvar = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).DrinkID & "\var.txt", ForReading).ReadAll Fvar = Val(VL64Decode(Fvar)) - 1 If Fvar < 0 Then Fvar = 0 FSO.OpenTextFile(DBP & "furni\" & Pet(Index).DrinkID & "\var.txt", ForWriting).Write VL64encode(Fvar) sendAll "AX" & Pet(Index).DrinkID & Chr(2) & Fvar & Chr(2) & Chr(1), (Pet(Index).InRoom) End If End If 'drink 'eat If Pet(Index).Eating = True Then Frr = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).FoodID & "\loc.txt", ForReading).ReadAll, " ")(2) Fname = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).FoodID & "\name.txt", ForReading).ReadAll Pet(Index).Look = Frr & "," & Frr Pet(Index).Update = True Pet(Index).EatVal = Pet(Index).EatVal + 1 If Pet(Index).EatVal = 6 Then Pet(Index).Eating = False Pet(Index).EatTimer = 0 Pet(Index).Gesture = "" Pet(Index).Update = True Fvar = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).FoodID & "\var.txt", ForReading).ReadAll Fvar = Val(VL64Decode(Fvar)) + 1 If InStr(Fname, "goodie") = 1 Then Fvar = 5 If VL64encode(Fvar) <> "QA" Or Fname = "petfood2" Then FSO.OpenTextFile(DBP & "furni\" & Pet(Index).FoodID & "\var.txt", ForWriting).Write VL64encode(Fvar) sendAll "AX" & Pet(Index).FoodID & Chr(2) & Fvar & Chr(2) & Chr(1), (Pet(Index).InRoom) Else sendAll "A^" & Pet(Index).FoodID & Chr(1), (Pet(Index).InRoom) NewLijst = ";" Lijst2 = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\furni.txt", ForReading).ReadAll Lijst = Split(Lijst2, ";") For a = 0 To UBound(Lijst) If Lijst(a) <> "" And Lijst(a) <> Pet(Index).FoodID Then NewLijst = NewLijst & ";" & Lijst(a) Next a NewLijst = Replace(NewLijst, ";;", ";") FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\furni.txt", ForWriting).Write NewLijst End If End If End If 'eat 'play If Pet(Index).Playing = True Then Frr = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\loc.txt", ForReading).ReadAll, " ")(2) Fname = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\name.txt", ForReading).ReadAll Pet(Index).Look = Frr & "," & Frr Pet(Index).Update = True Pet(Index).PlayVal = Pet(Index).PlayVal + 1 If Pet(Index).PlayVal = 6 Then Pet(Index).Playing = False Pet(Index).Actiontype = "" Pet(Index).Action = True Pet(Index).Update = True Fvar = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\var.txt", ForReading).ReadAll FCol = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\cust.txt", ForReading).ReadAll, Chr(30))(2) Var = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\var.txt", ForReading).ReadAll FHeight = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\height.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\name.txt", ForReading).ReadAll Custt = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\cust.txt", ForReading).ReadAll loca = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\loc.txt", ForReading).ReadAll, " ") Custsplit = Split(Custt, "") Fx = Val(loca(0)) Fy = Val(loca(1)) Frot = Val(loca(2)) sendAll "A_" & Pet(Index).PlayID & Chr(2) & Fname & Chr(2) & VL64encode(Fx) & VL64encode(Fy) & VL64encode(Custsplit(0)) & VL64encode(Custsplit(1)) & VL64encode(Frot) & FHeight & ".0" & Chr(2) & FCol & Chr(2) & Chr(2) & Var & Chr(2) & Chr(1), (Pet(Index).InRoom) End If End If 'play End If End If If Pet(Index).InRoom > 0 And Pet(Index).Update = True Then UpDateAan = False If Pet(Index).DestX <> Pet(Index).PosX Or Pet(Index).DestY <> Pet(Index).PosY Then Pet(Index).Update = True htmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\walk.txt").ReadAll NwP = findPathpet(Index, Pet(Index).PosX, Pet(Index).PosY, Pet(Index).DestX, Pet(Index).DestY, Pet(Index).InRoom, (Walkmp), (htmp)) If NwP = "NoPath" Then If (Pet(Index).PosX <> Pet(Index).DrinkX Or Pet(Index).PosY <> Pet(Index).DrinkY) And Pet(Index).FindDrink = True Then Pet(Index).FindDrink = False Pet(Index).FindFood = False Pet(Index).FindPlay = False Pet(Index).Action = True Pet(Index).NewAction = True Pet(Index).Update = False End If If (Pet(Index).PosX <> Pet(Index).FoodX Or Pet(Index).PosY <> Pet(Index).FoodY) And Pet(Index).FindFood = True Then Pet(Index).FindFood = False Pet(Index).FindDrink = False Pet(Index).FindPlay = False Pet(Index).Action = True Pet(Index).NewAction = True Pet(Index).Update = False End If If (Pet(Index).PosX <> Pet(Index).PlayX Or Pet(Index).PosY <> Pet(Index).PlayY) And Pet(Index).FindPlay = True Then Pet(Index).FindFood = False Pet(Index).FindDrink = False Pet(Index).FindPlay = False Pet(Index).Action = True Pet(Index).NewAction = True Pet(Index).Update = False End If If Pet(Index).DestX = Pet(Index).FoodX And Pet(Index).DestY = Pet(Index).FoodY And Pet(Index).FindFood = True Then Pet(Index).FindFood = False If Pet(Index).DestX = Pet(Index).DrinkX And Pet(Index).DestY = Pet(Index).DrinkY And Pet(Index).FindDrink = True Then Pet(Index).FindDrink = False If Pet(Index).DestX = Pet(Index).PlayX And Pet(Index).DestY = Pet(Index).PlayY And Pet(Index).FindPlay = True Then Pet(Index).FindPlay = False Pet(Index).DestX = Pet(Index).PosX Pet(Index).DestY = Pet(Index).PosY NwP = Pet(Index).PosX & "," & Pet(Index).PosY Else Pet(Index).Sit = False Pet(Index).Lay = False extbt = extbt & "mv " & NwP & "," & Pet(Index).He & "/" End If End If htmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & Pet(Index).InRoom & "\walk.txt").ReadAll If Pet(Index).DestX = Pet(Index).PosX And Pet(Index).DestY = Pet(Index).PosY Then Pet(Index).Update = False If Pet(Index).DestX = Pet(Index).NestX And Pet(Index).DestY = Pet(Index).NestY And Pet(Index).DestNestLay = True Then PetTimer(Index).Tag = -30 Pet(Index).DestY = Pet(Index).PosY Pet(Index).DestX = Pet(Index).PosX Pet(Index).Gesture = "" Pet(Index).Lay = True Pet(Index).Sit = False Pet(Index).Actiontype = "" Pet(Index).Action = True End If If Pet(Index).DestX = Pet(Index).FoodX And Pet(Index).DestY = Pet(Index).FoodY And Pet(Index).FindFood = True Then Pet(Index).FindFood = False Fvar = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).FoodID & "\var.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).FoodID & "\name.txt", ForReading).ReadAll If Fvar <> "PA" Or Fname <> "petfood2" Then 'eat! Pet(Index).Gesture = "eat" 'BERICHT Pet(Index).TalkVal = 0 If Split(Pet(Index).App, " ")(0) = "0" Then ' dog 'msg Berichten = Split("Mmmmm..;hrum, umm, umm grrr;slurp, slurp, slurp;crunch, crunch mmmm;hrum, hrum, crunch!", ";") 'msg Else ' cat 'msg Berichten = Split("*munch, munch*;lap, lap, lap, lap;mmm...thumm, thumm", ";") 'msg End If Randomize Timer Berichtnum = Int(Rnd * (UBound(Berichten) + 1)) sendAll "@X" & VL64encode(Index) & Berichten(Berichtnum) & Chr(2) & Chr(1), (Pet(Index).InRoom) 'BERICHT Pet(Index).EatVal = 0 Pet(Index).Eating = True Frr = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).FoodID & "\loc.txt", ForReading).ReadAll, " ")(2) Pet(Index).Look = Frr & "," & Frr Pet(Index).Update = True 'eat! End If End If If Pet(Index).DestX = Pet(Index).DrinkX And Pet(Index).DestY = Pet(Index).DrinkY And Pet(Index).FindDrink = True Then Pet(Index).FindDrink = False Fvar = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).DrinkID & "\var.txt", ForReading).ReadAll If Fvar <> "H" Then 'drink 'BERICHT Pet(Index).TalkVal = 0 If Split(Pet(Index).App, " ")(0) = "0" Then ' dog 'msg Berichten = Split("Mmmmm..;hrum, umm, umm grrr;slurp, slurp, slurp;crunch, crunch mmmm;hrum, hrum, crunch!", ";") 'msg Else ' cat 'msg Berichten = Split("*munch, munch*;lap, lap, lap, lap;mmm...thumm, thumm", ";") 'msg End If Randomize Timer Berichtnum = Int(Rnd * (UBound(Berichten) + 1)) sendAll "@X" & VL64encode(Index) & Berichten(Berichtnum) & Chr(2) & Chr(1), (Pet(Index).InRoom) 'BERICHT Pet(Index).Gesture = "eat" Pet(Index).DrinkVal = 0 Pet(Index).Drinking = True Frr = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).DrinkID & "\loc.txt", ForReading).ReadAll, " ")(2) Pet(Index).Look = Frr & "," & Frr Pet(Index).Update = True 'drink End If End If 'play If Pet(Index).DestX = Pet(Index).PlayX And Pet(Index).DestY = Pet(Index).PlayY And Pet(Index).FindPlay = True Then Pet(Index).FindPlay = False Fvar = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\var.txt", ForReading).ReadAll FCol = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\cust.txt", ForReading).ReadAll, Chr(30))(2) Var = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\var.txt", ForReading).ReadAll FHeight = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\height.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\name.txt", ForReading).ReadAll Custt = FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\cust.txt", ForReading).ReadAll loca = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\loc.txt", ForReading).ReadAll, " ") Custsplit = Split(Custt, "") Fx = Val(loca(0)) Fy = Val(loca(1)) Frot = Val(loca(2)) sendAll "A_" & Pet(Index).PlayID & Chr(2) & Fname & Chr(2) & VL64encode(Fx) & VL64encode(Fy) & VL64encode(Custsplit(0)) & VL64encode(Custsplit(1)) & VL64encode(Frot) & FHeight & ".0" & Chr(2) & FCol & Chr(2) & "1" & Chr(2) & Var & Chr(2) & Chr(1), (Pet(Index).InRoom) Pet(Index).Actiontype = "pla" Pet(Index).PlayVal = 0 Pet(Index).Playing = True Frr = Split(FSO.OpenTextFile(DBP & "furni\" & Pet(Index).PlayID & "\loc.txt", ForReading).ReadAll, " ")(2) Pet(Index).Look = Frr & "," & Frr Pet(Index).Update = True End If 'play End If If Pet(Index).Actiontype <> "" And Pet(Index).Sleep = False And Pet(Index).Sit = False And Pet(Index).Lay = False Then extbt = extbt & Pet(Index).Actiontype & "/" End If If Pet(Index).Sit = True Then Hoogte = Replace(Pet(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "sit " & Hoogte & "/" End If If Pet(Index).Lay = True Then Hoogte = Replace(Pet(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "lay " & Hoogte & " null/" End If If Pet(Index).Sleep = True Then Hoogte = Replace(Pet(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "slp " & Hoogte & " null/" End If If Pet(Index).Gesture <> "" Then Pet(Index).Actiontype = "" extbt = extbt & "gst " & Pet(Index).Gesture & "/" End If FirstHe = Replace(FirstHe, ",", ".") If InStr(FirstHe, ".") = 0 Then FirstHe = FirstHe & ".0" sendAll "@b" & Index & " " & Pet(Index).PosX & "," & Pet(Index).PosY & "," & FirstHe & "," & Pet(Index).Look & "/" & extbt & Chr(13) & Chr(1), (Pet(Index).InRoom) If NwP <> "" Then Pet(Index).PosX = Split(NwP, ",")(0) Pet(Index).PosY = Split(NwP, ",")(1) End If End If lol: End Sub Private Sub RollerTimer_Timer() On Error GoTo lol Gehad = "" SplitRoll = Split(Replace(LoadedRollers, ">", ""), "<") For Q = 0 To UBound(SplitRoll) If SplitRoll(Q) <> "" Then NuFurni = 0 UpdateFurni2 = 0 Index = Val(SplitRoll(Q)) Gehad = Gehad & "<" & Index & ">" 'On Error GoTo Errr Packet = "" loca = Split(FSO.OpenTextFile(DBP & "furni\" & Index & "\loc.txt", ForReading).ReadAll, " ") InRoom = FSO.OpenTextFile(DBP & "furni\" & Index & "\inroom.txt", ForReading).ReadAll FurniOP = ReadINI("furnies", loca(0) & "," & loca(1), DBP & "privaterooms\" & InRoom & "\rotation.txt") If FurniOP <> "" Then Loca2 = Split(FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\loc.txt", ForReading).ReadAll, " ") Sitheight = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\sitheight.txt", ForReading).ReadAll Hadd = Val(ReadINI("had", loca(0) & "," & loca(1), DBP & "privaterooms\" & InRoom & "\rotation.txt")) FType = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\type.txt", ForReading).ReadAll NuFurni = FurniOP If Hadd = 0 Then Hadd = 999999 If InStr(Gehad, "<" & Hadd & ">") = 0 Then If loca(2) = 2 Then BijX = 1 BijY = 0 End If If loca(2) = 4 Then BijX = 0 BijY = 1 End If If loca(2) = 6 Then BijX = -1 BijY = 0 End If If loca(2) = 0 Then BijX = 0 BijY = -1 End If htmp = FSO.OpenTextFile(DBP & "privaterooms\" & InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & InRoom & "\walk.txt").ReadAll NoHabbo = 1 For b = 1 To frmMain.SockI If Client(b).InRoom = InRoom Then If Client(b).PosX = Val(Loca2(0)) + BijX And Client(b).PosY = Val(Loca2(1)) + BijY Then NoHabbo = 0 End If Next b splitP = Split(frmMain.Hpets, ";") For b = 0 To UBound(splitP) If splitP(b) <> "" Then If Pet(splitP(b)).InRoom = InRoom Then If Pet(splitP(b)).PosX = Val(Loca2(0)) + BijX And Pet(splitP(b)).PosY = Val(Loca2(1)) + BijY Then NoHabbo = 0 End If End If Next b If NoHabbo = 1 Then If Mid(Split(Walkmp, Chr(13))(Val(Loca2(1)) + BijY), Val(Loca2(0)) + BijX + 1, 1) = "O" Then NewH = Mid(Split(htmp, Chr(13))(Val(Loca2(1)) + BijY), Val(Loca2(0)) + BijX + 1, 1) FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\height.txt", ForWriting).Write NewH StarttH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Loca2(1)) + BijY), Val(Loca2(0)) + BijX + 1, 1)) StarttH = Replace(StarttH, ",", ".") If InStr(StarttH, ".") = 0 Then StarttH = StarttH & ".0" Packet = Packet & "Cf" & VL64encode(Loca2(0)) & VL64encode(Loca2(1)) & VL64encode(Val(Loca2(0)) + BijX) & VL64encode(Val(Loca2(1)) + BijY) & "I" & VL64encode(FurniOP) & StarttH & Chr(2) & NewH & Chr(2) & VL64encode(Index) & Chr(1) WriteINI "furnies", Loca2(0) & "," & Loca2(1), "", DBP & "privaterooms\" & InRoom & "\rotation.txt" 'JAJAJAWriteINI "furnies", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, FurniOP, DBP & "privaterooms\" & InRoom & "\rotation.txt" FFType = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\type.txt", ForReading).ReadAll FFVar = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\var.txt", ForReading).ReadAll FFInRoom = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\inroom.txt", ForReading).ReadAll Doen = "O" If FFType = "sit" Then Doen = "S" If FFType = "bed" Then Doen = "L" If FFType = "solid" Then Doen = "X" If FFType = "door" Then If InStr(FFVar, "O") Then Doen = "D" Else Doen = "X" End If End If Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & FFInRoom & "\walk.txt", ForReading).ReadAll Walksplit = Split(Walkmp, Chr(13)) Walksplit(Val(Loca2(1)) + BijY) = Mid(Walksplit(Val(Loca2(1)) + BijY), 1, Val(Loca2(0)) + BijX) & Doen & Mid(Walksplit(Val(Loca2(1)) + BijY), Val(Loca2(0)) + BijX + 2) Walkmp = Join(Walksplit, Chr(13)) WriteWalk = 1 WalkRoom = FFInRoom Walkmp2 = Walkmp FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\loc.txt", ForWriting).Write Val(Loca2(0)) + BijX & " " & Val(Loca2(1)) + BijY & " " & Loca2(2) WriteINI "rotation", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, Loca2(2) & "," & Loca2(2), DBP & "privaterooms\" & InRoom & "\rotation.txt" WriteINI "offset", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, Sitheight, DBP & "privaterooms\" & InRoom & "\rotation.txt" UpdateID2 = FurniOP ElseIf Mid(Split(Walkmp, Chr(13))(Val(Loca2(1)) + BijY), Val(Loca2(0)) + BijX + 1, 1) = "R" Then FurniOP2 = ReadINI("furnies", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, DBP & "privaterooms\" & InRoom & "\rotation.txt") If FurniOP2 = "" Then NewH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Loca2(1)) + BijY), Val(Loca2(0)) + BijX + 1, 1)) NewH = Replace(NewH, ",", ".") If InStr(NewH, ".") = 0 Then NewH = NewH & ".0" FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\height.txt", ForWriting).Write NewH FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\loc.txt", ForWriting).Write Val(Loca2(0)) + BijX & " " & Val(Loca2(1)) + BijY & " " & Loca2(2) Packet = Packet & "Cf" & VL64encode(Loca2(0)) & VL64encode(Loca2(1)) & VL64encode(Val(Loca2(0)) + BijX) & VL64encode(Val(Loca2(1)) + BijY) & "I" & VL64encode(FurniOP) & NewH & Chr(2) & NewH & Chr(2) & VL64encode(Index) & Chr(1) WriteINI "furnies", Loca2(0) & "," & Loca2(1), "", DBP & "privaterooms\" & InRoom & "\rotation.txt" WriteINI "had", Loca2(0) & "," & Loca2(1), 0, DBP & "privaterooms\" & InRoom & "\rotation.txt" WriteINI "furnies", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, FurniOP, DBP & "privaterooms\" & InRoom & "\rotation.txt" WriteINI "had", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, Index, DBP & "privaterooms\" & InRoom & "\rotation.txt" WriteINI "rotation", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, Loca2(2) & "," & Loca2(2), DBP & "privaterooms\" & InRoom & "\rotation.txt" WriteINI "offset", Val(Loca2(0)) + BijX & "," & Val(Loca2(1)) + BijY, Sitheight, DBP & "privaterooms\" & InRoom & "\rotation.txt" UpdateID2 = FurniOP End If End If End If Else WriteINI "had", Loca2(0) & "," & Loca2(1), 0, DBP & "privaterooms\" & InRoom & "\rotation.txt" End If End If For b = 1 To frmMain.SockI If Client(b).InRoom = InRoom Then If Client(b).PosX = Val(loca(0)) And Client(b).PosY = Val(loca(1)) Then Hadd = Client(b).Hadd If Hadd = 0 Then Hadd = 999999 If InStr(Gehad, "<" & Hadd & ">") = 0 Then If loca(2) = 2 Then BijX = 1 BijY = 0 End If If loca(2) = 4 Then BijX = 0 BijY = 1 End If If loca(2) = 6 Then BijX = -1 BijY = 0 End If If loca(2) = 0 Then BijX = 0 BijY = -1 End If htmp = FSO.OpenTextFile(DBP & "privaterooms\" & InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & InRoom & "\walk.txt").ReadAll NoHabbo = 1 For ba = 1 To frmMain.SockI If Client(ba).InRoom = InRoom Then If Client(ba).PosX = Val(Client(b).PosX) + BijX And Client(ba).PosY = Val(Client(b).PosY) + BijY Then NoHabbo = 0 End If Next ba splitP = Split(frmMain.Hpets, ";") For ba = 0 To UBound(splitP) If splitP(ba) <> "" Then If Pet(splitP(ba)).InRoom = InRoom Then If Pet(splitP(ba)).PosX = Val(Client(b).PosX) + BijX And Pet(splitP(ba)).PosY = Val(Client(b).PosY) + BijY Then NoHabbo = 0 End If End If Next ba If NoHabbo = 1 Then If Mid(Split(Walkmp, Chr(13))(Val(Client(b).PosY) + BijY), Val(Client(b).PosX) + BijX + 1, 1) = "O" Then NewH = Mid(Split(htmp, Chr(13))(Val(Client(b).PosY) + BijY), Val(Client(b).PosX) + BijX + 1, 1) VanH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Client(b).PosY) + BijY), Val(Client(b).PosX) + BijX + 1, 1)) NaarH = Mid(Split(htmp, Chr(13))(Val(Client(b).PosY) + BijY), Val(Client(b).PosX) + BijX + 1, 1) If Client(b).Sit Or Client(b).Lay = True Then NaarH = Val(NaarH) + Val(ReadINI("offset", Client(b).PosX & "," & Client(b).PosY, DBP & "privaterooms\" & Client(b).InRoom & "\rotation.txt")) - 1 NaarH = Replace(NaarH, ",", ".") If InStr(VanH, ".") = 0 Then VanH = VanH & ".0" VanH = Val(NaarH) + Val(ReadINI("offset", Client(b).PosX & "," & Client(b).PosY, DBP & "privaterooms\" & Client(b).InRoom & "\rotation.txt")) - 1 VanH = Replace(NaarH, ",", ".") If InStr(VanH, ".") = 0 Then VanH = VanH & ".0" End If Client(b).Hadd = Index 'Client(b).RollerUpdate = True 'TimerUpdate_Timer (b) If Packet = "" Then Packet = Packet & "Cf" & VL64encode(Client(b).PosX) & VL64encode(Client(b).PosY) & VL64encode(Client(b).PosX + BijX) & VL64encode(Client(b).PosY + BijY) & "H" & VL64encode(Index) & "J" & VL64encode(Client(b).Num) & VanH & Chr(2) & NaarH & Chr(2) & Chr(1) Else Packet = Mid(Packet, 1, Len(Packet) - 1) Packet = Packet & "J" & VL64encode(Client(b).Num) & VanH & Chr(2) & NaarH & Chr(2) & Chr(1) End If Client(b).PosX = Client(b).PosX + BijX Client(b).PosY = Client(b).PosY + BijY Client(b).He = NewH Client(b).DestX = Client(b).PosX Client(b).DestY = Client(b).PosY ElseIf Mid(Split(Walkmp, Chr(13))(Val(Client(b).PosY) + BijY), Val(Client(b).PosX) + BijX + 1, 1) = "R" Then FurniOP2 = ReadINI("furnies", Val(Client(b).PosX) + BijX & "," & Val(Client(b).PosY) + BijY, DBP & "privaterooms\" & InRoom & "\rotation.txt") ToeStaan = 0 If FurniOP2 = "" Then ToeStaan = 1 Else If FurniOP2 = NuFurni Then ToeStaan = 1 End If If ToeStaan = 1 Then NewH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Client(b).PosY) + BijY), Val(Client(b).PosX) + BijX + 1, 1)) NaarH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Client(b).PosY) + BijY), Val(Client(b).PosX) + BijX + 1, 1)) If Client(b).Sit Or Client(b).Lay = True Then NaarH = Val(NaarH) + Val(ReadINI("offset", Client(b).PosX & "," & Client(b).PosY, DBP & "privaterooms\" & Client(b).InRoom & "\rotation.txt")) - 1 End If NaarH = Replace(NaarH, ",", ".") If InStr(NaarH, ".") = 0 Then NaarH = NaarH & ".0" Client(b).Hadd = Index 'Client(b).RollerUpdate = True 'TimerUpdate_Timer (b) If Packet = "" Then Packet = Packet & "Cf" & VL64encode(Client(b).PosX) & VL64encode(Client(b).PosY) & VL64encode(Client(b).PosX + BijX) & VL64encode(Client(b).PosY + BijY) & "H" & VL64encode(Index) & "J" & VL64encode(Client(b).Num) & NaarH & Chr(2) & NaarH & Chr(2) & Chr(1) Else Packet = Mid(Packet, 1, Len(Packet) - 1) Packet = Packet & "J" & VL64encode(Client(b).Num) & NaarH & Chr(2) & NaarH & Chr(2) & Chr(1) End If Client(b).PosX = Client(b).PosX + BijX Client(b).PosY = Client(b).PosY + BijY Client(b).He = NewH Client(b).DestX = Client(b).PosX Client(b).DestY = Client(b).PosY End If End If End If TimerUpdate(b).Enabled = False TimerUpdate(b).Interval = 1000 TimerUpdate(b).Enabled = True Client(b).Update = True Exit For Else Client(b).Hadd = 0 End If End If End If Next b splitP = Split(frmMain.Hpets, ";") For bx = 1 To UBound(splitP) If splitP(bx) <> "" Then b = Val(splitP(bx)) If Pet(b).InRoom = InRoom Then If Pet(b).PosX = Val(loca(0)) And Pet(b).PosY = Val(loca(1)) Then Hadd = Pet(b).Hadd If Hadd = 0 Then Hadd = 999999 If InStr(Gehad, "<" & Hadd & ">") = 0 Then If loca(2) = 2 Then BijX = 1 BijY = 0 End If If loca(2) = 4 Then BijX = 0 BijY = 1 End If If loca(2) = 6 Then BijX = -1 BijY = 0 End If If loca(2) = 0 Then BijX = 0 BijY = -1 End If htmp = FSO.OpenTextFile(DBP & "privaterooms\" & InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & InRoom & "\walk.txt").ReadAll NoHabbo = 1 For ba = 1 To frmMain.SockI If Pet(ba).InRoom = InRoom Then If Pet(ba).PosX = Val(Pet(b).PosX) + BijX And Pet(ba).PosY = Val(Pet(b).PosY) + BijY Then NoHabbo = 0 End If Next ba splitP = Split(frmMain.Hpets, ";") For ba = 0 To UBound(splitP) If splitP(ba) <> "" Then If Pet(splitP(ba)).InRoom = InRoom Then If Pet(splitP(ba)).PosX = Val(Pet(b).PosX) + BijX And Pet(splitP(ba)).PosY = Val(Pet(b).PosY) + BijY Then NoHabbo = 0 End If End If Next ba If NoHabbo = 1 Then If Mid(Split(Walkmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1) = "O" Then NewH = Mid(Split(htmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1) VanH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1)) NaarH = Mid(Split(htmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1) If Pet(b).Sit Or Pet(b).Lay = True Then NaarH = Val(NaarH) + Val(ReadINI("offset", Pet(b).PosX & "," & Pet(b).PosY, DBP & "privaterooms\" & Pet(b).InRoom & "\rotation.txt")) - 1 NaarH = Replace(NaarH, ",", ".") If InStr(VanH, ".") = 0 Then VanH = VanH & ".0" VanH = Val(NaarH) + Val(ReadINI("offset", Pet(b).PosX & "," & Pet(b).PosY, DBP & "privaterooms\" & Pet(b).InRoom & "\rotation.txt")) - 1 VanH = Replace(NaarH, ",", ".") If InStr(VanH, ".") = 0 Then VanH = VanH & ".0" End If Pet(b).Hadd = Index 'Client(b).RollerUpdate = True 'TimerUpdate_Timer (b) If Packet = "" Then Packet = Packet & "Cf" & VL64encode(Pet(b).PosX) & VL64encode(Pet(b).PosY) & VL64encode(Pet(b).PosX + BijX) & VL64encode(Pet(b).PosY + BijY) & "H" & VL64encode(Index) & "J" & VL64encode(b) & VanH & Chr(2) & NewH & Chr(2) & Chr(1) Else Packet = Mid(Packet, 1, Len(Packet) - 1) Packet = Packet & "J" & VL64encode(b) & VanH & Chr(2) & NaarH & Chr(2) & Chr(1) End If Pet(b).PosX = Pet(b).PosX + BijX Pet(b).PosY = Pet(b).PosY + BijY Pet(b).He = NewH Pet(b).DestX = Pet(b).PosX Pet(b).DestY = Pet(b).PosY ElseIf Mid(Split(Walkmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1) = "R" Then FurniOP2 = ReadINI("furnies", Val(Pet(b).PosX) + BijX & "," & Val(Pet(b).PosY) + BijY, DBP & "privaterooms\" & InRoom & "\rotation.txt") ToeStaan = 0 If FurniOP2 = "" Then ToeStaan = 1 Else If FurniOP2 = NuFurni Then ToeStaan = 1 End If If ToeStaan = 1 Then NewH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1)) NaarH = 0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Pet(b).PosY) + BijY), Val(Pet(b).PosX) + BijX + 1, 1)) If Pet(b).Sit Or Pet(b).Lay = True Then NaarH = Val(NaarH) + Val(ReadINI("offset", Pet(b).PosX & "," & Pet(b).PosY, DBP & "privaterooms\" & Pet(b).InRoom & "\rotation.txt")) - 1 End If NaarH = Replace(NaarH, ",", ".") If InStr(NaarH, ".") = 0 Then NaarH = NaarH & ".0" Pet(b).Hadd = Index 'Client(b).RollerUpdate = True 'TimerUpdate_Timer (b) If Packet = "" Then Packet = Packet & "Cf" & VL64encode(Pet(b).PosX) & VL64encode(Pet(b).PosY) & VL64encode(Pet(b).PosX + BijX) & VL64encode(Pet(b).PosY + BijY) & "H" & VL64encode(Index) & "J" & VL64encode(b) & NaarH & Chr(2) & NaarH & Chr(2) & Chr(1) Else Packet = Mid(Packet, 1, Len(Packet) - 1) Packet = Packet & "J" & VL64encode(b) & NaarH & Chr(2) & NaarH & Chr(2) & Chr(1) End If Pet(b).PosX = Pet(b).PosX + BijX Pet(b).PosY = Pet(b).PosY + BijY Pet(b).He = NewH Pet(b).DestX = Pet(b).PosX Pet(b).DestY = Pet(b).PosY End If End If End If PetTimer(b).Enabled = False PetTimer(b).Interval = 1000 PetTimer(b).Enabled = True Pet(b).Update = True Exit For Else Pet(b).Hadd = 0 End If End If End If End If Next bx If Packet <> "" Then sendAll (Packet), (InRoom) If WriteWalk = 1 Then FSO.OpenTextFile(DBP & "privaterooms\" & WalkRoom & "\walk.txt", ForWriting).Write Walkmp2 Packet = "" If UpdateFurni2 > 0 Then Load UpdateFurni(UpdateFurni2) End If End If Errr: End If Next Q lol: End Sub Private Sub socket_Close(Index As Integer) If Index > 0 Then TimerUpdate(Index).Enabled = False TimerTeleport1(Index).Enabled = False TimerTeleport2(Index).Enabled = False TimerWave(Index).Enabled = False TimerTalk(Index).Enabled = False TimerGesture(Index).Enabled = False TimerDrink(Index).Enabled = False TimerVanish(Index).Enabled = False UseTimer(Index).Enabled = False 'client Client(Index).App = "" Client(Index).Name = "" Client(Index).Rank = 0 Client(Index).Sex = "" Client(Index).Mission = "" Client(Index).Badge = "" Client(Index).BadgeOn = 0 Client(Index).Rank = "" 'pet part Kamer = Client(Index).InRoom If Kamer > 0 Then InRoom = 0 For b = 1 To frmMain.SockI If Client(b).InRoom = Kamer Then InRoom = InRoom + 1 End If Next b If InRoom = 1 Then 'rollers splitP = Split(Replace(frmMain.LoadedRollers, ">", ""), "<") For b = 0 To UBound(splitP) If splitP(b) <> "" Then FType = FSO.OpenTextFile(DBP & "furni\" & splitP(b) & "\type.txt", ForReading).ReadAll FRoom = FSO.OpenTextFile(DBP & "furni\" & splitP(b) & "\inroom.txt", ForReading).ReadAll 'roller If FType = "roller" And FRoom = Kamer Then frmMain.LoadedRollers = Replace(frmMain.LoadedRollers, "<" & splitP(b) & ">", "") End If 'roller End If Next b 'rollers Hpets2 = "" splitP = Split(frmMain.Hpets, ";") For b = 0 To UBound(splitP) If splitP(b) <> "" Then If Pet(splitP(b)).InRoom = Kamer Then Unload frmMain.PetTimer(splitP(b)) Nums = Replace(Nums, "<" & splitP(b) & ">", "") 'save status WriteINI "pet", "alive", Pet(splitP(b)).Alive, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "drinktimer", Pet(splitP(b)).DrinkTimer, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "eattimer", Pet(splitP(b)).EatTimer, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "sleep", Pet(splitP(b)).Sleep, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "sleeptimer", Pet(splitP(b)).SleepTimer, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "sleepduration", Pet(splitP(b)).SleepDuration, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "he", Pet(splitP(b)).He, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "look", Mid(Pet(splitP(b)).Look, 1, InStr(Pet(splitP(b)).Look, ",") - 1), DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "posx", Pet(splitP(b)).PosX, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "posy", Pet(splitP(b)).PosY, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "sit", Pet(splitP(b)).Sit, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "lay", Pet(splitP(b)).Lay, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "gesture", Pet(splitP(b)).Gesture, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "action", Pet(splitP(b)).Action, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" WriteINI "pet", "actiontype", Pet(splitP(b)).Actiontype, DBP & "furni\" & Pet(splitP(b)).FurniID & "\status.txt" 'save status Pet(splitP(b)).Name = "" Else Hpets2 = Hpets2 & splitP(b) & ";" End If End If Next b frmMain.Hpets = Hpets2 End If 'pet part End If Nums = Replace(Nums, "<" & Client(Index).Num & ">", "") Client(Index).Num = 0 Client(Index).InRoom = 0 Client(Index).Sit = False Client(Index).RollerUpdate = False Client(Index).Lay = False Client(Index).Wave = False Client(Index).Dance = False Client(Index).Trading = False Client(Index).Update = False Client(Index).TelMove = False Client(Index).Teled = False Client(Index).DoDrink = False Client(Index).Dancetype = "" Client(Index).NoDrink = True Client(Index).UseItem = False Client(Index).Carrying = 0 TimerVanish(Index).Enabled = False TimerDrink(Index).Enabled = False Client(Index).PosX = 0 Client(Index).PosY = 0 Client(Index).He = "0.0" Client(Index).DestX = 0 Client(Index).DestY = 0 Client(Index).TelX = 0 Client(Index).TelY = 0 Client(Index).TelHe = "" Client(Index).Look = "" Client(Index).Gesture = "" Client(Index).Talking = False Client(Index).HandPage = 0 Client(Index).Publicname = "" Client(Index).Publicnum = 0 If Client(Index).TradingWith <> "" Then Hab_AF "AF", Index Client(Index).TradingWith = "" End If 'client FreeSockets = FreeSockets & "<" & Index & ">" End If End Sub Private Sub socket_ConnectionRequest(Index As Integer, ByVal requestID As Long) If Index = 0 Then Dim NewI As Integer If FreeSockets = "" Then NewI = SockI + 1 SockI = SockI + 1 Load socket(NewI) Load TimerUpdate(NewI) Load TimerTeleport1(NewI) Load TimerTeleport2(NewI) Load TimerTeleport3(NewI) Load TimerWave(NewI) Load TimerTalk(NewI) Load TimerGesture(NewI) Load TimerDrink(NewI) Load TimerVanish(NewI) Load UseTimer(NewI) ReDim Preserve Client(NewI) Else NewI = Replace(Split(FreeSockets, ">")(0), "<", "") FreeSockets = Replace(FreeSockets, "<" & NewI & ">", "") Unload socket(NewI) Load socket(NewI) End If On Error Resume Next TimerUpdate(NewI).Enabled = True socket(NewI).Accept requestID socket(NewI).SendData "@@" & Chr(1) End If End Sub Private Sub socket_DataArrival(Index As Integer, ByVal bytesTotal As Long) On Error GoTo fuckyomom Dim info As String Dim Offset As Integer Dim TheNum As Integer Dim ToDo() As String Dim P As Integer Dim FindIt As String Dim NewInfo As String socket(Index).GetData info reloop: ReDim Preserve ToDo(Offset) As String TheNum = Decode(Mid(info, 1, 3)) ToDo(Offset) = Mid(info, 4, TheNum) info = Right(info, Len(info) - TheNum - 3) Offset = Offset + 1 If Len(info) >= 1 Then GoTo reloop For P = 0 To UBound(ToDo) NewInfo = ToDo(P) FindIt = Left(NewInfo, 2) If 1 = 1 Then If frmMain.chckLog.Value = 1 Then 'If FindIt = "AK" Then Exta = " [" & Decode(Mid(NewInfo, 3, 2)) & " " & Decode(Mid(NewInfo, 5, 2)) & "]" Else Exta = "" frmMain.txtLog.Text = frmMain.txtLog.Text + vbCrLf + "[" & Index & "] ›› " & NewInfo frmMain.txtLog.SelStart = Len(frmMain.txtLog.Text) End If End If 'HANDLING Select Case FindIt Case "CD" 'Connection request answer Client(Index).Close = 0 Case "CJ" 'things Hab_CJ NewInfo, Index Case "@D" 'login Hab_AtD NewInfo, Index Case "@H" 'get info Hab_Ath NewInfo, Index Case "@L" 'console shit, WORK IN THIS! Hab_AtL NewInfo, Index Case "@Z" 'get hc days badge(s) etc Hab_AtZ NewInfo, Index Case "B~" 'buy hc Hab_Bgolf NewInfo, Index Case "@I" 'update id (get) Hab_Ati NewInfo, Index Case "@l" 'update id Hab_Atl2 NewInfo, Index Case "BA" 'voucher Hab_BA NewInfo, Index Case "@]" 'create private room Hab_Athaak NewInfo, Index Case "BY" 'change category Hab_BY NewInfo, Index Case "@P" 'room list by name Hab_AtP NewInfo, Index Case "@Q" 'room list by query Hab_AtQ NewInfo, Index Case "BW" 'room list home Hab_BW NewInfo, Index Case "@U" 'room info Hab_AtU NewInfo, Index Case "BX" 'modify room Hab_BX NewInfo, Index Case "@Y" 'modify room Hab_AtY NewInfo, Index Case "@X" 'modify room Hab_AtX NewInfo, Index Case "B[" 'remove all rights Hab_Bhaak NewInfo, Index Case "@W" 'remove guestroom Hab_AtW NewInfo, Index Case "@S" 'add room to favourites ( @SH) Hab_AtS NewInfo, Index Case "@T" 'delete room from favourites ( @TH) Hab_AtT NewInfo, Index Case "@R" 'get favourites ( @R@) Hab_AtR NewInfo, Index Case "Bv" 'enter room ? Hab_Bv NewInfo, Index Case "@B" 'enter room ? Hab_Atb NewInfo, Index Case "@y" 'enter pass for room Hab_Aty2 NewInfo, Index Case "@{" 'enter room ? Hab_Atlol NewInfo, Index frmMain.socket(Index).SendData furniture & Chr(1) socket(Index).SendData "DiH" & Chr(1) Case "CW" frmMain.socket(Index).SendData furniture Case "A" 'get transactions (not supported) Hab_Ablokje NewInfo, Index Case "A~" 'enter room ? Hab_Agolf NewInfo, Index Case "@" 'enter room ? Hab_Atblokje NewInfo, Index Case "A@" 'enter room ? Hab_Aat Index Case "@~" 'public room data Hab_Atgolf NewInfo, Index Case "AO" 'look Hab_AO NewInfo, Index Case "AK" 'walk Hab_AK NewInfo, Index Case "B^" 'badge select Hab_Bdak NewInfo, Index Case "A]" 'dance Hab_Ahaak NewInfo, Index Case "A^" 'wave Hab_Adak NewInfo, Index Case "AX" 'stop something Hab_AX NewInfo, Index Case "A`" 'give rights Hab_Astreep NewInfo, Index Case "Aa" 'remove rights Hab_Aa NewInfo, Index Case "A_" 'kick Hab_Alaag NewInfo, Index Case "@u" 'leave room ? Hab_Kick Index Case "As" 'click door Hab_As NewInfo, Index Case "@w" 'shout Hab_Atw2 NewInfo, Index Case "@t" 'talk Hab_Att2 NewInfo, Index Case "@x" 'whisper Hab_Atx2 NewInfo, Index Case "AA" 'hand stuff Hab_AA2 NewInfo, Index Case "AB" 'floor & wallpaper Hab_AB NewInfo, Index Case "AZ" 'put down furni Hab_AZ NewInfo, Index Case "AC" 'pick up furni Hab_AC NewInfo, Index Case "AI" 'move/rotate furni Hab_AI NewInfo, Index Case "AJ" 'turn on /off Hab_AJ NewInfo, Index Case "AM" 'turn off dice Hab_AM NewInfo, Index Case "AL" 'turn on Hab_AL NewInfo, Index Case "AN" 'open present Hab_AN NewInfo, Index Case "AQ" 'walk in teleport Hab_AQ NewInfo, Index Case "@\" 'teleport Hab_AtSlash NewInfo, Index Case "AR" 'flash teleport Hab_AR NewInfo, Index Case "@v" 'enter room with teleport Hab_Atv NewInfo, Index Case "AS" 'open stickie Hab_AS2 NewInfo, Index Case "AT" 'edit stickie Hab_AT NewInfo, Index Case "AU" 'delete stickie Hab_AU NewInfo, Index Case "AG" 'start trade Hab_AG NewInfo, Index Case "AF" 'stop trade Hab_AF NewInfo, Index Case "AH" 'add item to trade Hab_AH NewInfo, Index Case "AE" 'accept trade Hab_AE NewInfo, Index Case "AD" 'unaccept trade Hab_AD NewInfo, Index Case "AP" 'carry something Hab_AP NewInfo, Index Case "Ae" 'open cato Hab_Ae2 NewInfo, Index Case "Af" 'open cato page Hab_Af2 NewInfo, Index Case "@q" 'get date Hab_Atq2 NewInfo, Index Case "Ad" 'buy stuff Hab_Ad2 NewInfo, Index Case "AW" 'carry item Hab_AW NewInfo, Index Case "AY" 'use item Hab_AY NewInfo, Index Case "@j" 'something for pets & registering Hab_Atj NewInfo, Index Case "B@" 'pet info Hab_Bat NewInfo, Index Case "Ab" 'door bell yes no Hab_Ab2 NewInfo, Index Case "BV" 'open category Hab_BV2 NewInfo, Index Case "CH" 'mod tool Hab_CH NewInfo, Index Case "AV" 'call for help Hab_AV NewInfo, Index Case "@p" 'pick call for help Hab_Atp2 NewInfo, Index Case "CF" 'assign call to mods or helpers Hab_CF NewInfo, Index Case "CG" 'reply to cfh Hab_CG NewInfo, Index Case "@k" 'register Hab_Atk NewInfo, Index Case "CK" 'Check Passwordlength Hab_CK NewInfo, Index Case "BU" 'change password Hab_Bu NewInfo, Index Case "CI" 'report message Hab_Ci NewInfo, Index Case "@d" 'change console Mission Hab_Atd2 NewInfo, Index Case "@i" 'Search User at console Hab_Ati2 NewInfo, Index Case "@O" 'Update Console Hab_Ato NewInfo, Index Case "@`" 'Delete Message Hab_Atquo NewInfo, Index Case "@_" 'Delete Staff Message Hab_Atquo NewInfo, Index Case "@g" 'Ask for Friend Hab_Atg NewInfo, Index Case "@f" 'Dont accept ask for Friend Hab_Atf NewInfo, Index Case "@e" 'Accept ask for Friend Hab_Ate NewInfo, Index Case "@h" 'Delete Friend Hab_Ath2 NewInfo, Index Case "@a" 'Send Console Message Hab_Ata NewInfo, Index Case "CV" ' Candle thing.. ;] wallID = Val(Mid(NewInfo, 5)) cust = Split(NewInfo, wallID)(1) loca = FSO.OpenTextFile(DBP & "furni\" & wallID & "\loc.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & wallID & "\name.txt", ForReading).ReadAll Fvar = FSO.OpenTextFile(DBP & "furni\" & wallID & "\var.txt", ForReading).ReadAll If Fvar = "3" Or Fvar = "2" Or Fvar = "H" Or Fvar = "J" Then FSO.OpenTextFile(DBP & "furni\" & wallID & "\var.txt", ForWriting).Write "I" sendAll "AU" & wallID & Chr(9) & " " & Fname & " " & loca & Chr(9) & "2" & Chr(1), (Client(Index).InRoom) ElseIf Fvar = "1" Or Fvar = "2" Or Fvar = "I" Then FSO.OpenTextFile(DBP & "\furni\" & wallID & "\var.txt", ForWriting).Write "J" sendAll "AU" & wallID & Chr(9) & " " & Fname & " " & loca & Chr(9) & "1" & Chr(1), (Client(Index).InRoom) End If Case "Ac" 'Delete Furni Hab_Ac2 NewInfo, Index Case "Bw" ' Habbo Exchange 'Hab_Bw2 NewInfo, Index FurniID = VL64Decode(Mid(NewInfo, 3)) 'FID = Split(NewInfo, "Bw")(1) 'FID2 = VL64Decode(FID) 'frmMain.socket(Index).SendData "B! Furniture ID - " & FID & " " & FurniID & Chr(1) NewLijst = ";" Lijst2 = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\furni.txt", ForReading).ReadAll Lijst = Split(Lijst2, ";") For a = 0 To UBound(Lijst) If Lijst(a) <> "" And Lijst(a) <> FurniID Then NewLijst = NewLijst & ";" & Lijst(a) Next a NewLijst = Replace(NewLijst, ";;", ";") FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\furni.txt", ForWriting).Write NewLijst FurniType = FSO.OpenTextFile(DBP & "furni\" & FurniID & "\type.txt", ForReading).ReadAll Custt = FSO.OpenTextFile(DBP & "furni\" & FurniID & "\cust.txt", ForReading).ReadAll Fname = FSO.OpenTextFile(DBP & "furni\" & FurniID & "\name.txt", ForReading).ReadAll loca = Split(FSO.OpenTextFile(DBP & "furni\" & FurniID & "\loc.txt", ForReading).ReadAll, " ") Innroom = FSO.OpenTextFile(DBP & "furni\" & FurniID & "\inroom.txt", ForReading).ReadAll htmp = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\walk.txt").ReadAll Doen = "O" Fvar = FSO.OpenTextFile(DBP & "furni\" & FurniID & "\var.txt", ForReading).ReadAll 'roller If FurniType = "roller" Then frmMain.LoadedRollers = Replace(frmMain.LoadedRollers, "<" & FurniID & ">", "") FurniOP = ReadINI("furnies", loca(0) & "," & loca(1), DBP & "privaterooms\" & Innroom & "\rotation.txt") If FurniOP <> "" Then FurniTypeX = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\type.txt", ForReading).ReadAll If FurniTypeX = "sit" Then Doen = "S" If FurniTypeX = "bed" Then Doen = "L" If FurniTypeX = "solid" Then Doen = "X" If FurniTypeX = "door" Then If InStr(Fvar, "O") Then Doen = "D" Else Doen = "X" End If End If End If End If 'roller 'pet part If Fname = "nest" Then Hpets2 = "" splitP = Split(frmMain.Hpets, ";") For b = 0 To UBound(splitP) If splitP(b) <> "" Then If Pet(splitP(b)).FurniID = FurniID Then Unload frmMain.PetTimer(splitP(b)) Nums = Replace(Nums, "<" & splitP(b) & ">", "") If Pet(splitP(b)).Actiontype = "pla" Then Pet(splitP(b)).Actiontype = "" 'save status WriteINI "pet", "alive", Pet(splitP(b)).Alive, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "drinktimer", Pet(splitP(b)).DrinkTimer, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "eattimer", Pet(splitP(b)).EatTimer, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "sleep", Pet(splitP(b)).Sleep, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "sleeptimer", Pet(splitP(b)).SleepTimer, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "sleepduration", Pet(splitP(b)).SleepDuration, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "he", Pet(splitP(b)).He, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "look", Mid(Pet(splitP(b)).Look, 1, InStr(Pet(splitP(b)).Look, ",") - 1), DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "posx", Pet(splitP(b)).PosX, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "posy", Pet(splitP(b)).PosY, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "sit", Pet(splitP(b)).Sit, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "lay", Pet(splitP(b)).Lay, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "gesture", Pet(splitP(b)).Gesture, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "action", Pet(splitP(b)).Action, DBP & "furni\" & FurniID & "\status.txt" WriteINI "pet", "actiontype", Pet(splitP(b)).Actiontype, DBP & "furni\" & FurniID & "\status.txt" 'save status Pet(splitP(b)).Name = "" sendAll "@]" & splitP(b) & Chr(1), (Client(Index).InRoom) Else Hpets2 = Hpets2 & splitP(b) & ";" End If End If Next b frmMain.Hpets = Hpets2 End If 'pet part Fx = Val(loca(0)) Fy = Val(loca(1)) Dim Custsplit() As String Custsplit() = Split(Custt, "") Dim ForX As Integer, ForY As Integer If Val(loca(2)) = 0 Or Val(loca(2)) = 4 Then BijX = Val(Custsplit(0)) BijY = Val(Custsplit(1)) Else BijX = Val(Custsplit(1)) BijY = Val(Custsplit(0)) End If Walksplit = Split(Walkmp, Chr(13)) For ForX = Fx To Fx + BijX - 1 For ForY = Fy To Fy + BijY - 1 If (FurniType <> "rug" And Mid(Split(Walkmp, Chr(13))(ForY), ForX + 1, 1) <> "R") Or FurniType = "roller" Then Walksplit(ForY) = Mid(Walksplit(ForY), 1, ForX) & Doen & Mid(Walksplit(ForY), ForX + 2) FSO.CopyFile DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt", DBP & "privaterooms\" & Client(Index).InRoom & "\rotationb.txt", True TopID = ReadINI("furnies", ForX & "," & ForY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") If TopID = FurniID Then StackHere = ReadINI("stacked", ForX & "," & ForY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") If StackHere <> "" Then WriteINI "furnies", ForX & "," & ForY, StackHere, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt" WriteINI "stacked", ForX & "," & ForY, "", DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt" If Mid(Split(Walkmp, Chr(13))(ForY), ForX + 1, 1) <> "R" Then Walksplit(ForY) = Mid(Walksplit(ForY), 1, ForX) & "X" & Mid(Walksplit(ForY), ForX + 2) Else WriteINI "furnies", ForX & "," & ForY, "", DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt" End If Else FurniHere = ReadINI("stacked", ForX & "," & ForY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") If FurniHere <> "" Then WriteINI "stacked", ForX & "," & ForY, "", DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt" If Mid(Split(Walkmp, Chr(13))(ForY), ForX + 1, 1) <> "R" Then Walksplit(ForY) = Mid(Walksplit(ForY), 1, ForX) & "X" & Mid(Walksplit(ForY), ForX + 2) Else WriteINI "stacked", ForX & "," & ForY, "", DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt" End If End If Next ForY Next ForX Walkmp = Join(Walksplit, Chr(13)) FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\walk.txt", ForWriting).Write Walkmp 'make space NewLijst = ";" Lijst2 = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\furni.txt", ForReading).ReadAll Lijst = Split(Lijst2, ";") For a = 0 To UBound(Lijst) If Lijst(a) <> "" And Lijst(a) <> FurniID Then NewLijst = NewLijst & ";" & Lijst(a) Next a NewLijst = Replace(NewLijst, ";;", ";") FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\furni.txt", ForWriting).Write NewLijst FSO.OpenTextFile(DBP & "furni\" & FurniID & "\inroom.txt", ForWriting).Write 0 credits = FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\credits.txt", ForReading).ReadAll amount = FSO.OpenTextFile(DBP & "furni\" & FurniID & "\name.txt", ForReading).ReadAll 'If FurniID = "P]" Then If amount = "CF_50_goldbar" Then NewCredits = credits + 50 'CF_20_moneybag ElseIf amount = "CF_20_moneybag" Then NewCredits = credits + 20 ElseIf amount = "CF_10_coin_gold" Then NewCredits = credits + 10 ElseIf amount = "CF_5_coin_silver" Then NewCredits = credits + 5 ElseIf amount = "CF_1_coin_bronze" Then NewCredits = credits + 1 End If sendAll "A^" & FurniID & Chr(1), (Client(Index).InRoom) FSO.OpenTextFile(DBP & "habbos\" & LCase(Client(Index).Name) & "\credits.txt", ForWriting).Write NewCredits If socket(Index).State = sckConnected Then socket(Index).SendData "@F" & NewCredits & ".00" & Chr(1) FSO.DeleteFolder DBP & "furni\" & FurniID, True Case "CN" If socket(Index).State = sckConnected Then frmMain.socket(Index).SendData "DUIH" & Chr(1) 'some things that don't need a function Case "BC" If socket(Index).State = sckConnected Then socket(Index).SendData "CV" & Chr(1) Case "CE" If socket(Index).State = sckConnected Then socket(Index).SendData "DO" & Chr(1) Case "BR" If socket(Index).State = sckConnected Then socket(Index).SendData "CY1" & Chr(1) Case "@n" If socket(Index).State = sckConnected Then socket(Index).SendData "DO" & Chr(1) End Select 'HANDLING Next fuckyomom: End Sub Private Sub Text2_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyReturn Then If Text2.Text = "´commands´" Then MsgBox "´showcfh´ - Shows the actual CFH PacketData" & vbNewLine & "´sendall´ [data] - Sends [data] to all connected Users" & vbNewLine & "´1´ - CharacterCode 1" & vbNewLine & "´2´ - CharacterCode 2" & vbNewLine & "´13´ - CharacterCode 13" & vbNewLine & "´dicetimers´ - Shows the running dices" & vbNewLine & "´showvars´ - Shows the loaded Filedata" & vbNewLine & "´loadedrollers´ - Shows the loaded rollers", vbInformation, "Server" Exit Sub End If If Text2.Text = "´showcfh´" Then Packet = "CALL FOR HELP STOREDDATA" For a = 1 To CFHs If Len(CFH(a).Text) > 1 Then Packet = Packet & vbNewLine & CFH(a).Text End If Next a Text2.Text = "" MsgBox Packet, vbInformation, "Server" Exit Sub End If If Text2.Text = "´dicetimers´" Then Text2.Text = "" MsgBox frmMain.dices, vbInformation, "Server" Exit Sub End If If Text2.Text = "´loadedrollers´" Then Text2.Text = "" MsgBox frmMain.LoadedRollers, vbInformation, "Server" Exit Sub End If If InStr(Text2.Text, "´sendall´") = 1 Then Packet = Mid(Text2.Text, InStr(Text2.Text, " ") + 1) Packet = Replace(Packet, "´1´", Chr(1)) Packet = Replace(Packet, "´2´", Chr(2)) Packet = Replace(Packet, "´13´", Chr(13)) For a = 1 To SockI If socket(a).State = sckConnected Then socket(a).SendData Packet End If Next a Text2.Text = "" Exit Sub End If End If End Sub Private Sub TimerBotAction_Timer(Index As Integer) If Bot(Index).Otheraction = True Then Bot(Index).Otheraction = False Exit Sub End If For b = 1 To SockI If socket(b).State = sckConnected Then If Client(b).Publicnum = Bot(Index).Publicnum Then GoTo ThereAreGuests End If Next b Exit Sub ThereAreGuests: Randomize BotAction = Int((2 - 1 + 1) * Rnd) + 1 If BotAction = 1 Then Tries = 0 TryAgain1: Randomize SayNum = Int((7 - 1 + 1) * Rnd) + 1 Saying = ReadINI("bot", "talk" & SayNum, DBP & "pub\" & Bot(Index).Publicnum & "\data.ini") If Saying <> "0" And Saying <> "" Then If InStr(Saying, Chr(2)) = 0 Then Saying = "say" & Chr(2) & Saying If Split(Saying, Chr(2))(0) = "say" Then For a = 1 To frmMain.SockI If socket(a).State = sckConnected And Client(a).Publicnum = Bot(Index).Publicnum And Diff(Client(a).PosX, Bot(Index).PosX) < 8 And Diff(Client(a).PosY, Bot(Index).PosY) < 8 Then Send a, "@X" & VL64encode(Bot(Index).Num) & Split(Saying, Chr(2))(1) & Chr(2) & Chr(1) End If Next a Else sendAllP "@Z" & VL64encode(Bot(Index).Num) & Split(Saying, Chr(2))(1) & Chr(2) & Chr(1), (Bot(Index).Publicnum) End If Tijd = Len(Saying) * 100 If Tijd < 500 Then Tijd = 500 Bot(Index).Talking = True TimerBotTalk(Index).Interval = Tijd TimerBotTalk(Index).Enabled = True Bot(Index).Update = True Exit Sub Else Tries = Tries + 1 If Tries >= 20 Then Exit Sub End If GoTo TryAgain1 End If Else Tries = 0 Walks = Split(ReadINI("bot", "walkspace", DBP & "pub\" & Bot(Index).Publicnum & "\data.ini"), ",") TryAgain2: Randomize NewDest = Int((UBound(Walks) - 1 + 1) * Rnd) + 1 NewDest = Walks(NewDest) If InStr(NewDest, " ") <> 0 Then If IsNumeric(Split(NewDest, " ")(0)) = True And IsNumeric(Split(NewDest, " ")(1)) = True Then Bot(Index).DestX = Split(NewDest, " ")(0) Bot(Index).DestY = Split(NewDest, " ")(1) Bot(Index).Update = True Exit Sub Else Tries = Tries + 1 If Tries >= 20 Then Exit Sub End If GoTo TryAgain2 End If Else Tries = Tries + 1 If Tries >= 20 Then Exit Sub End If GoTo TryAgain2 End If End If End Sub Private Sub TimerBotTalk_Timer(Index As Integer) On Error GoTo lol TimerBotTalk(Index).Enabled = False Bot(Index).Talking = False Bot(Index).Update = True lol: End Sub Private Sub TimerBotUpdate_Timer(Index As Integer) If Bot(Index).Update = True Then extb = "" FirstHeBot = Bot(Index).He If Bot(Index).Talking = True Then extb = extb & "talk/" End If If Bot(Index).PosX <> Bot(Index).DestX Or Bot(Index).PosY <> Bot(Index).DestY Then HeightMap = FSO.OpenTextFile(DBP & "pub\" & Bot(Index).Publicnum & "\heightmap.map", ForReading).ReadAll NwPB = FindPathBot(Index, Bot(Index).PosX, Bot(Index).PosY, Bot(Index).DestX, Bot(Index).DestY, HeightMap) If NwPB = "NoPath" Then Bot(Index).DestX = Bot(Index).PosX Bot(Index).DestY = Bot(Index).PosY NwPB = Bot(Index).PosX & "," & Bot(Index).PosY Else extb = extb & "mv " & NwPB & "," & Bot(Index).He & "/" End If End If If Bot(Index).DestX = Bot(Index).PosX And Bot(Index).DestY = Bot(Index).PosY Then Bot(Index).InUse = False Bot(Index).Look = Bot(Index).Standartlook Bot(Index).Update = False End If sendAllP "@b" & Bot(Index).Num & " " & Bot(Index).PosX & "," & Bot(Index).PosY & "," & FirstHeBot & "," & Bot(Index).Look & "/" & extb & Chr(13) & Chr(1), (Bot(Index).Publicnum) If NwPB <> "" Then Bot(Index).PosX = Split(NwPB, ",")(0) Bot(Index).PosY = Split(NwPB, ",")(1) End If End If End Sub Private Sub TimerDice_Timer(Index As Integer) Dim getal As Long, DiceID As Long DiceID = Split(TimerDice(Index).Tag, ".")(0) TheRom = Split(TimerDice(Index).Tag, ".")(1) Randomize Timer getal = Int((6 - 1 + 1) * Rnd) + 1 FSO.OpenTextFile(DBP & "furni\" & DiceID & "\var.txt", ForWriting).Write "H" & getal getal = (DiceID * 38) + getal sendAll "AZ" & DiceID & Chr(20) & getal & Chr(1), (TheRom) dices = Replace(dices, "<" & Index & ">", "") Unload TimerDice(Index) End Sub Private Sub TimerDrink_Timer(Index As Integer) On Error GoTo lol Client(Index).DoDrink = True Client(Index).Update = True lol: End Sub Private Sub TimerGesture_Timer(Index As Integer) On Error GoTo lol TimerGesture(Index).Enabled = False Client(Index).Gesture = "" Client(Index).Update = True lol: End Sub Private Sub TimerTalk_Timer(Index As Integer) On Error GoTo lol TimerTalk(Index).Enabled = False Client(Index).Talking = False Client(Index).Update = True lol: End Sub Private Sub TimerTeleport1_Timer(Index As Integer) On Error GoTo lol Fname = FSO.OpenTextFile(DBP & "furni\" & TimerTeleport1(Index).Tag & "\name.txt", ForReading).ReadAll FRoom = FSO.OpenTextFile(DBP & "furni\" & TimerTeleport1(Index).Tag & "\inroom.txt", ForReading).ReadAll If FRoom = Client(Index).InRoom Then sendAll "AY" & TimerTeleport1(Index).Tag & "/" & Client(Index).Name & "/" & Fname & Chr(1) & "AY" & TimerTeleport1(Index).Tag & "/" & Client(Index).Name & "/" & Fname & Chr(1), (FRoom) TimerTeleport1(Index).Enabled = False TimerTeleport2(Index).Enabled = True Else TimerTeleport1(Index).Enabled = False sendAll "@]" & Client(Index).Num & Chr(1), (Client(Index).InRoom) RoomNum = FRoom Client(Index).Teled = True Client(Index).InRoom = RoomNum 'frmMain.socket(index).SendData "@S" & Chr(1) End If lol: End Sub Private Sub TimerTeleport2_Timer(Index As Integer) On Error GoTo lol FLoc = Split(FSO.OpenTextFile(DBP & "furni\" & TimerTeleport1(Index).Tag & "\loc.txt", ForReading).ReadAll, " ") Client(Index).PosX = FLoc(0) Client(Index).PosY = FLoc(1) Client(Index).Look = FLoc(2) & "," & FLoc(2) If Val(FLoc(2)) = 0 Or Val(FLoc(2)) = 2 Then Client(Index).DestX = Client(Index).PosX + 1 Client(Index).DestY = Client(Index).PosY Else Client(Index).DestX = Client(Index).PosX Client(Index).DestY = Client(Index).PosY + 1 End If Hab_AJ "AJ" & encodeB64(TimerTeleport1(Index).Tag) & TimerTeleport1(Index).Tag & "@DTRUE", Index Client(Index).Update = True TimerTeleport2(Index).Enabled = False TimerTeleport3(Index).Enabled = True lol: End Sub Private Sub TimerTeleport3_Timer(Index As Integer) On Error GoTo lol Hab_AJ "AJ" & encodeB64(TimerTeleport1(Index).Tag) & TimerTeleport1(Index).Tag & "@DFALSE", Index TimerTeleport3(Index).Enabled = False lol: End Sub Private Sub TimerUpdate_Timer(Index As Integer) On Error GoTo lol Dim Splitt() As String FirstHe = Client(Index).He If TimerUpdate(Index).Interval > 500 Then TimerUpdate(Index).Interval = 500 ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Client(Index).InRoom > 0 Then ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' If Client(Index).RollerUpdate = True Then Client(Index).RollerUpdate = False Owner = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\owner.txt").ReadAll rights = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\rights.txt").ReadAll If Owner = Client(Index).Name Then extbt = extbt & "flatctrl useradmin/" If FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\allrights.txt").ReadAll = "1" Then extbt = extbt & "flatctrl useradmin/" Else Splitt = Split(rights, ";") For Q = 0 To UBound(Splitt()) If Splitt(Q) = Client(Index).Name Then extbt = extbt & "flatctrl useradmin/" Exit For End If Next Q End If If Client(Index).Wave = True Then extbt = extbt & "wave/" End If If Client(Index).Dance = True Then extbt = extbt & Client(Index).Dancetype & "/" End If If Val(Client(Index).Carrying) > 0 Then If Client(Index).NoDrink = False Then If Client(Index).DoDrink = False Then extbt = extbt & "carryd " & Client(Index).Carrying & "/" Else extbt = extbt & "drink " & Client(Index).Carrying & "/" Client(Index).DoDrink = False Client(Index).Update = True End If Else If Client(Index).UseItem = False Then extbt = extbt & "cri " & Client(Index).Carrying & "/" Else extbt = extbt & "usei " & Client(Index).Carrying & "/" End If End If End If If Client(Index).Talking = True Then extbt = extbt & "talk/" End If If Client(Index).Gesture <> "" Then extbt = extbt & "gest " & Client(Index).Gesture & "/" End If If Client(Index).Trading = True Then extbt = extbt & "trd/" End If If Client(Index).Sit = True Then Client(Index).Look = ReadINI("rotation", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") Hoogte = Val(ReadINI("offset", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt")) 'Hoogte = Hoogte + Val(Client(Index).He) 'If Client(Index).InBig = True Then Hoogte = Hoogte / 3 Hoogte = Replace(Hoogte, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "sit " & Hoogte & "/" End If If Client(Index).Lay = True Then Client(Index).Look = ReadINI("rotation", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") Hoogte = Val(ReadINI("offset", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt")) 'Hoogte = Hoogte + Val(Client(Index).He) 'If Client(Index).InBig = True Then Hoogte = Hoogte / 3 Hoogte = Replace(Hoogte, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "lay " & Hoogte & " null/" End If Client(Index).He = Replace(Client(Index).He, ",", ".") If InStr(Client(Index).He, ".") = 0 Then Client(Index).He = Client(Index).He & ".0" sendAll "@b" & Client(Index).Num & " " & Client(Index).PosX & "," & Client(Index).PosY & "," & Client(Index).He & "," & Client(Index).Look & "/" & extbt & Chr(13) & Chr(1), (Client(Index).InRoom) Exit Sub End If If Client(Index).InRoom > 0 Then htmp = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\walk.txt").ReadAll Hoogte = Replace(Client(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" If Mid(Split(Walkmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) <> "R" And Mid(Split(htmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) & ".0" <> Hoogte And Client(Index).Sit = False And Client(Index).Lay = False Then If Mid(Split(htmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) <> "x" Then Client(Index).He = Mid(Split(htmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) & ".0" FirstHe = Client(Index).He Client(Index).Update = True End If End If If Mid(Split(Walkmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) = "R" And Replace(0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Client(Index).PosY) + BijY), Val(Client(Index).PosX) + BijX + 1, 1)), ",", ".") <> Hoogte And Client(Index).Sit = False And Client(Index).Lay = False Then Client(Index).He = Replace(0.4 + Val(Mid(Split(htmp, Chr(13))(Val(Client(Index).PosY)), Val(Client(Index).PosX) + 1, 1)), ",", ".") FirstHe = Client(Index).He Client(Index).Update = True End If If Mid(Split(Walkmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) = "S" Then If Client(Index).Sit = False Then Client(Index).Sit = True Client(Index).Dance = False Client(Index).Lay = False Client(Index).Update = True End If End If If Mid(Split(Walkmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) = "L" Then If Client(Index).Lay = False Then Client(Index).Sit = False Client(Index).Dance = False Client(Index).Lay = True Client(Index).Update = True End If End If If Mid(Split(Walkmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) = "O" Or Mid(Split(Walkmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) = "X" Then If Client(Index).Lay = True Or Client(Index).Sit = True Then Client(Index).Sit = False Client(Index).Lay = False Client(Index).Update = True End If End If 'roller If Mid(Split(Walkmp, Chr(13))(Client(Index).PosY), Client(Index).PosX + 1, 1) = "R" Then FurniOP = ReadINI("furnies", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") If FurniOP <> "" Then FurniType = FSO.OpenTextFile(DBP & "furni\" & FurniOP & "\type.txt", ForReading).ReadAll 'sit If FurniType = "sit" And Client(Index).Sit = False Then Client(Index).Sit = True Client(Index).Dance = False Client(Index).Lay = False Client(Index).Update = True End If 'sit 'lay If FurniType = "bed" And Client(Index).Lay = False Then Client(Index).Sit = False Client(Index).Dance = False Client(Index).Lay = True Client(Index).Update = True End If 'lay Else If Client(Index).Sit = True Then Client(Index).Sit = False Client(Index).Update = True End If If Client(Index).Lay = True Then Client(Index).Lay = False Client(Index).Update = True End If End If End If 'roller End If If Client(Index).Update = True And Client(Index).InRoom > 0 Then Client(Index).Update = False Owner = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\owner.txt").ReadAll rights = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\rights.txt").ReadAll If Owner = Client(Index).Name Then extbt = extbt & "flatctrl useradmin/" If FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\allrights.txt").ReadAll = "1" Then extbt = extbt & "flatctrl useradmin/" Else Splitt = Split(rights, ";") For Q = 0 To UBound(Splitt()) If Splitt(Q) = Client(Index).Name Then extbt = extbt & "flatctrl useradmin/" Exit For End If Next Q End If If Client(Index).DestX <> Client(Index).PosX Or Client(Index).DestY <> Client(Index).PosY Then Client(Index).Update = True htmp = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\shtmp.txt").ReadAll Walkmp = FSO.OpenTextFile(DBP & "privaterooms\" & Client(Index).InRoom & "\walk.txt").ReadAll NwP = findPath(Index, Client(Index).PosX, Client(Index).PosY, Client(Index).DestX, Client(Index).DestY, Client(Index).InRoom, (Walkmp), (htmp)) If NwP = "NoPath" Then Client(Index).DestX = Client(Index).PosX Client(Index).DestY = Client(Index).PosY NwP = Client(Index).PosX & "," & Client(Index).PosY Else Client(Index).Sit = False Client(Index).Lay = False extbt = extbt & "mv " & NwP & "," & Client(Index).He & "/" End If End If If Client(Index).DestX = Client(Index).PosX And Client(Index).DestY = Client(Index).PosY Then Client(Index).Update = False If Client(Index).Kick = True Then Client(Index).Kick = False Hab_Kick Index End If End If If Client(Index).TelMove = True Then extbt = extbt & "mv " & Client(Index).TelX & "," & Client(Index).TelY & "," & Client(Index).TelHe & "/" End If If Client(Index).Wave = True Then extbt = extbt & "wave/" End If If Client(Index).Dance = True Then extbt = extbt & Client(Index).Dancetype & "/" End If If Val(Client(Index).Carrying) > 0 Then If Client(Index).NoDrink = False Then If Client(Index).DoDrink = False Then extbt = extbt & "carryd " & Client(Index).Carrying & "/" Else extbt = extbt & "drink " & Client(Index).Carrying & "/" Client(Index).DoDrink = False Client(Index).Update = True End If Else If Client(Index).UseItem = False Then extbt = extbt & "cri " & Client(Index).Carrying & "/" Else extbt = extbt & "usei " & Client(Index).Carrying & "/" End If End If End If If Client(Index).Talking = True Then extbt = extbt & "talk/" End If If Client(Index).Gesture <> "" Then extbt = extbt & "gest " & Client(Index).Gesture & "/" End If If Client(Index).Trading = True Then extbt = extbt & "trd/" End If If Client(Index).Sit = True Then If Right(Client(Index).Look, 1) <> Right(ReadINI("rotation", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt"), 1) Then Client(Index).Look = ReadINI("rotation", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") Hoogte = Val(ReadINI("offset", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt")) 'Hoogte = Hoogte + Val(Client(Index).He) 'If Client(Index).InBig = True Then Hoogte = Hoogte / 3 Hoogte = Replace(Hoogte, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "sit " & Hoogte & "/" End If If Client(Index).Lay = True Then Client(Index).Look = ReadINI("rotation", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt") Hoogte = Val(ReadINI("offset", Client(Index).PosX & "," & Client(Index).PosY, DBP & "privaterooms\" & Client(Index).InRoom & "\rotation.txt")) 'Hoogte = Hoogte + Val(Client(Index).He) 'If Client(Index).InBig = True Then Hoogte = Hoogte / 3 Hoogte = Replace(Hoogte, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "lay " & Hoogte & " null/" End If FirstHe = Replace(FirstHe, ",", ".") If InStr(FirstHe, ".") = 0 Then FirstHe = FirstHe & ".0" sendAll "@b" & Client(Index).Num & " " & Client(Index).PosX & "," & Client(Index).PosY & "," & FirstHe & "," & Client(Index).Look & "/" & extbt & Chr(13) & Chr(1), (Client(Index).InRoom) If Client(Index).TelMove = True Then Client(Index).TelMove = False Client(Index).PosX = Client(Index).TelX Client(Index).PosY = Client(Index).TelY Client(Index).He = Client(Index).TelHe Client(Index).DestX = Client(Index).TelX Client(Index).DestY = Client(Index).TelY End If If NwP <> "" Then Client(Index).PosX = Split(NwP, ",")(0) Client(Index).PosY = Split(NwP, ",")(1) End If End If ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Else ''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''''' Hoogte = Replace(Client(Index).He, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" 'If PublicWalk(Client(index).Publicnum, Client(index).PosX, Client(index).PosY) & ".0" <> Hoogte And Client(index).Sit = False And Client(index).Lay = False Then 'If PublicWalk(Client(index).Publicnum, Client(index).PosX, Client(index).PosY) <> "X" Then 'Client(index).He = PublicWalk(Client(index).Publicnum, Client(index).PosX + 1, Client(index).PosY) & ".0" 'FirstHe = Client(index).He 'Client(index).UpDate = True 'End If 'End If 'If Replace(0.4 + Val(Mid(Split(Htmp, Chr(13))(Val(Client(index).PosY) + BijY), Val(Client(index).PosX) + BijX + 1, 1)), ",", ".") <> Hoogte And Client(index).Sit = False And Client(index).Lay = False Then 'Client(index).He = Replace(0.4 + Val(Mid(Split(Htmp, Chr(13))(Val(Client(index).PosY)), Val(Client(index).PosX) + 1, 1)), ",", ".") 'FirstHe = Client(index).He 'Client(index).UpDate = True 'End If 'If IsNumeric(PublicWalk(Client(index).Publicnum, Client(index).PosX, Client(index).PosY)) = False Then 'If Client(index).Sit = False Then 'Client(index).Sit = True 'Client(index).Dance = False 'Client(index).Lay = False 'Client(index).UpDate = True 'End If 'End If 'If IsNumeric(PublicWalk(Client(index).Publicnum, Client(index).PosX, Client(index).PosY)) = True Then 'If Client(index).Lay = True Or Client(index).Sit = True Then 'Client(index).Sit = False 'Client(index).Lay = False 'Client(index).UpDate = True 'End If 'End If If PublicWalk(Client(Index).Publicnum, Client(Index).PosX, Client(Index).PosY) = "S" Then If Client(Index).Sit = False Then Client(Index).Sit = True Client(Index).Look = PublicRot(Client(Index).Publicnum, Client(Index).PosX, Client(Index).PosY) Client(Index).Lay = False Client(Index).Dance = False Client(Index).Update = True End If Else Client(Index).Sit = False End If If Client(Index).DestX <> Client(Index).PosX Or Client(Index).DestY <> Client(Index).PosY Then Client(Index).Update = True HeightMap = FSO.OpenTextFile(DBP & "pub\" & Client(Index).Publicnum & "\heightmap.map", ForReading).ReadAll NwP = FindPathP(Index, Client(Index).PosX, Client(Index).PosY, Client(Index).DestX, Client(Index).DestY, HeightMap) If NwP = "NoPath" Then Client(Index).DestX = Client(Index).PosX Client(Index).DestY = Client(Index).PosY NwP = Client(Index).PosX & "," & Client(Index).PosY Else 'MsgBox "YAY!" Client(Index).Sit = False Client(Index).Lay = False extbt = extbt & "mv " & NwP & "," & Client(Index).He & "/" End If End If If Client(Index).DestX = Client(Index).PosX And Client(Index).DestY = Client(Index).PosY Then Client(Index).Update = False If Client(Index).Kick = True Then Client(Index).Kick = False Hab_Kick Index GoTo Ntb End If CheckPosition Index End If Ntb: If Client(Index).Wave = True Then extbt = extbt & "wave/" End If If Client(Index).Dance = True Then extbt = extbt & Client(Index).Dancetype & "/" End If If Val(Client(Index).Carrying) > 0 Then If Client(Index).NoDrink = False Then If Client(Index).DoDrink = False Then extbt = extbt & "carryd " & Client(Index).Carrying & "/" Else extbt = extbt & "drink " & Client(Index).Carrying & "/" Client(Index).DoDrink = False Client(Index).Update = True End If Else If Client(Index).UseItem = False Then extbt = extbt & "cri " & Client(Index).Carrying & "/" Else extbt = extbt & "usei " & Client(Index).Carrying & "/" End If End If End If If Client(Index).Talking = True Then extbt = extbt & "talk/" End If If Client(Index).Gesture <> "" Then extbt = extbt & "gest " & Client(Index).Gesture & "/" End If If Client(Index).Trading = True Then extbt = extbt & "trd/" End If If Client(Index).Sit = True Then Hoogte = "1" If Right(Client(Index).Look, 1) <> Right(PublicRot(Client(Index).Publicnum, Client(Index).PosX, Client(Index).PosY), 1) Then Client(Index).Look = PublicRot(Client(Index).Publicnum, Client(Index).PosX, Client(Index).PosY) 'Hoogte = Hoogte + Val(Client(Index).He) 'If Client(Index).InBig = True Then Hoogte = Hoogte / 3 Hoogte = Replace(Hoogte, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "sit " & Hoogte & "/" End If If Client(Index).Lay = True Then Client(Index).Look = "1,1" Hoogte = "1" 'Hoogte = Hoogte + Val(Client(Index).He) 'If Client(Index).InBig = True Then Hoogte = Hoogte / 3 Hoogte = Replace(Hoogte, ",", ".") If InStr(Hoogte, ".") = 0 Then Hoogte = Hoogte & ".0" extbt = extbt & "lay " & Hoogte & " null/" End If FirstHe = Replace(FirstHe, ",", ".") If InStr(FirstHe, ".") = 0 Then FirstHe = FirstHe & ".0" sendAllP "@b" & Client(Index).Num & " " & Client(Index).PosX & "," & Client(Index).PosY & "," & FirstHe & "," & Client(Index).Look & "/" & extbt & Chr(13) & Chr(1), (Client(Index).Publicnum) If Client(Index).TelMove = True Then Client(Index).TelMove = False Client(Index).PosX = Client(Index).TelX Client(Index).PosY = Client(Index).TelY Client(Index).He = Client(Index).TelHe Client(Index).DestX = Client(Index).TelX Client(Index).DestY = Client(Index).TelY End If If NwP <> "" Then Client(Index).PosX = Split(NwP, ",")(0) Client(Index).PosY = Split(NwP, ",")(1) End If '''''' End If '''''' lol: End Sub Public Sub DoTimer(Index As Integer) TimerTeleport1_Timer Index End Sub Private Sub TimerVanish_Timer(Index As Integer) If TimerVanish(Index).Tag = 2 Then Client(Index).NoDrink = True Client(Index).UseItem = False Client(Index).Carrying = 0 TimerVanish(Index).Enabled = False TimerDrink(Index).Enabled = False Client(Index).Update = True Else TimerVanish(Index).Tag = Val(TimerVanish(Index).Tag) + 1 End If End Sub Private Sub TimerWave_Timer(Index As Integer) On Error GoTo lol TimerWave(Index).Enabled = False Client(Index).Wave = False Client(Index).Update = True lol: End Sub Private Sub txtLog_Change() If Len(txtLog.Text) > 32000 Then txtLog.Text = "" End Sub Private Sub txtLog_KeyDown(KeyCode As Integer, Shift As Integer) If KeyCode = vbKeyEscape Then If Text2.Visible = False Then Text2.Visible = True Else Text2.Visible = False End If End Sub Private Sub UpdateFurni_Timer(Index As Integer) On Error GoTo lol If Index > 0 Then Fname = FSO.OpenTextFile(DBP & "furni\" & Index & "\name.txt", ForReading).ReadAll FCol = Split(FSO.OpenTextFile(DBP & "furni\" & Index & "\cust.txt", ForReading).ReadAll, Chr(30))(2) Var = FSO.OpenTextFile(DBP & "furni\" & Index & "\var.txt", ForReading).ReadAll FHeight = FSO.OpenTextFile(DBP & "furni\" & Index & "\height.txt", ForReading).ReadAll loca = Split(FSO.OpenTextFile(DBP & "furni\" & Index & "\loc.txt", ForReading).ReadAll, " ") Custsplit = Split(FSO.OpenTextFile(DBP & "furni\" & Index & "\cust.txt", ForReading).ReadAll, "") 'pet part If Fname = "nest" Then splitP = Split(frmMain.Hpets, ";") For b = 0 To UBound(splitP) If splitP(b) <> "" Then If Pet(splitP(b)).FurniID = Index Then Pet(splitP(b)).NestX = loca(0) Pet(splitP(b)).NestY = loca(1) End If End If Next b End If 'pet part FHeight = Replace(FHeight, ",", ".") If InStr(FHeight, ".") = 0 Then FHeight = FHeight & ".0" sendAll "A_" & Index & Chr(2) & Fname & Chr(2) & VL64encode(loca(0)) & VL64encode(loca(1)) & VL64encode(Custsplit(0)) & VL64encode(Custsplit(1)) & VL64encode(loca(2)) & FHeight & Chr(2) & FCol & Chr(2) & Chr(2) & Var & Chr(2) & Chr(1), (InRoom) Unload UpdateFurni(Index) End If lol: End Sub Private Sub UseTimer_Timer(Index As Integer) On Error GoTo lol Client(Index).UseItem = False UseTimer(Index).Enabled = False Client(Index).Update = True lol: End Sub