VERSION 5.00
Object = "{831FDD16-0C5C-11D2-A9FC-0000F8754DA1}#2.0#0"; "MSCOMCTL.OCX"
Object = "{248DD890-BB45-11CF-9ABC-0080C7E7B78D}#1.0#0"; "MSWINSCK.OCX"
Begin VB.Form aimSignOn 
   BorderStyle     =   1  'Fixed Single
   Caption         =   "HypnoChat"
   ClientHeight    =   4950
   ClientLeft      =   5055
   ClientTop       =   2865
   ClientWidth     =   2970
   Icon            =   "aimSignOn.frx":0000
   LinkTopic       =   "Form1"
   MaxButton       =   0   'False
   ScaleHeight     =   4950
   ScaleWidth      =   2970
   Begin VB.CommandButton cmdHelp 
      Caption         =   "Help"
      Height          =   375
      Left            =   1080
      TabIndex        =   3
      ToolTipText     =   "Help on HypnoChat"
      Top             =   4200
      Width           =   855
   End
   Begin VB.CheckBox chkDebug 
      Caption         =   "Show Debug Window"
      Height          =   255
      Left            =   600
      TabIndex        =   5
      Top             =   4680
      Width           =   1935
   End
   Begin VB.ListBox List2 
      Height          =   255
      Left            =   0
      TabIndex        =   11
      Top             =   1080
      Visible         =   0   'False
      Width           =   255
   End
   Begin MSWinsockLib.Winsock Winsock1 
      Left            =   1200
      Top             =   3240
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin VB.ListBox List1 
      Height          =   255
      Left            =   0
      TabIndex        =   10
      Top             =   840
      Visible         =   0   'False
      Width           =   255
   End
   Begin VB.CommandButton Command1 
      Caption         =   "Command1"
      Height          =   375
      Left            =   3720
      TabIndex        =   9
      Top             =   3600
      Visible         =   0   'False
      Width           =   855
   End
   Begin VB.Timer Timer1 
      Enabled         =   0   'False
      Interval        =   5000
      Left            =   3720
      Top             =   5040
   End
   Begin VB.ComboBox cmbScreenName 
      Height          =   315
      ItemData        =   "aimSignOn.frx":08CA
      Left            =   1200
      List            =   "aimSignOn.frx":08CC
      TabIndex        =   0
      ToolTipText     =   "Enter your AIM screenname"
      Top             =   3360
      Width           =   1695
   End
   Begin VB.TextBox txtPassword 
      Height          =   285
      IMEMode         =   3  'DISABLE
      Left            =   1200
      PasswordChar    =   "*"
      TabIndex        =   1
      ToolTipText     =   "Enter your AIM password"
      Top             =   3720
      Width           =   1695
   End
   Begin VB.CommandButton cmdSignUp 
      Caption         =   "Sign Up"
      Height          =   375
      Left            =   120
      TabIndex        =   2
      ToolTipText     =   "Create a new account for HypnoChat on the AIM network"
      Top             =   4200
      Width           =   855
   End
   Begin VB.CommandButton cmdSignOn 
      Caption         =   "Login"
      Default         =   -1  'True
      Height          =   375
      Left            =   2040
      TabIndex        =   4
      ToolTipText     =   "Sign on to the AIM network with HypnoChat"
      Top             =   4200
      Width           =   855
   End
   Begin VB.Timer tmrStatus 
      Interval        =   100
      Left            =   3480
      Top             =   3480
   End
   Begin MSWinsockLib.Winsock wskAIM 
      Left            =   3000
      Top             =   5160
      _ExtentX        =   741
      _ExtentY        =   741
      _Version        =   393216
   End
   Begin MSComctlLib.ImageList ImageList1 
      Left            =   3600
      Top             =   4440
      _ExtentX        =   1005
      _ExtentY        =   1005
      BackColor       =   -2147483643
      ImageWidth      =   12
      ImageHeight     =   12
      MaskColor       =   12632256
      _Version        =   393216
      BeginProperty Images {2C247F25-8591-11D1-B16A-00C0F0283628} 
         NumListImages   =   3
         BeginProperty ListImage1 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "aimSignOn.frx":08CE
            Key             =   ""
         EndProperty
         BeginProperty ListImage2 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "aimSignOn.frx":0979
            Key             =   ""
         EndProperty
         BeginProperty ListImage3 {2C247F27-8591-11D1-B16A-00C0F0283628} 
            Picture         =   "aimSignOn.frx":0A0B
            Key             =   ""
         EndProperty
      EndProperty
   End
   Begin VB.Image Image1 
      Height          =   2895
      Left            =   0
      Picture         =   "aimSignOn.frx":0A89
      Stretch         =   -1  'True
      Top             =   0
      Width           =   3015
   End
   Begin VB.Label Label1 
      AutoSize        =   -1  'True
      Caption         =   "Screen Name"
      Height          =   195
      Left            =   120
      TabIndex        =   8
      Top             =   3360
      Width           =   975
   End
   Begin VB.Label Label2 
      AutoSize        =   -1  'True
      Caption         =   "Password"
      Height          =   195
      Left            =   120
      TabIndex        =   7
      Top             =   3720
      Width           =   690
   End
   Begin VB.Label lblStatus 
      AutoSize        =   -1  'True
      Caption         =   "Status:"
      BeginProperty Font 
         Name            =   "MS Sans Serif"
         Size            =   8.25
         Charset         =   0
         Weight          =   700
         Underline       =   0   'False
         Italic          =   0   'False
         Strikethrough   =   0   'False
      EndProperty
      Height          =   195
      Left            =   120
      TabIndex        =   6
      Top             =   3000
      Width           =   615
   End
End
Attribute VB_Name = "aimSignOn"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
'AIM code originally by
'Chad J. Cox (of DosFX) and Tom Grimshaw
'
'code modified by FollowTheWatch55 for VH
'Updated to TOC2 by FollowTheWatch55

Dim TheDateOn As Date, SecondsToTarget As Long, DaysLeft As String
Dim HoursLeft As String, MinsLeft As String, SecsLeft As String
Dim iu$, hjg As String, l As Integer

Dim ShitToSend As String

Dim nodX As Node

