Sebagai contoh mungkin sobat - sobat pernah mengalami aplikasinya tidak dapat dijalankan atau istilahnya runtime error setelah di Instalkan kekomputer lain karena file pendukung tidak diregister, nah bagai mana caranya supaya langsung diregister melalui coding bagi yang tertarik silahkan ikuti langkah - langkah berikut
'Letakan Coding dibawah ini pada Module Project
Private Declare Function LoadLibraryRegister Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CreateThreadForRegister Lib "kernel32" Alias "CreateThread" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lParameter 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 GetProcAddressRegister Lib "kernel32" Alias "GetProcAddress" (ByVal hModule As Long, ByVal lpProcName 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 GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Public Function RegServer(ByVal FileName As String) As Boolean
RegServer = RegSvr32(FileName, False)
End Function
Public Function UnRegServer(ByVal FileName As String) As Boolean
UnRegServer = RegSvr32(FileName, True)
End Function
Private Function RegSvr32(ByVal FileName As String, bUnReg As Boolean) As Boolean
Dim lLib As Long
Dim lProcAddress As Long
Dim lThreadID As Long
Dim lSuccess As Long
Dim lExitCode As Long
Dim lThread As Long
Dim bAns As Boolean
Dim sPurpose As String
sPurpose = IIf(bUnReg, "DllUnregisterServer", _
"DllRegisterServer")
If Dir(FileName) = "" Then Exit Function
lLib = LoadLibraryRegister(FileName)
If lLib = 0 Then Exit Function
lProcAddress = GetProcAddressRegister(lLib, sPurpose)
If lProcAddress = 0 Then
FreeLibraryRegister lLib
Exit Function
Else
lThread = CreateThreadForRegister(ByVal 0&, 0&, ByVal lProcAddress, ByVal 0&, 0&, lThread)
If lThread Then
lSuccess = (WaitForSingleObject(lThread, 10000) = 0)
If Not lSuccess Then
Call GetExitCodeThread(lThread, lExitCode)
Call ExitThread(lExitCode)
bAns = False
Exit Function
Else
bAns = True
End If
CloseHandle lThread
FreeLibraryRegister lLib
End If
End If
RegSvr32 = bAns
End Function
'Contoh Penerapan Fungsi-fungsi Register diatas
Public Function Sub RegisterFile() as Boolean
Dim FileSys1 As String
FileSys1 = "C:\Windows\System32\vbaListView6.ocx"
If Dir(FileSys1) <> "" Then
RegisterFile = RegServer(FileSys1)
end if
End Function
Private Declare Function LoadLibraryRegister Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function CreateThreadForRegister Lib "kernel32" Alias "CreateThread" (lpThreadAttributes As Any, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lParameter 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 GetProcAddressRegister Lib "kernel32" Alias "GetProcAddress" (ByVal hModule As Long, ByVal lpProcName 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 GetExitCodeThread Lib "kernel32" (ByVal hThread As Long, lpExitCode As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Public Function RegServer(ByVal FileName As String) As Boolean
RegServer = RegSvr32(FileName, False)
End Function
Public Function UnRegServer(ByVal FileName As String) As Boolean
UnRegServer = RegSvr32(FileName, True)
End Function
Private Function RegSvr32(ByVal FileName As String, bUnReg As Boolean) As Boolean
Dim lLib As Long
Dim lProcAddress As Long
Dim lThreadID As Long
Dim lSuccess As Long
Dim lExitCode As Long
Dim lThread As Long
Dim bAns As Boolean
Dim sPurpose As String
sPurpose = IIf(bUnReg, "DllUnregisterServer", _
"DllRegisterServer")
If Dir(FileName) = "" Then Exit Function
lLib = LoadLibraryRegister(FileName)
If lLib = 0 Then Exit Function
lProcAddress = GetProcAddressRegister(lLib, sPurpose)
If lProcAddress = 0 Then
FreeLibraryRegister lLib
Exit Function
Else
lThread = CreateThreadForRegister(ByVal 0&, 0&, ByVal lProcAddress, ByVal 0&, 0&, lThread)
If lThread Then
lSuccess = (WaitForSingleObject(lThread, 10000) = 0)
If Not lSuccess Then
Call GetExitCodeThread(lThread, lExitCode)
Call ExitThread(lExitCode)
bAns = False
Exit Function
Else
bAns = True
End If
CloseHandle lThread
FreeLibraryRegister lLib
End If
End If
RegSvr32 = bAns
End Function
'Contoh Penerapan Fungsi-fungsi Register diatas
Public Function Sub RegisterFile() as Boolean
Dim FileSys1 As String
FileSys1 = "C:\Windows\System32\vbaListView6.ocx"
If Dir(FileSys1) <> "" Then
RegisterFile = RegServer(FileSys1)
end if
End Function
Sekarang masukan fungsi RegisterFile tersebut kedalam Start up Program misal di Sub Main Coding seperti dibawah ini
Sub Main()
call RegisterFile
End Sub
call RegisterFile
End Sub
Cukup dulu pembahasan tentang Cara Register File mudah-mudahan ada mamfaat nya bagi sobat-sobat, kalau ada kesempatan akan kita lanjutkan tentang pembahasan yang lain yang pasti masih seputar Tutorial Visual Basic selamat mencoba dan terima kasih.
0 komentar:
Posting Komentar