AIM Toc 2.0 Logon Algorithm

Private Sub Command1_Click()
Winsock1.Connect "aimexpress.oscar.aol.com", 5190
End Sub
Function AIM_Algorithum(ByVal sUser As String, ByVal sPass As String) As String
'This is the code that generates the 8 or 9 digit number on the end of
'the logon packet. Uses the Screen Name and Password to make it
Dim sUserChar As Long, sVar As Long
  DoEvents: sUser = Left(LCase(sUser), 1)
  DoEvents: sUserChar = Int(Asc(sUser) - 96)
  
  DoEvents: sVar = Int(sUserChar * 7696) + 738816
  DoEvents: sBase = Int(sUserChar * 746512)
  DoEvents: sVal = Int(Asc(Left(LCase(sPass), 1)) - 96) * sVar
  
  AIM_Algorithum = Int(Int(sVal) - sVar) + Int(sBase + 71665152)
  
End Function
Function AIM_EncryptPW(ByVal sPass As String) As String
'This will take the password, and encrypt it using the word "Tic/Toc"
Dim vTable() As Variant, sString As String
Dim sLoop As Long, sHex As String
vTable = Array("84", "105", "99", "47", "84", "111", "99")
sString = "0x"
For sLoop = 0 To Len(sPass) - 1
  sHex = Hex(Asc(Mid(sPass, sLoop + 1, 1)) Xor CLng(vTable(sLoop Mod 7)))
  
  If CLng("&H" & sHex) < 16 Then
    sString = sString & "0"
  End If
  
  sString = sString & sHex
Next
AIM_EncryptPW = LCase(sString)
End Function
Private Sub Form_Load()
End Sub
Private Sub Winsock1_Connect()
Winsock1.SendData "FLAPON" & vbCrLf & vbCrLf
End Sub
Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)
Dim Text As String
'Get the data from the server.
Winsock1.GetData Text, vbString
'Place all the incomming text, into text3, so you
'can see what all is going on. I replaced character
'0, with Ø so that you can see the text with the
'null character.
Text3 = Text3 & vbCrLf & Replace(Text, Chr(0), "Ø")
'If the second character is character 1, it means it
'wants the log on information. You will only get that
'character at log on, and never again once you're
'connected.
If Asc(Mid(Text, 2, 1)) = 1 Then
  'Send the log on information
  Winsock1.SendData Chr(42) & Chr(1) & Chr(1) & Chr(0) & Chr(0) & Chr(8 + Len(Text1)) & Chr(0) & Chr(0) & Chr(0) & Chr(1) & Chr(0) & Chr(1) & Chr(0) & Chr(Len(Text1)) & Trim(Text1)
  Winsock1.SendData Chr(42) & Chr(2) & Chr(1) & Chr(1) & Chr(0) & Chr(Len(Text1) + Len(AIM_EncryptPW(Trim(Text2))) + 90) & "toc2_signon login.oscar.aol.com 29999 " & Trim(Text1) & " " & AIM_EncryptPW(Trim(Text2)) & " english-US " & Chr(34) & "TIC:\$Revision: 1.83 \$" & Chr(34) & " 160 " & AIM_Algorithum(Text1, Text2) & Chr(0)
  
End If
End Sub