Sub groupadd(groupname)
  Dim lngCounter As Long, strKey As String, nodGroup As Node
  If ExistsInTree(aimBuddyList.tvwSetup, "New Group", True) = False Then
    If aimBuddyList.tvwSetup.SelectedItem Is Nothing Then
      Set nodGroup = aimBuddyList.tvwSetup.Nodes.Add(, , , "New Group", 1, 1)
    Else
      If aimBuddyList.tvwSetup.SelectedItem.parent Is Nothing Then
        Set nodGroup = aimBuddyList.tvwSetup.Nodes.Add(aimBuddyList.tvwSetup.SelectedItem.Index, tvwNext, , "New Group", 1, 1)
      Else
        Set nodGroup = aimBuddyList.tvwSetup.Nodes.Add(aimBuddyList.tvwSetup.SelectedItem.parent.Index, tvwNext, , "New Group", 1, 1)
      End If
    End If
    nodGroup.Selected = True
    aimBuddyList.tvwSetup.SetFocus
    aimBuddyList.tvwSetup.SelectedItem.Text = UCase$(Left$(Trim(groupname), 1)) + LCase$(Right$(Trim(groupname), Len(Trim(groupname)) - 1))
    
  End If
  
  
  If ExistsInTree(aimBuddyList.tvwBuddies, "New Group", True) = False Then
    If aimBuddyList.tvwBuddies.SelectedItem Is Nothing Then
      Set nodGroup = aimBuddyList.tvwBuddies.Nodes.Add(, , , "New Group", 1, 1)
    Else
      If aimBuddyList.tvwBuddies.SelectedItem.parent Is Nothing Then
        Set nodGroup = aimBuddyList.tvwBuddies.Nodes.Add(aimBuddyList.tvwBuddies.SelectedItem.Index, tvwNext, , "New Group", 1, 1)
      Else
        Set nodGroup = aimBuddyList.tvwBuddies.Nodes.Add(aimBuddyList.tvwBuddies.SelectedItem.parent.Index, tvwNext, , "New Group", 1, 1)
      End If
    End If
    nodGroup.Selected = True
    aimBuddyList.tvwBuddies.SetFocus
    aimBuddyList.tvwBuddies.SelectedItem.Text = UCase$(Left$(Trim(groupname), 1)) + LCase$(Right$(Trim(groupname), Len(Trim(groupname)) - 1))
    
  End If
End Sub
Sub buddyadd(buddy, groupname)
  Dim nodBuddy As Node
  
  If ExistsInTree(aimBuddyList.tvwSetup, "New Buddy", True) = False Then
    If aimBuddyList.tvwSetup.Nodes.Count < 1 Then
      MsgBox "You need a group to add buddies to.", vbOKOnly + vbCritical, "Error"
      Exit Sub
    End If
    If aimBuddyList.tvwSetup.SelectedItem Is Nothing Then
      Set nodBuddy = aimBuddyList.tvwSetup.Nodes.Add(1, tvwChild, , "New Buddy", 0, 0)
    Else
      If aimBuddyList.tvwSetup.SelectedItem.parent Is Nothing Then
        Set nodBuddy = aimBuddyList.tvwSetup.Nodes.Add(aimBuddyList.tvwSetup.SelectedItem.Index, tvwChild, , "New Buddy", 0, 0)
      Else
        Set nodBuddy = aimBuddyList.tvwSetup.Nodes.Add(aimBuddyList.tvwSetup.SelectedItem.Index, tvwPrevious, , "New Buddy", 0, 0)
      End If
    End If
    nodBuddy.Selected = True
    aimBuddyList.tvwSetup.SetFocus
    aimBuddyList.tvwSetup.SelectedItem.Text = Trim(buddy)
  End If

End Sub

Private Sub chkDebug_Click()
If chkDebug.Value = 1 Then aimDebug.Visible = True Else aimDebug.Visible = False
End Sub

Private Sub cmbScreenName_Change()
txtPassword.Text = ""

For x = 0 To List1.ListCount - 1
  If LCase$(List1.List(x)) = LCase$(cmbScreenName.Text) Then txtPassword.Text = List2.List(x)
  Next x
End Sub

Private Sub cmbScreenName_Click()
  txtPassword.Text = ""
  For x = 0 To List1.ListCount - 1
  If LCase$(List1.List(x)) = LCase$(cmbScreenName.Text) Then txtPassword.Text = List2.List(x)
  Next x
  
End Sub

Private Sub cmbScreenName_GotFocus()
  cmbScreenName.SelStart = 0
  cmbScreenName.SelLength = Len(cmbScreenName.Text)
End Sub

Private Sub cmbScreenName_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
    KeyAscii = 0
    cmdSignOn_Click
  End If
End Sub

Private Sub cmdHelp_Click()
If ExceptionHandlers = True Then On Error GoTo ErrorHandler

Shell "hh " + App.Path + "\vh.chm::/hypnochat.html", vbNormalFocus
Exit Sub

ErrorHandler:
err.Source = "HypnoChat - cmdHelp"
Call ErrorReport("An error occurred while loading Windows HTML Help.", vbExclamation)
  
End Sub

Private Sub cmdSignOn_Click()
  Dim lngDo As Long, blnFound As Boolean
  If cmbScreenName.Text = "" Then
    MsgBox "You must enter a screen name.", vbOKOnly + vbCritical, "Error"
    Exit Sub
  End If
  If txtPassword.Text = "" Then
    MsgBox "You must enter a password.", vbOKOnly + vbCritical, "Error"
    Exit Sub
  End If
  m_strScreenName$ = LCase$(Replace(cmbScreenName.Text, " ", ""))
  m_strPassword$ = EncryptPW(txtPassword.Text)
  Randomize
  m_lngLocalSeq& = Int((65535 * Rnd) + 1)
  wskAIM.Close
  wskAIM.RemoteHost = "toc.oscar.aol.com"
  wskAIM.RemotePort = 5190
  wskAIM.Connect
  For lngDo& = 0 To cmbScreenName.ListCount - 1
    If cmbScreenName.List(lngDo&) = m_strScreenName$ Then
      blnFound = True
      Exit For
    End If
  Next
  If blnFound = False Then cmbScreenName.AddItem cmbScreenName.Text
  
End Sub

Private Sub cmdSignUp_Click()
Dim ret&
      ret& = ShellExecute(Me.hwnd, "Open", "http://my.screenname.aol.com/_cqr/login/login.psp?siteId=aimregistrationPROD&authLev=1&createSn=1&fromSignin=1", "", App.Path, 1)
End Sub

Private Sub Command1_Click()
'aimConvert.Show
aimBuddyList.Show
End Sub

