J
Çevrimdışı
JustforYou
Kayıtlı Üye
- 18 Mayıs 2012
- 235
- 7
- 18
- 29
şöyle bir modulümüz var
şimdi Form1_loada ekliyoruz
burda dlladi.dll yazan yere kayıt ediceğimiz dll gelicek
kayıt edilecek .DLL dosyasını programın yanında vermeyi unutmayın
Module Module1
Private Declare Function LoadLibraryRegister Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) 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" (ByVal lpThreadAttributes As Long, ByVal dwStackSize As Long, ByVal lpStartAddress As Long, ByVal lpParameter As Long, ByVal dwCreationFlags As Long, ByVal 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, ByVal lpExitCode As Long) As Long
Private Declare Sub ExitThread Lib "kernel32" (ByVal dwExitCode As Long)
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Declare Function FreeLibraryRegister Lib "kernel32" Alias "FreeLibrary" (ByVal hLibModule As Long) As Long
Dim stFileCouldNotBeLoadedIntoMemorySpace As Integer
Dim stNotAValidActiveXComponent As Integer
Dim stActiveXComponentRegistrationFailed As Integer
Dim stActiveXComponentRegistrationSuccessful As Integer
Dim stActiveXComponentUnRegisterSuccessful As Integer
Dim stActiveXComponentUnRegistrationFailed As Integer
Dim stNoFileProvided As Integer
Private Const NOERRORS As Long = 0
Private Const STATUS_WAIT_0 = &H0
Private Const WAIT_OBJECT_0 = ((STATUS_WAIT_0) + 0)
Private Enum stRegisterStatus
stFileCouldNotBeLoadedIntoMemorySpace = 1
stNotAValidActiveXComponent = 2
stActiveXComponentRegistrationFailed = 3
stActiveXComponentRegistrationSuccessful = 4
stActiveXComponentUnRegisterSuccessful = 5
stActiveXComponentUnRegistrationFailed = 6
stNoFileProvided = 7
End Enum
Public Function Register(ByVal p_sFileName As String) As Object
Dim lLib As Long
Dim lProcAddress As Long
Dim lThreadID As Long
Dim lSuccess As Long
Dim lExitCode As Long
Dim lThreadHandle As Long
Dim lRet As Long
On Error GoTo ErrorHandler
If lRet = NOERRORS Then
If p_sFileName = "" Then
lRet = stNoFileProvided
End If
End If
If lRet = NOERRORS Then
lLib = LoadLibraryRegister(p_sFileName)
If lLib = 0 Then
lRet = stFileCouldNotBeLoadedIntoMemorySpace
End If
End If
If lRet = NOERRORS Then
lProcAddress = GetProcAddressRegister(lLib, "DllRegisterServer")
If lProcAddress = 0 Then
lRet = stNotAValidActiveXComponent
Else
lThreadHandle = CreateThreadForRegister(0, 0, lProcAddress, 0, 0, lThreadID)
If lThreadHandle <> 0 Then
lSuccess = (WaitForSingleObject(lThreadHandle, 10000) = WAIT_OBJECT_0)
If lSuccess = 0 Then
Call GetExitCodeThread(lThreadHandle, lExitCode)
Call ExitThread(lExitCode)
lRet = stActiveXComponentRegistrationFailed
Else
lRet = stActiveXComponentRegistrationSuccessful
End If
End If
End If
End If
ExitRoutine:
Register = lRet
If lThreadHandle <> 0 Then
Call CloseHandle(lThreadHandle)
End If
If lLib <> 0 Then
Call FreeLibraryRegister(lLib)
End If
Exit Function
ErrorHandler:
lRet = Err.Number
GoTo ExitRoutine
End Function
End Module
şimdi Form1_loada ekliyoruz
Private Sub Form1_Load(ByVal sender As Object, ByVal e As System.EventArgs) Handles Me.Load
Dim fileExists As Boolean
fileExists = My.Computer.FileSystem.FileExists("dlladi.dll")
If fileExists = False Then
MsgBox("istenilen .dll Bulunamadı ! ,programlar doğru çalışmayablir !!!")
End If
If fileExists = True Then
Call Register(CurDir() & "\dlladi.dll")
End If
End Sub
burda dlladi.dll yazan yere kayıt ediceğimiz dll gelicek
kayıt edilecek .DLL dosyasını programın yanında vermeyi unutmayın
