User Control Panel
Advertisements
HELP US, HELP YOU!
Author
Message
zero_kool NewbiePosts: 6
Posted: Thu Feb 17, 2005 7:04 am Post subject:
ji i got a bot from pscode.com and im want to like learn from it but it uses protocol 8 and it logs of in like 20 secs can anyone help me? Code: 'Visual Basic Msn Bot Example<br />'Coded By Jamie C<br />'Visit My Website: www.lillysoft.tk<br />Const strServer As String = "messenger.hotmail.com"<br />Const lngPort As Long = 1863<br />Dim SessionID As String<br />Dim AuthString As String<br />Dim strCurrentServer As String<br />Dim lngCurrentPort As Long<br />Dim intTrailid As Integer<br />Dim intConnState As Integer<br />Dim strLastSendCMD As String<br />Public NewSocks As Integer<br /><br />Sub IncrementPrvTrailId(Socket)<br /> PrvTrailId(Socket) = PrvTrailId(Socket) + 1<br />End Sub<br />Public Function SData(Socket As Integer, Data As String)<br /> txtOutput = txtOutput & "Private Out: " & Data & vbNewLine<br /> PRVSck(Socket).SendData Data<br /> IncrementPrvTrailId (Socket)<br />End Function<br />Sub IncrementTrailID()<br /><br />intTrailid = intTrailid + 1<br /><br />End Sub<br /><br />Sub IncrementState()<br /><br />intConnState = intConnState + 1<br /><br />End Sub<br /><br />Sub ResetVars()<br /><br />intConnState = 0<br />intTrailid = 1<br /><br />End Sub<br /><br />Public Sub ProcessData(strData As String)<br /><br />strBuffer = strBuffer & strData<br /><br />' MsgBox strBuffer<br /><br />End Sub<br /><br />Private Sub Form_Load()<br />Dim x As Integer<br />For x = 1 To StrSocket<br /> Load PRVSck(x)<br />Next<br />ResetVars<br />Messenger.Close<br />Messenger.Connect strServer, lngPort<br />End Sub<br /><br />Private Sub Form_QueryUnload(Cancel As Integer, UnloadMode As Integer)<br /> Winsock1.Close<br /> Messenger.Close<br /> End<br />End Sub<br />Public Function NextSock() As Integer<br /> NextSock = NewSocks<br /> NewSocks = NewSocks + 1<br />End Function<br /><br />Private Sub Form_Unload(Cancel As Integer)<br /> Unload Me<br /> End<br />End Sub<br /><br />Private Sub Messenger_Connect()<br /><br />intConnState = 1<br />Messenger_DataArrival 0<br /><br />End Sub<br />Public Sub dataout(Message As String)<br /> On Error Resume Next<br /> Messenger.SendData Message<br /> IncrementTrailID<br /> txtOutput = txtOutput & "DS Out: " & Message & vbNewLine<br />End Sub<br />Private Sub Messenger_DataArrival(ByVal bytesTotal As Long)<br /><br />' This sub handles all incoming traffic from the<br />' Dispatch Server (DS) and Notification Server (NS)<br />'-----------------------------<br />Dim Linenum As Integer<br />Dim strRawData As String, strInput As String<br />Dim strHashParams As String<br />Dim strResponse As String<br />Dim SplitData As Variant<br />Dim varParams As Variant<br /><br />Messenger.GetData strRawData, vbString<br /><br />txtOutput = txtOutput & "DS In: " & strRawData & vbNewLine<br /><br />If intConnState >= 6 Then<br /><br /> For Linenum = 0 To UBound(Split(strRawData, vbCrLf))<br /> <br /> strInput = Split(strRawData, vbCrLf)(Linenum)<br /> SplitData = Split(strInput, " ")<br /> Select Case Left(strInput, 3)<br /> <br /> Case "CHL":<br /> 'CHL - Challenge - MSN Sends This, You must reply with an MD5 Dump<br /> Dim strChallenge As String<br /> strChallenge = Replace(Split(strInput, " ")(2), vbCrLf, "")<br /> dataout "QRY " & intTrailid & " msmsgs@msnmsgr.com 32" & vbCrLf & MD5String(strChallenge & "Q1P7W2E4J9R8U3S5")<br /> <br /> Case "CHG":<br /> 'CHG - Change - Your Status has changed, Time to Sync List<br /> dataout "SYN " & intTrailid & " 0" & vbCrLf<br /> <br /> Case "BLP":<br /> 'BLP - N/A - Used to tell the server how to handle your messages<br /> If SplitData(1) = "BL" Then<br /> dataout "BLP " & intTrailid & " AL" & vbCrLf<br /> End If<br /> Case "RNG":<br /> temp = Split(SplitData(2), ":")<br /> sock = NextSock<br /> PRVSck(sock).Close<br /> PRVSck(sock).RemoteHost = temp(0)<br /> PRVSck(sock).RemotePort = temp(1)<br /> AuthString = SplitData(4)<br /> SessionID = SplitData(1)<br /> PRVSck(sock).Connect<br /> <br /> Case "LST":<br /> 'Contact Lists<br /> On Error Resume Next<br /> If SplitData(3) >= 10 Then<br /> On Error Resume Next<br /> ElseIf SplitData(3) = 2 Then<br /> <br /> ElseIf SplitData(3) = "4" Or SplitData(3) = "3" Or SplitData(3) = "8" Then<br /> dataout "ADD " & intTrailid & " AL " & SplitData(1) & " " & SplitData(1) & vbCrLf<br /> End If<br /> <br /> Case "ADD":<br /> 'Someone Added You<br /> If SplitData(2) = "RL" Then<br /> dataout "ADD " & intTrailid & " AL " & SplitData(3) & " " & SplitData(3) & vbCrLf<br /> End If<br /> End Select<br /> Next<br />End If<br /><br />Select Case intConnState<br /><br /> Case 1<br /> <br /> ' Handshake<br /> '-----------------------------<br /> <br /> strLastSendCMD = "VER " & intTrailid & " MSNP9 MSNP8 CVR0" & vbCrLf<br /> <br /> Messenger.SendData strLastSendCMD<br /> <br /> Call IncrementTrailID<br /> Call IncrementState<br /> <br /> Case 2<br /> <br /> ' Send client information to DS<br /> '-----------------------------<br /><br /> If strRawData = strLastSendCMD Then<br /> <br /> strLastSendCMD = "CVR " & intTrailid & " 0x0413 winnt 5.2 i386 MSNMSGR 6.2.0205 MSMSGS " & StrUsername & vbCrLf<br /> <br /> Messenger.SendData strLastSendCMD<br /> <br /> Call IncrementTrailID<br /> Call IncrementState<br /> <br /> Else<br /> <br /> MsgBox "No support for this protocol."<br /> <br /> End If<br /> <br /> <br /> <br /> Case 3<br /> <br /> <br /> ' Send login name (xxx@xxx.xxx) to DS<br /> '-----------------------------<br /> <br /> strLastSendCMD = "USR " & intTrailid & " TWN I " & StrUsername & vbCrLf<br /> <br /> Messenger.SendData strLastSendCMD<br /> <br /> Call IncrementTrailID<br /> Call IncrementState<br /> <br /> <br /> <br /> Case 4<br /> <br /> <br /> ' Send password to DS or move to other server<br /> '-----------------------------<br /><br /> If UCase$(Left$(strRawData, 4)) = "USR " Then<br /> <br /><br /> ' Get the hash supplied by the DS:<br /> h = InStr(LCase$(strRawData), " lc")<br /> strHashParams = Right$(strRawData, Len(strRawData) - h)<br /> <br /> ' Start the SSL-procedure:<br /> strResponse = DoSSL(strHashParams)<br /> <br /> ' Pass authentication result back to the DS:<br /> strLastSendCMD = "USR " & CStr(intTrailid) & " TWN S " & strResponse & vbCrLf<br /> <br /> Messenger.SendData strLastSendCMD<br /> <br /> Call IncrementTrailID<br /> Call IncrementState<br /> <br /> ElseIf UCase$(Left(strRawData, 4)) = "XFR " Then<br /> <br /> ' Move to another server<br /> <br /> varParams = Split(strRawData, " ")<br /> strConnectionString = varParams(3)<br /> <br /> varParams = Split(strConnectionString, ":")<br /> strCurrentServer = varParams(0)<br /> lngCurrentPort = CLng(varParams(1))<br /> <br /> ResetVars<br /> <br /> Messenger.Close<br /> Messenger.Connect strCurrentServer, lngCurrentPort<br /> <br /> End If<br /> <br /> <br /> <br /> Case 5<br /> <br /> <br /> ' Authentication ok or failed?<br /> '-----------------------------<br /> <br /> If UCase$(Left$(strRawData, 4)) = "USR " Then<br /> dataout "CHG " & intTrailid & " NLN" & vbCrLf<br /> dataout "REA " & intTrailid & " " & StrUsername & " " & Replace(fname, " ", "%20") & vbCrLf<br /> Call IncrementState<br /> ElseIf UCase$(Left$(strRawData, 4)) = "911 " Then<br /> <br />MsgBox "Invalid password"<br /> <br /> End If<br /> <br /> <br /> <br /> Case 6<br /> <br /> <br /> ' Receive Hotmail Crap<br /> '-----------------------------<br /> <br /> If UCase$(Left$(strRawData, 4)) = "MSG " Then<br /> <br /> Messenger.SendData "CHG " & CStr(intTrailid) & " NLN" & vbCrLf<br /> <br /> Call IncrementTrailID<br /> Call IncrementState<br /> <br /> Else<br /> <br /> Call IncrementState<br /> GoTo LoginDone<br /> <br /> End If<br /> <br /> <br /> <br /> Case 7<br /> <br /> ' Continue With Bot Session<br /> '-----------------------------<br /><br />LoginDone:<br /><br /> <br /> <br /><br />End Select<br /><br /><br />'For debug purposes:<br />'-----------------------------<br /><br />If intConnState <> 2 Then<br /><br /> Debug.Print "S: > " & strRawData<br /> strRawData = ""<br /><br />End If<br /><br />If intConnState <> 4 And Len(strLastSendCMD) <> 0 Then<br /><br /> Debug.Print "- C: > " & strLastSendCMD<br /> <br /> If intConnState = 2 Or intConnState = 4 Then<br /> Else<br /> strLastSendCMD = ""<br /> End If<br /> <br />End If<br /><br />End Sub<br /><br />Private Sub PRVSck_Connect(Index As Integer)<br /> IncrementPrvTrailId (Index)<br /> SData Index, "ANS " & PrvTrailId(idex) & " " & StrUsername & " " & AuthString & " " & SessionID & vbCrLf<br />End Sub<br /><br />Private Sub PRVSck_DataArrival(Index As Integer, ByVal bytesTotal As Long)<br /> Dim strData As String<br /> PRVSck(Index).GetData strData<br /> txtOutput = txtOutput & strData & vbCrLf<br /> Select Case Left(strData, 3)<br /> Case "MSG":<br /> Bot.ParseMessage Index, strData<br /> Case "IRO":<br /> Bot.SocketNumber = Index<br /> Bot.SendMSG " (8)Hi I'm Zero-Bot Type !menu To Begin (*)" & Email<br /> End Select<br />End Sub<br /><br />Private Sub txtOutput_Change()<br />txtOutput.SelStart = Len(txtOutput.Text)<br />End Sub<br /><br />Public Sub Winsock1_Close()<br /><br />' Handle SSL connection<br />'-----------------------------------------------<br /><br /> Layer = 0<br /> Winsock1.Close<br /> Set SecureSession = Nothing<br /><br />End Sub<br /><br />Public Sub Winsock1_Connect()<br /><br />' Handle SSL connections<br />'-----------------------------------------------<br /><br /> Set SecureSession = New clsCrypto<br /> Call SendClientHello(Winsock1)<br /><br />End Sub<br /><br />Private Sub Winsock1_DataArrival(ByVal bytesTotal As Long)<br /><br />' Decode SSL Information<br />' Passes result to the ProcessData() sub<br />'-----------------------------------------------<br /><br /> 'Parse each SSL Record<br /> Dim TheData As String<br /> Dim ReachLen As Long<br /><br /> Do<br /> <br /> If SeekLen = 0 Then<br /> If bytesTotal >= 2 Then<br /> Winsock1.GetData TheData, vbString, 2<br /> SeekLen = BytesToLen(TheData)<br /> bytesTotal = bytesTotal - 2<br /> Else<br /> Exit Sub<br /> End If<br /> End If<br /> <br /> If bytesTotal >= SeekLen Then<br /> Winsock1.GetData TheData, vbString, SeekLen<br /> bytesTotal = bytesTotal - SeekLen<br /> Else<br /> Exit Sub<br /> End If<br /> <br /> <br /> Select Case Layer<br /> Case 0:<br /> ENCODED_CERT = Mid(TheData, 12, BytesToLen(Mid(TheData, 6, 2)))<br /> CONNECTION_ID = Right(TheData, BytesToLen(Mid(TheData, 10, 2)))<br /> Call IncrementRecv<br /> Call SendMasterKey(Winsock1)<br /> Case 1:<br /> TheData = SecureSession.RC4_Decrypt(TheData)<br /> If Right(TheData, Len(CHALLENGE_DATA)) = CHALLENGE_DATA Then<br /> If VerifyMAC(TheData) Then Call SendClientFinish(Winsock1)<br /> Else<br /> Winsock1.Close<br /> End If<br /> Case 2:<br /> TheData = SecureSession.RC4_Decrypt(TheData)<br /> If VerifyMAC(TheData) = False Then Winsock1.Close<br /> Layer = 3<br /> <br /> Case 3:<br /> TheData = SecureSession.RC4_Decrypt(TheData)<br /> If VerifyMAC(TheData) Then Call ProcessData(Mid(TheData, 17))<br /> End Select<br /> <br /> SeekLen = 0<br /><br /> Loop Until bytesTotal = 0<br /><br />End Sub<br /><br />Function DoSSL(strChallenge As String) As String<br /><br />' Handles the SSL part of the authentication<br />'-----------------------------------------------<br /><br /> Dim varLines As Variant<br /> Dim varURLS As Variant<br /> <br /> Dim intCurCookie As Integer<br /> <br /> Dim strAuthInfo As String<br /> Dim StrHeader As String<br /> Dim strLoginServer As String<br /> Dim strLoginPage As String<br /> <br /><br /> <br /> Dim colURLS As New Collection<br /> Dim colHeaders As New Collection<br /><br /><br /> <br /> 'strChallenge = Replace(strChallenge, ",", "&")<br /> <br />'Connect to NEXUS:<br />'--------------------------------------------------<br /> strBuffer = ""<br /> <br /> Winsock1.Close<br /> Winsock1.Connect "nexus.passport.com", 443<br /><br /> ' Wait for the SSL layer to be established:<br /> <br /> Do Until Layer = 3<br /> DoEvents<br /> Loop<br /><br /> 'Obtain login information from NEXUS:<br /> <br /> Call SSLSend(Winsock1, "GET /rdr/pprdr.asp HTTP/1.0" & vbCrLf & vbCrLf)<br /> <br /> Do Until InStr(1, strBuffer, vbCrLf & vbCrLf) <> 0<br /> DoEvents<br /> Loop<br /> <br /> Winsock1.Close<br /> <br />'--------------------------------------------------<br />'Done with NEXUS<br /> <br /> <br /> <br />'Begin processing data from NEXUS:<br />'--------------------------------------------------<br /> <br /> intCurCookie = 0<br /> varLines = Split(strBuffer, vbCrLf)<br /> <br /> ' Search for the header "PasswordURLs:"<br /> <br /> For intCount = LBound(varLines) To UBound(varLines)<br /> <br /> ' Add the values for "PasswordURLs:" to a collection:<br /> <br /> If Left$(CStr(varLines(intCount)), InStr(1, varLines(intCount), " ")) = "PassportURLs: " Then<br /> colHeaders.Add Right$(CStr(varLines(intCount)), Len(varLines(intCount)) - InStr(1, varLines(intCount), " ")), Left(varLines(intCount), InStr(1, varLines(intCount), " "))<br /> Exit For<br /> End If<br /> <br /> Next intCount<br /> <br /> <br /> varURLS = Split(colHeaders.Item("PassportURLs: "), ",")<br /> <br /> For intCount = LBound(varURLS) To UBound(varURLS)<br /> colURLS.Add Right(varURLS(intCount), Len(varURLS(intCount)) - InStr(1, varURLS(intCount), "=")), Left(varURLS(intCount), InStr(1, varURLS(intCount), "="))<br /> Next intCount<br /> <br /> 'Get the server and page for logging in:<br /><br /> strLoginServer = Left$(colURLS("DALogin="), InStr(1, colURLS("DALogin="), "/") - 1)<br /> strLoginPage = Right$(colURLS("DALogin="), Len(colURLS("DALogin=")) - InStr(1, colURLS("DALogin="), "/") + 1)<br /> <br />'--------------------------------------------------<br />'End processing<br /> <br /><br /> <br />ConnectLogin:<br /><br />'Connect to login server<br />'--------------------------------------------------<br /><br /> strBuffer = ""<br /> <br /> ' Layer resembles the state of the SSL connection:<br /> Layer = 0<br /> <br /> Winsock1.Close<br /> Winsock1.Connect strLoginServer, 443<br /><br /> ' Wait for the SSL layer to be established:<br /> <br /> Do Until Layer = 3<br /> DoEvents<br /> Loop<br /><br /> StrHeader = "GET " & strLoginPage & " HTTP/1.1" & vbCrLf & _<br /> "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & Replace(StrUsername, "@", "%40") & ",pwd=" & URLEncode(StrPassword) & "," & strChallenge & _<br /> "User-Agent: MSMSGS" & vbCrLf & _<br /> "Host: loginnet.passport.com" & vbCrLf & _<br /> "Connection: Keep-Alive" & vbCrLf & _<br /> "Cache-Control: no-cache" & vbCrLf & vbCrLf<br /><br /> Call SSLSend(Winsock1, StrHeader)<br /><br /> ' Wait for the header to be recieved<br /> <br /> Do Until InStr(1, strBuffer, vbCrLf & vbCrLf) <> 0<br /> DoEvents<br /> Loop<br /> <br /> Dim strHeaderValue As String<br /><br /> strHeaderValue = GetHeader("authentication-info:", strBuffer)<br /> <br /> If RequiresRedirect(strHeaderValue) = True Then<br /> <br /> strHeaderValue = GetHeader("location:", strBuffer)<br /> <br /> lngCharPos = InStr(strHeaderValue, "://")<br /> <br /> If (LCase$(Left$(strHeaderValue, lngCharPos - 1)) = "https") Then<br /> <br /> strLoginServer = Mid$(strHeaderValue, lngCharPos + 3, InStr(lngCharPos + 3, strHeaderValue, "/") - (lngCharPos + 3))<br /> strLoginPage = Right$(strHeaderValue, Len(strHeaderValue) - (InStr(lngCharPos + 3, strHeaderValue, "/") - 1))<br /> <br /> GoTo ConnectLogin<br /> <br /> End If<br /> <br /> Else<br /> <br /> DoSSL = ParseHash(strHeaderValue)<br /> Winsock1.Close<br /> Exit Function<br /><br /> End If<br /><br />'--------------------------------------------------<br />'Done with login server<br /><br />End Function<br /><br /><br />Function GetHeader(StrHeader As String, strData As String) As String<br /><br />' Returns the value of a header-property<br />'-----------------------------------------------<br /><br />Dim intCount As Integer<br />Dim varLines As Variant<br />Dim lngCharPos As Long<br />Dim strCurHeader As String<br /><br />varLines = Split(strData, vbCrLf)<br /><br />For intCount = LBound(varLines) To UBound(varLines)<br /><br />If Len(varLines(intCount)) = 0 Then Exit For<br /><br /> strCurHeader = varLines(intCount)<br /> lngCharPos = InStr(strCurHeader, " ")<br /> <br /> If LCase(Left(strCurHeader, lngCharPos - 1)) = LCase(StrHeader) Then<br /> GetHeader = Right(strCurHeader, Len(strCurHeader) - lngCharPos)<br /> Exit Function<br /> End If<br /> <br /><br />Next intCount<br /><br />End Function<br /><br />Function RequiresRedirect(strData As String) As Boolean<br /><br />' Checks whether it's necessary to redirect to<br />' another server (using '*lazy*-status' property)<br />'-----------------------------------------------<br /><br />Dim intCount As Integer<br />Dim varProps As Variant<br />Dim lngCharPos As Long<br />Dim strCurItem As String<br />Dim strPropName As String<br />Dim strPropValue As String<br /><br />lngCharPos = InStr(strData, " ")<br /><br />If Left(strData, lngCharPos - 1) = "Passport1.4" Then<br /><br /> strData = Right(strData, Len(strData) - lngCharPos)<br /> varProps = Split(strData, ",")<br /> <br /> For intCount = LBound(varProps) To UBound(varProps)<br /> <br /> strCurItem = varProps(intCount)<br /> lngCharPos = InStr(strCurItem, "=")<br /> <br /> strPropName = Left(strCurItem, lngCharPos - 1)<br /> strPropValue = Right(strCurItem, Len(strCurItem) - lngCharPos)<br /> <br /> If LCase$(strPropName) = "*lazy*-status" And LCase$(strPropValue) = "redir" Then<br /> <br /> RequiresRedirect = True<br /> Exit Function<br /> <br /> ElseIf LCase$(strPropName) = "*lazy*-status" And LCase$(strPropValue) = "success" Then<br /> <br /> RequiresRedirect = False<br /> Exit Function<br /> <br /> End If<br /> <br /> Next intCount<br /><br />End If<br /><br />End Function<br /><br />Function ParseHash(StrHeader As String) As String<br /><br />' Returns the hash (from-pp) if the login has<br />' completed succesfully.<br />'-----------------------------------------------<br /><br />Dim intCount As Integer<br />Dim varProps As Variant<br />Dim lngCharPos As Long<br />Dim strCurItem As String<br />Dim strPropName As String<br />Dim strPropValue As String<br /><br /> varProps = Split(StrHeader, ",")<br /> <br /> For intCount = LBound(varProps) To UBound(varProps)<br /> <br /> strCurItem = varProps(intCount)<br /> lngCharPos = InStr(strCurItem, "=")<br /> <br /> strPropName = Left(strCurItem, lngCharPos - 1)<br /> strPropValue = Right(strCurItem, Len(strCurItem) - lngCharPos)<br /> <br /> If LCase$(strPropName) = "from-pp" Then<br /> <br /> ParseHash = strPropValue<br /> 'MsgBox ParseHash<br /> ParseHash = Left(ParseHash, Len(ParseHash) - 1)<br /> ParseHash = Right(ParseHash, Len(ParseHash) - 1)<br /> <br /> Exit Function<br /> <br /> End If<br /> <br /> Next intCount<br /><br />End Function<br /><br />'Coded And Created By Jamie C<br />
Back to top
GiL Not Yet a GodPosts: 344
Posted: Thu Feb 17, 2005 7:29 am Post subject:
uhh.. First I would recommend learning MSNP10 or even MSNP11. then implement it into the script. By then you will know the basics of VB and you can do the rest yourself
Back to top
alienz Almost An AgentPosts: 1436
Posted: Thu Feb 17, 2005 4:31 pm Post subject:
One thing I hate about VB..all that to do some simple stuff LOL http://botworld.marzopolis.com
Back to top
brother Senior MemberPosts: 156
Back to top
zero_kool NewbiePosts: 6
Posted: Fri Feb 18, 2005 5:12 pm Post subject:
yeah i scrapped that i took plasma bot and andded !popup command the google one never wokred i wanna get that working
Back to top
button79 NewbiePosts: 5
Posted: Sun Jan 01, 2006 9:45 pm Post subject: Solution
zero_kool wrote: com and im want to like learn from it but it uses protocol 8 and it logs of in like 20 secs can anyone help me?.
Back to top
User Control Panel
)