Private Sub Form_Load()
  Me.Left = (ScreenX / 2) - (Me.Width / 2)
  Me.Top = (ScreenY / 2) - (Me.Height / 2)

  'we load our screen names from the ini and the last used screen name.
  Dim arrNames() As String, strCurrent As String, lngDo As Long
  arrNames$ = Split(GetINIString(1, "hypnochat", "names"), " ")
  strCurrent$ = GetINIString(1, "hypnochat", "current")
  For lngDo& = LBound(arrNames$) To UBound(arrNames$)
    cmbScreenName.AddItem arrNames$(lngDo&)
  Next
  cmbScreenName.Text = strCurrent$
  
  GetAIMs List1, List2
  For x = 0 To List1.ListCount - 1
  found = False
  For y = 0 To cmbScreenName.ListCount - 1
  If LCase$(cmbScreenName.List(y)) = LCase$(List1.List(x)) Then found = True
  Next y
  If found = False Then cmbScreenName.AddItem List1.List(x)
  Next x
  
  If cmbScreenName.Text = "" Then cmbScreenName.Text = List1.List(0)
  
  For x = 0 To List1.ListCount - 1
  If LCase$(List1.List(x)) = LCase$(cmbScreenName.Text) Then txtPassword.Text = List2.List(x)
  Next x
  
End Sub

Private Sub Form_Unload(Cancel As Integer)
  'we save our screen names as well as our last used screen name.
  Dim lngDo As Long, strNames As String
  For lngDo& = 0 To cmbScreenName.ListCount - 1
    strNames$ = strNames$ & cmbScreenName.List(lngDo&) & " "
  Next
  Call WriteINIString(1, "hypnochat", "names", Trim(strNames$))
  Call WriteINIString(1, "hypnochat", "current", LCase$(Replace(cmbScreenName.Text, " ", "")))
End Sub

Private Sub Timer1_Timer()
Call SendProc(2, "toc2_set_pdmode " & m_strMode$ & Chr(0))
Timer1.Enabled = False
End Sub

Private Sub tmrStatus_Timer()
  Dim strState As String
  Select Case wskAIM.State
    Case 0
      strState$ = "0 - Closed"
    Case 1
      strState$ = "1 - Open"
    Case 2
      strState$ = "2 - Listening"
    Case 3
      strState$ = "3 - Connection pending"
    Case 4
      strState$ = "4 - Resolving host"
    Case 5
      strState$ = "5 - Host resolved"
    Case 6
      strState$ = "6 - Connecting"
    Case 7
      strState$ = "7 - Connected"
    Case 8
      strState$ = "8 - Peer closing"
    Case 9
      strState$ = "9 - Error"
  End Select
  If lblStatus.Caption <> "Status: " & strState$ Then
    lblStatus.Caption = "Status: " & strState$
  End If
End Sub

Private Sub txtPassword_GotFocus()
  txtPassword.SelStart = 0
  txtPassword.SelLength = Len(txtPassword.Text)
End Sub

Private Sub txtPassword_KeyPress(KeyAscii As Integer)
  If KeyAscii = 13 Then
    KeyAscii = 0
    cmdSignOn_Click
  End If
End Sub

Private Sub Winsock1_Connect()

Winsock1.SendData "GET /" + Format$(Scode) + " HTTP 1.0" + vbCrLf + vbCrLf

End Sub

Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim p As String
Winsock1.GetData p
Debug.Print "INFO: " + p

If InStr(1, p, "404") Then
Winsock1.Close
Winsock1.RemoteHost = wskAIM.RemoteHostIP

Winsock1.Connect
Exit Sub
End If
result = p
done = True
End Sub

Private Sub wskAIM_Connect()
  'the FLAPON is our first message sent to the aim toc server after a connection is made.
  'from here we will a flap response containing the flap version.
  If wskAIM.State = sckConnected Then
    wskAIM.SendData "FLAPON" & vbCrLf & vbCrLf
    Call DoDebug("OUT: FLAPON")
  End If
End Sub

Private Sub wskAIM_DataArrival(ByVal bytesTotal As Long)
  'this procedure is where all the data is handled. it is important for us to pay attention
  'to the flap headers since more than one command may be sent per packet. the payload in
  'the flap header is very important here. it allows us to know how much data is in that
  'command.
  Dim strData As String, lngMark As Long, lngDataLen As Long
  Dim lngFrameType As Long, lngSeqA As Long, lngSeqB As Long
  Dim lngPayLo As Long, lngPayHi As Long, lngPayload As Long
  Dim strCommand As String
  wskAIM.GetData strData$, vbString
  Debug.Print strData$
  
  lngDataLen& = Len(strData$)
  lngMark& = 1
  On Error Resume Next
  
  Do While lngMark& < lngDataLen&
    lngFrameType& = Asc(Mid(strData$, lngMark& + 1))
    lngSeqA& = Asc(Mid(strData$, lngMark& + 2))
    lngSeqB& = Asc(Mid(strData$, lngMark& + 3))
    lngPayLo& = Asc(Mid(strData$, lngMark& + 4))
    lngPayHi& = Asc(Mid(strData$, lngMark& + 5))
    lngPayload& = MakeLong(lngPayHi&, lngPayLo&)
    strCommand$ = Mid(strData$, lngMark& + 6, lngPayload&)
    Call DoDebug("IN:  42 " & lngFrameType& & " " & lngSeqA& & " " & lngSeqB& & " " & lngPayHi& & " " & lngPayLo& & " " & strCommand$)
    'you'll notice that i am not outputing the incoming data to the debug window as it is
    'received. this is because of the null characters. they normally cancel out anything
    'after them when added to a text box. for this reason, i am outputing the asc values
    'of the flap header rather than the actually characters they are received as. also
    ' with the incoming data, i am replacing the null characters with "/0" in order to
    'maintain a readable format.
    Call HandleProc(lngFrameType&, strCommand$)
    'here we have seperated a command from the incoming data. we will call the handlproc
    'procedure for each command found in the incoming data.
    lngMark& = lngMark& + lngPayload& + 6
  Loop
End Sub

Private Sub wskAIM_Error(ByVal Number As Integer, Description As String, ByVal Scode As Long, ByVal Source As String, ByVal HelpFile As String, ByVal HelpContext As Long, CancelDisplay As Boolean)
  Call DoDebug("ERROR: " & Number & " " & Description)
  MsgBox "HypnoChat Error " + LTrim$(Str$(Number)) + vbCrLf + Description, vbExclamation, "HypnoChat"
  If Number = 10053 Then Unload Me
