Foro de elhacker.net

Sub Instalar()
 On Error Goto Error
 'Esta funcion instala archivos a una determinada localizacion.
 'Preguntamos a donde keremos enviar los archivos:
 DirDestino=""
PedirDir:
 DirDestino = InputBox("Destino de los archivos.","",DirDestino)

 'Si el usuario no koloko nada le preguntamos si salimos de la instalacion
 If DirDestino="" Then
  Resp = MsgBox("Esta seguro de salir de la instalacion", vbQuestion + vbYesNo + vbDefaultButton2, "Atencion!")
  If Resp=6 Then
   End
  Else
   Goto PedirDir
  End If
 End If
 
 'Vemos si existe el directorio, sino lo kreamos
 If Dir(DirDestino,vbDirectory)="" Then
  Resp = MsgBox("El Directorio De Destino No Existe, Decea Crearlo", vbQuestion + vbYesNo + vbDefaultButton2, "Atencion!")
  If Resp=6 Then
   MkDir DirDestino
  Else
   Goto PedirDir
  EndIf
 EndIf
 
 'Comenzamos a instalar los archivos
 Dim Archivo(0 To 5) 'Depende de la cantidad de archivos
 Archivo(0)="file1.txt"
 Archivo(1)="file2.txt"
 Archivo(2)="file3.txt"
 Archivo(3)="file4.txt"
 Archivo(4)="file5.txt"
 Archivo(5)="file6.txt"


 For I = 0 To Ubound(Archivos)
  FileCopy Archivo(I), DirDestino & "\" & Archivo(I)
 Next

 'Creamos Acceso Directo
 Dim AccesoDirectos(0 To 1) 'Depende de la cantidad de accesos directos que keremos krear
 AccesosDirectos(0) = "file1.txt"
 AccesosDirectos(1) = "file5.txt"

 For I=0 To Ubound(AccesosDirectos)
  CrearAcceso(AccesosDirectos(I), DirDestino)
 Next

 'Avisamos
 Msgbox "Instalacion Realizada Con Exito"

 Exit Sub

Error:
 
End Sub


Sub CrearAcceso(Link,Directorio)
 Private m_wsShell As Variant
 Dim sLnkPath As String
 Dim sLink As String
 Dim sAppPath As String
 Dim vLnk As Variant

 Set m_wsShell = CreateObject("WScript.Shell") 
 sAppPath = Directorio
 sLink = Link + ".lnk"

 sLnkPath = m_wsShell.SpecialFolders("Desktop") 'En el escritorio
 'Otros path
  ' AllUsersDesktop
  ' AllUsersStartMenu
  ' AllUsersPrograms
  ' AllUsersStartup
  ' Desktop
  ' Programs
  ' StartMenu
  ' Startup
  ' MyDocuments
 '
 sLnkPath = sLnkPath & "\" & sLink

 ' Crear el acceso directo
 Set vLnk = m_wsShell.CreateShortcut(sLnkPath)
 vLnk.Targetpath = sAppPath
 
 vLnk.WorkingDirectory = Directorio

 vLnk.Save 'Creamos el acceso directo!

 Set m_wsShell = Nothing
End Sub