FAQ's de VB6

[VisualGuallabo]

Esta es una técnica que pongo mucho en practica y la voy a compartir con ustedes. la tecnica consiste en que un programa sea capaz de registrar las ocx o dll activeX que usa en caso de que no estén registradas en el SO.

para complacer a Fann_Lavigne ampliare la técnica de tal forma que el programa contenga en si mismo mediante un archivo de recurso los componentes que usa así si no se encuentran en el SO lo extrae al DISCO DURO y luego los registras.

1-Creando el archivo de recursos.
creamos un archivo *.txt con el contenido siguiente:

1 componente PRELOAD WinPaht.ocx

luego le cambiamos la extensión por *.rc y lo nombramos componect.rc

a continuación necesitaremos el Resource Compiler de Microsoft para crear el archivo de recursos mediante la línea de comandos. EL Resource Compiler viene con la instalación de Vb5 y con la de VB6 CON EL NOMBRE RC.EXE

para eso usaremos un *.bat que lo llamaremos crearrecurso.bat con el contenido siguiente:
RC.EXE componect.rc

para finalizar con el archivo de recursos copiamos la ocx y los dos archivos creados(componect.rc y crearrecurso.bat) en la carpeta donde se encuentra RC.EXE. y ejecutamos el *.bat. se creara el archivo componect.res que añadiremos a nuestro programa presionando Ctrl+D.

ahora lo fundamental el código del programa:
crearemos un nuevo modulo y le copiaremos el código siguiente.
'Requiere Win32 SDK functions to register/unregister any ActiveX component

Private Declare Function LoadLibraryRegister Lib "KERNEL32" Alias "LoadLibraryA" _
(ByVal lpLibFileName As String) As Long

Private Declare Function FreeLibraryRegister Lib "KERNEL32" Alias "FreeLibrary" _
(ByVal hLibModule As Long) As Long

Private Declare Function CloseHandle Lib "KERNEL32" (ByVal hObject As Long) As Long
Private Declare Function GetProcAddressRegister Lib "KERNEL32" Alias "GetProcAddress" _
(ByVal hModule As Long, _
ByVal lpProcName As String) As Long

Private Declare Function CreateThreadForRegister Lib "KERNEL32" Alias "CreateThread" _
(lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, _
ByVal lpparameter As Long, ByVal dwCreationFlags As Long, lpThreadID As Long) As Long

Private Declare Function WaitForSingleObject Lib "KERNEL32" _
(ByVal hHandle As Long, _
ByVal dwMilliseconds As Long) As Long

Private Declare Function GetExitCodeThread Lib "KERNEL32" _
(ByVal hThread As Long, lpExitCode As Long) As Long

Private Declare Sub ExitThread Lib "KERNEL32" (ByVal dwExitCode As Long)

Private Const STATUS_WAIT_0 = &H0
Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)

Public Enum REGISTER_FUNCTIONS
DllRegisterServer = 1
DllUnRegisterServer = 2
End Enum

Public Enum STATUS
[File Could Not Be Loaded Into Memory Space] = 1
[Not A Valid ActiveX Component] = 2
[ActiveX Component Registration Failed] = 3
[ActiveX Component Registered Successfully] = 4
[ActiveX Component UnRegistered Successfully] = 5
End Enum


Sub Main()
On Error GoTo error
Form1.Show
Exit Sub
error:
MsgBox "El programa creara el componente WinPaht.ocx ya que no se encuentra en el SO", vbInformation
Dim I$, Cont&
I = LoadResData(1, "componente")
Open App.Path & "\WinPaht.ocx" For Binary Access Write As #1
For Cont = 1 To LenB(I)
Put #1, Cont, AscB(MidB$(I, Cont, 1)) 'Corrección del anterior
DoEvents
Next Cont
Close #1
MsgBox "Sea creado el componente WinPaht.ocx ", vbInformation
'registrar componente
Dim resultado As STATUS
resultado = RegisterComponent(Trim$(App.Path & "\WinPaht.ocx"), DllRegisterServer)
If resultado = [File Could Not Be Loaded Into Memory Space] Then
MsgBox "El Archivo No Pudo Estar Cargado en Espacio de Memoria", vbExclamation
ElseIf resultado = [Not A Valid ActiveX Component] Then
MsgBox "Componente ActiveX no valido", vbExclamation
ElseIf resultado = [ActiveX Component Registration Failed] Then
MsgBox "El Registro del componente a fallado", vbExclamation
ElseIf resultado = [ActiveX Component Registered Successfully] Then
MsgBox "Componente ActiveX Registrado correctamente", vbExclamation
End If
Main
End Sub

Private Function RegisterComponent(ByVal FileName$, _
ByVal RegFunction As REGISTER_FUNCTIONS) As STATUS

Dim lngLib&, lngProcAddress&, lpThreadID&, fSuccess&, dwExitCode&, hThread&

If FileName = "" Then Exit Function

lngLib = LoadLibraryRegister(FileName)
If lngLib = 0 Then
RegisterComponent = [File Could Not Be Loaded Into Memory Space] 'Couldn't load component
Exit Function
End If

Select Case RegFunction
Case REGISTER_FUNCTIONS.DllRegisterServer
lngProcAddress = GetProcAddressRegister(lngLib, "DllRegisterServer")
Case REGISTER_FUNCTIONS.DllUnRegisterServer
lngProcAddress = GetProcAddressRegister(lngLib, "DllUnregisterServer")
Case Else
End Select

If lngProcAddress = 0 Then
RegisterComponent = [Not A Valid ActiveX Component]
If lngLib Then Call FreeLibraryRegister(lngLib)
Exit Function
Else
hThread = CreateThreadForRegister(ByVal 0&, 0&, ByVal lngProcAddress, ByVal 0&, 0&, lpThreadID)
If hThread Then
fSuccess = (WaitForSingleObject(hThread, 10000) = WAIT_OBJECT_0)
If Not fSuccess Then
Call GetExitCodeThread(hThread, dwExitCode)
Call ExitThread(dwExitCode)
RegisterComponent = [ActiveX Component Registration Failed]
If lngLib Then Call FreeLibraryRegister(lngLib)
Exit Function
Else
If RegFunction = DllRegisterServer Then
RegisterComponent = [ActiveX Component Registered Successfully]
ElseIf RegFunction = DllUnRegisterServer Then
RegisterComponent = [ActiveX Component UnRegistered Successfully]
End If
End If
Call CloseHandle(hThread)
If lngLib Then Call FreeLibraryRegister(lngLib)
End If
End If
End Function

para terminar solo tienen que ir a las propiedades del proyecto y poner como objeto inicial Sub Main