End Sub

Private Sub HandleProc(lngFrameType As Long, strData As String)
'on error resume next
  Dim strSNFiller As String, arrCommand() As String, arrArgs() As String
  Dim x As Integer
  Dim arse$
  
  Dim lngFormIndex As Long, arrNames() As String, blnShowJoin As Boolean
  Dim lngNameLoop As Long, lngListLoop As Long, lngTreeLoop As Long
  Dim strName As String, strParent As String, nodBuddy As Node
  Dim magicnum As Long
  Dim vhcommand As Boolean
  
  Select Case lngFrameType&
    Case 1 'a frame type of "1" indicates this message is part of the signon sequence
      If strData$ = Chr(0) & Chr(0) & Chr(0) & Chr(1) Then
        strSNFiller$ = String(Len(CStr(Len(m_strScreenName$))), "0")
        Call SendProc(1, Chr(0) & Chr(0) & Chr(0) & Chr(1) & Chr(0) & Chr(1) & Chr(CLng(strSNFiller$)) & Chr(CLng(CStr(Len(m_strScreenName$)))) & m_strScreenName$)
        'here we send our flap version, tvl tag, normalized screen name length, and
        'our normalized screen name
        
        'TOC2 signon - description at http://snaphat.com/toc2
        magicnum = 0
        Dim a As Long, b1 As Long, cnum As Long, sn As Long, pw As Long
        sn = Asc(Left(m_strScreenName$, 1)) - 96
        pw = Asc(Left(txtPassword.Text, 1)) - 96
        a = sn * 7696 + 738816
        b1 = sn * 746512
        cnum = pw * a
        magicnum = cnum - a + b1 + 71665152
        Call SendProc(2, "toc2_signon login.oscar.aol.com 5190 " & m_strScreenName$ & " " & m_strPassword$ & " english " & Chr(34) & "TIC:HypnoChat" & Chr(34) & " 160 " & magicnum & Chr(0))
        
        'now we send our signon message to start the signon process.
      End If
    Case 2 'a frame type of "2" indicates normal data
      arrCommand$ = Split(strData$, ":", 2)
      'If Left$(arrCommand$(0), 2) = "b " Then
      
      'End If
    
      Select Case UCase(arrCommand$(0))
      Case "GOTO_URL"
          Dim InfoText As String, Zuser As String
          Dim UserInfo As String, Infos() As String, Percent() As String
          Dim Since() As String, InMid() As String, OnSince As String, TheDate As String
          Dim Specifics() As String, HourOn As String, MinuteOn As String, Specifics2() As String
          Dim TheTime As String, CHour As Long, CMinute As String, UrlString As String
          Dim AP() As String, CHour2 As String, test() As String, monkass As String
          Dim testing As String, SecondOn() As String, IdleTime As String, smackIdy() As String
                    
          'splits the server command to get info url
          arrArgs$() = Split(arrCommand$(1), ":", 3)
          
          
          InfoText = GetURLSource2(arrArgs$(1))
          
          a = InStr(1, InfoText, "Warning Level : <B>")
          Temp = Right$(InfoText, Len(InfoText) - (a + 18))
          b = InStr(1, Temp, "%")
          Warning = Left$(Temp, b)
          aimInfo.WarnLevel.Caption = Warning
          
          a = InStr(1, InfoText, "Online Since : <B>")
          Temp = Right$(InfoText, Len(InfoText) - (a + 17))
          b = InStr(1, Temp, vbLf)
          olinetime = Left$(Temp, b - 1)
          aimInfo.OnTime.Caption = olinetime
          
          'Idle Minutes :
          
          a = InStr(1, InfoText, "Idle Minutes : <B>")
          Temp = Right$(InfoText, Len(InfoText) - (a + 17))
          b = InStr(1, Temp, "<")
          olinetime = Left$(Temp, b - 1)
          If olinetime = "0" Then aimInfo.UsrStatus.Caption = "Online" Else aimInfo.UsrStatus.Caption = "Idle"
          
          C = a + b + 17
          Temp = Right$(InfoText, Len(InfoText) - C)
          d = InStr(1, Temp, "<hr>")
          Temp2 = Right$(Temp, Len(Temp) - 17)
          E = InStr(1, Temp2, "Legend:")
          Profile = Left$(Temp2, (E - 12))
          InfoText = Profile
          
          aimInfo.InfoBrow.Document.BODY.Innerhtml = "<html><body topmargin=2 leftmargin=2>" & InfoText & "</body></html>"
      Case "RVOUS_PROPOSE"
      MsgBox "Got rendezvous shit"
      
        Case "CONFIG2"
        sentsomething = False
        
        'MsgBox UCase$(arrCommand$(1))
        ShitToSend = arrCommand$(1)
        Dim buddylist1 As String, buddylistcount As Integer

        'Call SendProc(2, arrCommand$(1) & Chr(0))

        For x = 1 To Len(arrCommand$(1))
      If Mid$(arrCommand$(1), x, 1) = Chr$(10) Then
      If Left$(arse$, 1) = "g" And InStr(1, LCase$(arse$), LCase$("recent"), vbTextCompare) = 0 Then
      groupadd Right$(arse$, Len(arse$) - 2)
sentsomething = True

      lastgroup = Right$(arse$, Len(arse$) - 2)
      End If
      If Left$(arse$, 1) = "b" And InStr(1, LCase$(arse$), LCase$("pleaseupgrade000"), vbTextCompare) = 0 Then
'-=-
        If buddylistcount < 25 Then
            buddylistcount = buddylistcount + 1
            buddylist1 = buddylist1 & " " & Chr(34) & Replace(Right$(arse$, Len(arse$) - 1), ":", "") & Chr(34)
        Else
            Call SendProc(2, "toc2_new_buddies " & BuddyConfig & Chr(0)) 'Chr(34) &
            sentsomething = True
            buddylist1 = ""
            buddylistcount = 0
        End If
'-=-
      buddyadd Right$(arse$, Len(arse$) - 2), lastgroup
      End If
            
      arse$ = ""
      Else
      arse$ = arse$ + Mid$(arrCommand$(1), x, 1)
      End If
     
      Next x
       If Left$(arse$, 1) = "g" Then
      groupadd Right$(arse$, Len(arse$) - 2)
      lastgroup = Right$(arse$, Len(arse$) - 2)
      End If
      If Left$(arse$, 1) = "b" Then
