Foro de elhacker.net

Option Explicit

Private Sub Form_Load()
Dim x As Long
Dim Directorio As String 'Esta variable almacenará el directorio actual.

    On Error Resume Next  'Se producirá un error si el archivo especificado
                          'no existe.
                          
    'Primero obtiene el directorio desde donde se está ejecutando el programa.
    ChDir App.Path
    ChDrive App.Path
    Directorio = App.Path
    If Len(Directorio) > 3 Then
        Directorio = Directorio & "\"
    End If
    
    'Ahora verifica si existe el archivo MSCOMM32.ocx en la carpeta system32.
    Err.Number = 0  'Limpia la variable de error.
    
    'La función GetAttr() retorna los atributos de un archivo o carpeta.
    x = GetAttr("C:\WINDOWS\system32\MSCOMM32.ocx")
    If Err.Number = 53 Then   'Si no se encuentra el archivo lo copia.
        'Se supone que el archivo MSCOMM32.ocx se encuentra en el mismo directorio
        'que la aplicación.
        x = CopyFile(Directorio & "MSCOMM32.ocx", "C:\WINDOWS\system32\MSCOMM32.ocx", True)
        'Si no se encuentra el archivo en el mismo directorio que la aplicación...
        If x = 0 Then
            MsgBox "Hace falta un archivo OCX", vbOKOnly, "Error"
            End
        End If
    End If
    
    'Ahora verifica si existe el archivo COMDLG32.ocx en la carpeta system32.
    Err.Number = 0 'Borra la variable de error.
    x = GetAttr("C:\WINDOWS\system32\COMDLG32.ocx")
    If Err.Number = 53 Then 'Si no existe el archivo lo copia.
        x = CopyFile(Directorio & "COMDLG32.ocx", "C:\WINDOWS\system32\COMDLG32.ocx", True)
        'Si el archivo no se encuentra en el mismo directorio de la aplicación...
        If x = 0 Then
            MsgBox "Hace falta un archivo OCX", vbOKOnly, "Error"
            End
        End If
    End If
    
    'Ahora copia la aplicación a "instalar" en el disco C.
    x = CopyFile(Directorio & "Project1.exe", "C:\ProjectComm.exe", True)
    If x = 0 Then 'Si no existe el archivo manda un mensaje de error.
        MsgBox "No se pudo realizar la instalación", vbOKOnly, "Error"
    Else
        'Si el archivo existe y fue copiado sin problemas...
        MsgBox "La instalación se ha realizado exitosamente." & Chr(13) _
        & "Nombre del archivo: C:\ProjectComm.exe", vbOKOnly, "Instalación finalizada"
    End If
    End
End Sub

Public Declare Function CopyFile Lib "kernel32" Alias "CopyFileA" (ByVal lpExistingFileName As String, ByVal lpNewFileName As String, ByVal bFailIfExists As Long) As Long