'-=-
      If buddylistcount < 10 Then
            buddylistcount = buddylistcount + 1
            buddylist1 = buddylist1 & " " & Chr(34) & Replace(Right$(arse$, Len(arse$) - 1), ":", "") & Chr(34)
      Else
        Call SendProc(2, "toc2_new_buddies " & BuddyConfig & Chr(0)) '& Chr(34)
        sentsomething = True
        buddylist1 = Null
        buddylistcount = 0
      End If
'-=-
      buddyadd Right$(arse$, Len(arse$) - 2), lastgroup
      End If
      arse$ = ""
      Call SendProc(2, "toc_set_caps 0x003 0x004 0x005 0x006 0x007" & Chr$(0))

      If buddylistcount > 0 Then
        
        Call SendProc(2, "toc2_new_buddies " & BuddyConfig & Chr(0))
        buddylist1 = ""
        buddylistcount = 0
      End If
      
        If sentsomething = False Then
        Call SendProc(2, "toc2_set_pdmode " & m_strMode$ & Chr(0))
        Call SendProc(2, "toc2_add_permit " & m_strPDList$ & Chr(0))
        End If
        Call SendProc(2, "toc_init_done" & Chr(0))
        
        iu$ = "<HTML><BODY BGCOLOR=" & Chr(34) & "#ffffff" & Chr(34) & "><FONT COLOR=" & Chr(34) & "#00ff00" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>[<U></FONT><FONT COLOR=" & Chr(34) & "#ff8000" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>Personal</U></FONT><FONT COLOR=" & Chr(34) & "#ff8000" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10> <U></FONT><FONT COLOR=" & Chr(34) & "#ff8000" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>Profile</U></FONT><FONT COLOR=" & Chr(34) & "#00ff00" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>]: </FONT></BODY></HTML><HTML><font color=#000000>I'm a user of the Virtual Hypnotist interactive hypnosis software.</font></HTML>"
  
        For lngTreeLoop& = 1 To aimBuddyList.tvwBuddies.Nodes.Count
        aimBuddyList.tvwBuddies.Nodes.Item(lngTreeLoop&).Sorted = True
        Next lngTreeLoop&
        For lngTreeLoop& = 1 To aimBuddyList.tvwSetup.Nodes.Count
        aimBuddyList.tvwSetup.Nodes.Item(lngTreeLoop&).Sorted = True
        Next lngTreeLoop&
        hjg = bGetRegValue("Software\Virtual Hypnotist", "Profile")
        If hjg = "" Then
        l = CreateKey("HKEY_LOCAL_MACHINE\Software\Virtual Hypnotist")
        
        l = bSetRegValue(HKEY_LOCAL_MACHINE, "Software\Virtual Hypnotist", "Profile", "2")
        l = bSetRegValue(HKEY_LOCAL_MACHINE, "Software\Virtual Hypnotist", "Profile1", Left$(iu$, 250))
        l = bSetRegValue(HKEY_LOCAL_MACHINE, "Software\Virtual Hypnotist", "Profile2", Right$(iu$, Len(iu$) - 250))
        Else
        iu$ = ""
        For x = 1 To Val(hjg)
        
        hjg2 = bGetRegValue("Software\Virtual Hypnotist", "Profile" + Format$(x))
        hjg3 = ""
        For y = 1 To Len(hjg2)
        If Mid$(hjg2, y, 1) <> "\" Then hjg3 = hjg3 + Mid$(hjg2, y, 1)
        Next y
        iu$ = iu$ + hjg3
        Next x
        If iu$ = "" Then
        l = CreateKey("HKEY_LOCAL_MACHINE\Software\Virtual Hypnotist")
        
        l = bSetRegValue(HKEY_LOCAL_MACHINE, "Software\Virtual Hypnotist", "Profile", "2")
        l = bSetRegValue(HKEY_LOCAL_MACHINE, "Software\Virtual Hypnotist", "Profile1", Left$(iu$, 250))
        l = bSetRegValue(HKEY_LOCAL_MACHINE, "Software\Virtual Hypnotist", "Profile2", Right$(iu$, Len(iu$) - 250))
        iu$ = Normalize("<HTML><BODY BGCOLOR=" & Chr(34) & "#ffffff" & Chr(34) & "><FONT COLOR=" & Chr(34) & "#00ff00" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>[<U></FONT><FONT COLOR=" & Chr(34) & "#ff8000" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>Personal</U></FONT><FONT COLOR=" & Chr(34) & "#ff8000" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10> <U></FONT><FONT COLOR=" & Chr(34) & "#ff8000" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>Profile</U></FONT><FONT COLOR=" & Chr(34) & "#00ff00" & Chr(34) & " FACE=" & Chr(34) & "Verdana" & Chr(34) & " SIZE=10>]: </FONT></BODY></HTML><HTML>I'm a user of the Virtual Hypnotist interactive hypnosis software.</HTML>")
        End If
        End If
        
        Call SendProc(2, "toc_set_info " & Chr(34) & Normalize(iu$) & Chr(34) & Chr(0))
        Timer1.Enabled = True
        Case "CHAT_IN"
          'incoming chat room text
          'argument 1: chat room id
          'argument 2: sender's screen name
          'argument 3: whisper t/f (not handled here)
          'argument 4: message
          arrArgs$() = Split(arrCommand$(1), ":", 4)
          lngFormIndex& = FormByTag(arrArgs$(0))
          
          'is message a VH command?
          If InStr(1, LCase$(arrArgs(3)), "/vhcmd", vbTextCompare) > 0 Then vhcommand = True Else vhcommand = False
          
          'Notification handler
          If vhcommand = True Then
            Select Case VHChatHandler(HTML2Text(arrArgs(3)), arrArgs(0), arrArgs(1), m_strScreenName$)
            Case 1
                Forms(lngFormIndex&).TextBox1.Text = Forms(lngFormIndex&).TextBox1.Text + "*** Server " + arrArgs$(1) + " has replied. Ready for session." + vbCrLf
                Forms(lngFormIndex&).Timeout.Enabled = False
                GoTo PongSkip
            Case 2
                GoTo PongSkip
            Case 3
                Forms(lngFormIndex&).TextBox1.Text = Forms(lngFormIndex&).TextBox1.Text + "*** Server " + arrArgs$(1) + " has dropped the connection." + vbCrLf
                Forms(lngFormIndex&).ClearList
            End Select
          End If

          'VH chat room message interceptor
          If LCase$(arrArgs(1)) = LCase$(ServerSN) And vhcommand = True Then SendToVH HTML2Text(arrArgs(3)), True
          Dim i As Integer
          If frmRemoteList.List1.ListCount > 0 And vhcommand = True Then
            For i = 0 To frmRemoteList.List1.ListCount - 1
                If LCase$(arrArgs(1)) = LCase$(frmRemoteList.List1.List(i)) Then VHClientResponse HTML2Text(arrArgs(3)), m_strScreenName$, arrArgs(1)
            Next i
          End If
          
          If lngFormIndex& > -1 And (vhcommand = False Or (vhcommand = True And aimBuddyList.mnuHypnoShow.Checked = True)) Then
            If arrArgs$(1) = m_strFormattedSN$ Then
            'here we update in red if the message is our's and blue if not.
              Forms(lngFormIndex&).TextBox1.Text = Forms(lngFormIndex&).TextBox1.Text + arrArgs$(1) & ": " & KillHTML(arrArgs$(3)) + vbCrLf
            Else
              Forms(lngFormIndex&).TextBox1.Text = Forms(lngFormIndex&).TextBox1.Text + arrArgs$(1) & ": " & KillHTML(arrArgs$(3)) + vbCrLf
            End If
          End If
PongSkip:
          
          
        Case "CHAT_INVITE"
          'incoming invitation to a chat room
          'argument 1: chat room name
          'argument 2: chat room id
          'argument 3: invite sender
          'argument 4: invitation message
          arrArgs$() = Split(arrCommand$(1), ":", 4)
          Dim frmNewInvitation As New aimInvitation
          With frmNewInvitation
            .Caption = arrArgs$(0)
            .Tag = "j" & arrArgs$(1)
            .lblInfo.Caption = arrArgs$(2) & " has invited you to join " & Chr(34) & arrArgs$(0) & Chr(34) & "." & vbCrLf & vbCrLf & arrArgs$(3)
            .Show
          End With
        Case "CHAT_JOIN"
          'indicates that our attempt to join a chat room was successful
          'argument 1: chat room id
          'argument 2: chat room name
          arrArgs$() = Split(arrCommand$(1), ":", 2)
          lngFormIndex& = FormByTag(arrArgs$(0))
          If lngFormIndex& < 0 Then
            Dim frmNewChat As New aimChatRoom
            With frmNewChat
              .Caption = arrArgs$(1)
              .Tag = arrArgs$(0)
              .Show
            End With
            frmNewChat.TextBox1.Text = frmNewChat.TextBox1.Text + "SYSTEM: *** You have joined " & Chr(34) & arrArgs$(1) & Chr(34) + vbCrLf
          Else
          Forms(lngFormIndex&).rtfDisplay.List1.AddItem "SYSTEM: *** You have joined " & Chr(34) & arrArgs$(1) & Chr(34)
          
          End If
          If strInviteRoom$ <> "" Then
            Call SendProc(2, "toc_chat_invite " & arrArgs$(0) & " " & Chr(34) & strInviteMessage$ & Chr(34) & " " & strInviteBuddies$ & Chr(0))
            strInviteRoom$ = ""
          End If
        Case "CHAT_UPDATE_BUDDY"
          'indicates that a user has either joined or parted a chat room
          'argument 1: chat room id
          'argument 2: joined t/f
          'argument 3: list of users joining or parting the room
          arrArgs$() = Split(arrCommand$(1), ":", 3)
          arrNames$() = Split(arrArgs$(2), ":")
          lngFormIndex& = FormByTag(arrArgs$(0))
          If lngFormIndex& > -1 Then
            If arrArgs$(1) = "T" Then
              If LCase$(Replace(arrNames$(0), " ", "")) <> m_strScreenName$ Then
                blnShowJoin = True
              End If
              For lngNameLoop& = LBound(arrNames$) To UBound(arrNames$)
                Forms(lngFormIndex&).lstNames.AddItem arrNames$(lngNameLoop&)
                Forms(lngFormIndex&).lblPeople.Caption = Forms(lngFormIndex&).lstNames.ListCount & " people here"
                If blnShowJoin = True Then
                  Forms(lngFormIndex&).TextBox1.Text = Forms(lngFormIndex&).TextBox1.Text + "SYSTEM: *** " & arrNames$(lngNameLoop&) & " has joined " & Forms(lngFormIndex&).Caption + vbCrLf
                End If
              Next
            Else
              For lngNameLoop& = LBound(arrNames$) To UBound(arrNames$)
                For lngListLoop& = 0 To Forms(lngFormIndex&).lstNames.ListCount - 1
                  If Forms(lngFormIndex&).lstNames.List(lngListLoop&) = arrNames$(lngNameLoop&) Then
                    Forms(lngFormIndex&).lstNames.RemoveItem lngListLoop&
                    Forms(lngFormIndex&).lblPeople.Caption = Forms(lngFormIndex&).lstNames.ListCount & " people here"
                    Forms(lngFormIndex&).TextBox1.Text = Forms(lngFormIndex&).TextBox1.Text + "SYSTEM: *** " & arrNames$(lngNameLoop&) & " has left " & Forms(lngFormIndex&).Caption + vbCrLf
                    Exit For
                  End If
                Next
              Next
            End If
          End If
        Case "ERROR"
          'indicates there was an error
          'argument 1: error id number
          'argument 2: varies depending on the error
          arrArgs$() = Split(arrCommand$(1), ":", 2)
          Dim frmNewError As New aimError
          Select Case arrArgs$(0)
            Case "901"
              frmNewError.lblErrorType.Caption = "General Error: 901"
              frmNewError.lblInfo.Caption = arrArgs$(1) & " is not currently available."
            Case "902"
              frmNewError.lblErrorType.Caption = "General Error: 902"
              frmNewError.lblInfo.Caption = "Warning of " & arrArgs$(1) & " is not currently available."
            Case "903"
                '  frmNewError.lblErrorType.Caption = "General Error: 903"
                '  frmNewError.lblInfo.Caption = "A message has been dropped, you are exceeding the server speed limit."
                Call DoDebug("Got error 903 - pausing for 5 seconds and retrying")
                'wait for 5 seconds
                Sleep2 (ErrorWaitTime)
                'retry
                Call SendCommand(PrevCommand, PrevSN)
                Exit Sub
            Case "931"
                Exit Sub
            Case "950"
              frmNewError.lblErrorType.Caption = "Chat Error: 950"
              frmNewError.lblInfo.Caption = "Chat in " & arrArgs$(1) & " is unavailable."
            Case "960"
              frmNewError.lblErrorType.Caption = "IM/Info Error: 960"
              frmNewError.lblInfo.Caption = "You are sending messages too fast to " & arrArgs$(1) & "."
            Case "961"
              frmNewError.lblErrorType.Caption = "IM/Info Error: 961"
              frmNewError.lblInfo.Caption = "You missed a a message from " & arrArgs$(1) & " because it was too big."
            Case "962"
              frmNewError.lblErrorType.Caption = "IM/Info Error: 962"
              frmNewError.lblInfo.Caption = "You missed a a message from " & arrArgs$(1) & " because it was sent too fast."
            Case "970"
              frmNewError.lblErrorType.Caption = "Directory Error: 970"
              frmNewError.lblInfo.Caption = "Failure."
            Case "971"
              frmNewError.lblErrorType.Caption = "Directory Error: 971"
              frmNewError.lblInfo.Caption = "Too many matches."
            Case "972"
              frmNewError.lblErrorType.Caption = "Directory Error: 972"
              frmNewError.lblInfo.Caption = "Need more qualifiers."
            Case "973"
              frmNewError.lblErrorType.Caption = "Directory Error: 973"
              frmNewError.lblInfo.Caption = "Dir service temporarily unavailable."
            Case "974"
              frmNewError.lblErrorType.Caption = "Directory Error: 974"
              frmNewError.lblInfo.Caption = "Email lookup restricted."
            Case "975"
              frmNewError.lblErrorType.Caption = "Directory Error: 975"
              frmNewError.lblInfo.Caption = "Keyword Ignored."
            Case "976"
              frmNewError.lblErrorType.Caption = "Directory Error: 976"
              frmNewError.lblInfo.Caption = "No Keywords."
            Case "977"
              frmNewError.lblErrorType.Caption = "Directory Error: 977"
              frmNewError.lblInfo.Caption = "Language not supported."
            Case "978"
              frmNewError.lblErrorType.Caption = "Directory Error: 978"
              frmNewError.lblInfo.Caption = "Country not supported."
            Case "979"
              frmNewError.lblErrorType.Caption = "Directory Error: 979"
              frmNewError.lblInfo.Caption = "Failure unknown " & arrArgs$(1) & "."
            Case "980"
              frmNewError.lblErrorType.Caption = "Authorization Error: 980"
              frmNewError.lblInfo.Caption = "Incorrect nickname or password."
            Case "981"
              frmNewError.lblErrorType.Caption = "Authorization Error: 981"
              frmNewError.lblInfo.Caption = "The service is temporarily unavailable."
            Case "982"
              frmNewError.lblErrorType.Caption = "Authorization Error: 982"
              frmNewError.lblInfo.Caption = "Your warning level is currently too high to sign on."
            Case "983"
              frmNewError.lblErrorType.Caption = "Authorization Error: 983"
              frmNewError.lblInfo.Caption = "You have been connecting and disconnecting too frequently." & vbCrLf & "Wait 10 minutes and try again." & _
                                            vbCrLf & "If you continue to try, you will need to wait even longer."
            Case "989"
              frmNewError.lblErrorType.Caption = "Authorization Error: 989"
              frmNewError.lblInfo.Caption = "An unknown signon error has occurred " & arrArgs$(1) & "."
          End Select
          frmNewError.Show
        Case "EVILED"
        
        arrArgs$() = Split(arrCommand$(1), ":", 2)
        
        
        lngFormIndex& = FormByTag(LCase$(Replace(arrArgs$(1), " ", "")))
         If arrArgs$(1) <> "" Then
          If lngFormIndex& > -1 Then
            'Call RTFUpdate(Forms(lngFormIndex&).rtfDisplay, "\par\plain\fs16\cf1\b " & arrArgs$(1) & FixRTF(" has warned you. Your new warning level is " & arrArgs$(0) & "%."))
            Else
            Dim frmNewError2 As New aimError
            frmNewError2.Caption = "You've been warned..."
              frmNewError2.lblErrorType.Caption = "Warning"
              frmNewError2.lblInfo.Caption = arrArgs$(1) & " has warned you. Your new warning level is " & arrArgs$(0) & "%."
            frmNewError2.Show
            End If
         Else
         Dim frmNewError3 As New aimError
         frmNewError3.Caption = "You've been warned..."
           frmNewError3.lblErrorType.Caption = "Warning"
              frmNewError3.lblInfo.Caption = "A user has warned you anonymously. Your new warning level is " & arrArgs$(0) & "%."
            frmNewError3.Show
        End If
        Case "IM_IN2"
          'indicates an incoming instant message
          'argument 1: sender's screen name
          'argument 2: auto resonse t/f (not handled here)
          'argument 3: message
          arrArgs$() = Split(arrCommand$(1), ":", 4)
          
          'is message a VH command?
          If InStr(1, LCase$(arrArgs(3)), "/vhcmd", vbTextCompare) > 0 Then vhcommand = True Else vhcommand = False
          
          'VH message interceptor
          If LCase$(arrArgs(0)) = LCase$(ServerSN) And vhcommand = True Then SendToVH HTML2Text(arrArgs(3)), True
          If LCase$(arrArgs(0)) = LCase$(ClientSN) And vhcommand = True Then VHClientResponse HTML2Text(arrArgs(3)), m_strScreenName$
          
          'Block unwanted connection attempts
          If vhcommand = True And LCase$(arrArgs(0)) <> LCase$(ServerSN) And InStr(1, arrArgs(3), "<start>", vbTextCompare) > 0 Then
            If InSession = False Then Call MsgBox("Rejected connection attempt from user " + arrArgs(0), vbOKOnly + vbExclamation, "HypnoChat")
          End If
          
          lngFormIndex& = FormByTag(LCase$(Replace(arrArgs$(0), " ", "")))
          If lngFormIndex& > -1 Then
            If vhcommand = False Or (vhcommand = True And aimBuddyList.mnuHypnoShow.Checked = True) Then
                Call RTFUpdate(Forms(lngFormIndex&).rtfDisplay, htmltorich2("<font color=""#FF0000"" size=3>" & arrArgs(0) & ": </font><font color=""#000000"" face=""Times New Roman"">" & arrArgs$(3)))
                Forms(lngFormIndex&).Command2.Visible = True
                Call PlayWav(strSoundIMIn$)
            End If
            'If vhcommand = True And Forms(lngFormIndex&).RSession.Value = False And InStr(1, arrArgs(3), "<start>", vbTextCompare) > 0 Then
          Else
            If vhcommand = False Or (vhcommand = True And aimBuddyList.mnuHypnoShow.Checked = True) Then
                Dim frmNewIM As New aimIM
                With frmNewIM
                    .rtfDisplay.SelStart = Len(.rtfDisplay.Text)
                    .Caption = arrArgs$(0) & " - Instant Message"
                    .Tag = LCase$(Replace(arrArgs$(0), " ", ""))
                If MeAway = True Then
                    .Hide
                Else
                    .Show
                End If
                    .Command2.Visible = True
              
                End With
                Call RTFUpdate(frmNewIM.rtfDisplay, htmltorich2("<font color=""#FF0000"" size=3>" & arrArgs(0) & ": </font><font color=""#000000"" face=""Times New Roman"">" & arrArgs$(3)))
                Call PlayWav(strSoundFirstIM$)
            End If
          End If
          
           If MeAway = True Then
          'aimAway.List1.AddItem arrArgs$(0)
            ListAdd arrArgs$(0)
            lngFormIndex& = FormByTag(LCase$(Replace(arrArgs$(0), " ", "")))
            ph$ = awaymessage$
          
                Call SendProc(2, "toc2_send_im " & Replace(arrArgs$(0), " ", "") & " " & Chr(34) & Normalize("<HTML>" & ph$ & "</HTML>") & Chr(34) & " " & "auto" & Chr(0))
                Call RTFUpdate(Forms(lngFormIndex&).rtfDisplay, htmltorich2("<font color=""#0000FF"" size=3>" + m_strFormattedSN$ + " </font><font color=""#000000"" size=3 face=""times new roman""></p>" + ph$))
    
            Call PlayWav(strSoundIMOut$)
  
          
          End If
          
        Case "NICK"
          'this sends us the format our screen name should be used for display
          'argument 1: formatted screen name
          m_strFormattedSN$ = arrCommand$(1)
        Case "SIGN_ON"
          'the sign on message is sent letting us know is is ok to send our configuriations.
          aimBuddyList.Show
          'Call SendProc(2, "toc2_set_pdmode " & m_strMode$ & Chr(0))
          'send our buddy list
          'Select Case m_strMode$
            'Case "3"
              'Call SendProc(2, "toc2_add_permit " & m_strPDList$ & Chr(0))
            
            'Case "4"
              'Call SendProc(2, "toc2_add_deny " & m_strPDList$ & Chr(0))
            'Case "5"
              'Call SendProc(2, "toc2_add_permit " & GetBuddies$ & Chr(0))
          'End Select
          'send our permit/deny lists
          'Call SendProc(2, "toc_init_done" & Chr(0))
          'end our configurations. it is important to send our configurations before we
          'send toc_init_done so we do not flash on the buddy lists of users we have
          'blocked
          'Call SendProc(2, "toc2_new_buddies " & GetBuddies$ & Chr(0))
          'send a list of our buddies to the server so we can receive the UPDATE_BUDDY
          'messages.
          aimSignOn.Hide
          Call DoDebug("RECIEVED: SIGN_ON")
        Case "UPDATE_BUDDY2"
        Dim AwayM As String
          'indicates an update in the online status of one of our buddies
          'argument 1: buddies screen name
          'argument 2: online status t/f
          'argument 3: evil amount (not handled here)
          'argument 4: sign on time (not handled here)
          'argument 5: idle time (not handled here)
          'argument 6: user class (not handled here)
          arrArgs$() = Split(arrCommand$(1), ":", 7)
          AwayM = Replace(arrArgs$(5), " ", "")
          strName$ = LCase$(Replace(arrArgs$(0), " ", ""))
          
          If arrArgs$(1) = "T" Then
            If ExistsInTree(aimBuddyList.tvwBuddies, arrArgs$(0)) = False Then
              For lngTreeLoop& = 1 To aimBuddyList.tvwSetup.Nodes.Count
                If LCase$(Replace(aimBuddyList.tvwSetup.Nodes.Item(lngTreeLoop&).Text, " ", "")) = strName$ Then
                  If Not aimBuddyList.tvwSetup.Nodes.Item(lngTreeLoop&).parent Is Nothing Then
                    strParent$ = aimBuddyList.tvwSetup.Nodes.Item(lngTreeLoop&).parent.Text
                  End If
                  Exit For
                End If
              Next
            End If
            For lngTreeLoop& = 1 To aimBuddyList.tvwBuddies.Nodes.Count
              If aimBuddyList.tvwBuddies.Nodes.Item(lngTreeLoop&).parent Is Nothing Then
                If LCase$(Replace(aimBuddyList.tvwBuddies.Nodes.Item(lngTreeLoop&).Text, " ", "")) = LCase$(Replace(strParent$, " ", "")) Then
                  Set nodBuddy = aimBuddyList.tvwBuddies.Nodes.Add(lngTreeLoop&, tvwChild, , arrArgs$(0), 0, 0)
                  nodBuddy.EnsureVisible
                  Call PlayWav(strSoundSignOn$)
                End If
              End If
            Next
          Else
            Call ExistsInTree(aimBuddyList.tvwBuddies, strName$, False, True)
            Call PlayWav(strSoundSignOff$)
          End If
          '-=-
          'away message detection start
              If AwayM = "OU" Then
                'show away message icon
                For Each nodX In aimBuddyList.tvwBuddies.Nodes
                  If nodX.Text = arrArgs$(0) Then
                    nodX.Image = "Away"
                  End If
                Next
              End If
              If AwayM = "UU" Then
                'show away message icon
                For Each nodX In aimBuddyList.tvwBuddies.Nodes
                  If nodX.Text = arrArgs$(0) Then
                    nodX.Image = "Away"
                  End If
                Next
              ElseIf AwayM = "U" Then
                'remove away message icon
                For Each nodX In aimBuddyList.tvwBuddies.Nodes
                  If nodX.Text = arrArgs$(0) Then
                    nodX.Image = 0
                  End If
                Next
              End If
              'away message detection end
          '-=-
          'End If
      End Select
    Case Else
      Call DoDebug("Invalid Frame: " & lngFrameType&)
  End Select
End Sub

Public Sub GetRemaining(ByVal i As Long)

    DaysLeft = i \ 86400
    i = i Mod 86400
    
    HoursLeft = i \ 3600
    i = i Mod 3600
    
    MinsLeft = i \ 60
    i = i Mod 60
    
    SecsLeft = i
    
End Sub
