VERSION 1.0 CLASS
BEGIN
  MultiUse = -1  'True
  Persistable = 0  'NotPersistable
  DataBindingBehavior = 0  'vbNone
  DataSourceBehavior  = 0  'vbNone
  MTSTransactionMode  = 0  'NotAnMTSObject
END
Attribute VB_Name = "clsDllRegister"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'
' 이 파일은 기계어 클래스 생성기로 만들어졌습니다.
'
'     <DLL 등록> 모듈
'     작성자: 지상현(쥐씨당)
'
'     설명: ActiveX를 등록하거나 등록 해제한다.
'
'
' 만든 날짜: 2007-02-28
' 만든 시각: 오후 3:40:16
'
' 이 모듈에는 1개의 네이티브 함수가 있습니다.
' 모듈을 임의로 수정하지 마십시오.
'

Option Explicit

Private Declare Sub memcpy Lib "kernel32" Alias "RtlMoveMemory" (dest As Any, src As Any, ByVal Length As Long)

Private Declare Function LoadLibrary Lib "kernel32" Alias "LoadLibraryA" (ByVal lpLibFileName As String) As Long
Private Declare Function FreeLibrary Lib "kernel32" (ByVal hLibModule As Long) As Long
Private Declare Function GetProcAddress Lib "kernel32" (ByVal hModule As Long, ByVal lpProcName As String) As Long

Public Enum ResultCode
    S_OK = 0&                       ' 성공
    
    ERROR_FILE_NOT_FOUND = 2&       ' 파일이 없음
    ERROR_FILE_INVALID = 1006&      ' 잘못된 파일 (DLL이 아니거나)
    ERROR_FILE_CORRUPT = 1392&      ' 잘못된 파일 (등록 가능한 DLL이 아니거나)
    
    E_UNEXPECTED = &H8000FFFF       ' 예상치 못한 오류
    E_OUTOFMEMORY = &H8007000E      ' 메모리가 부족함
    SELFREG_E_TYPELIB = &H200&      ' TypeLib 등록 오류
    SELFREG_E_CLASS = &H201&        ' 클래스 등록 오류
End Enum

Private m_VtblOffset As Long
Private m_CodeData() As Byte

Public Property Let Vtbl(ByVal Index As Long, ByVal lNewPtr As Long)
memcpy ByVal m_VtblOffset + Index * 4, lNewPtr, 4
End Property

Public Property Get Vtbl(ByVal Index As Long) As Long
memcpy Vtbl, ByVal m_VtblOffset + Index * 4, 4
End Property

Private Sub InitCodeData()
Const CODE_DATA = "5589E58B550CFFD28B5510890231C0" & _
                  "89EC5DC20C00"
Dim i As Long, k As Long

k = Len(CODE_DATA) \ 2
ReDim m_CodeData(0 To k - 1)
For i = 0 To k - 1
    m_CodeData(i) = CByte("&H" & Mid$(CODE_DATA, i * 2 + 1, 2))
Next

' 새 네이티브 메서드를 채워넣습니다.
k = VarPtr(m_CodeData(0))
Vtbl(2) = k + 0
End Sub

Private Sub Class_Initialize()
memcpy m_VtblOffset, ByVal ObjPtr(Me), 4
m_VtblOffset = m_VtblOffset + &H1C&
InitCodeData
End Sub

Private Sub Class_Terminate()
m_VtblOffset = 0
Erase m_CodeData
End Sub

' $네이티브 메서드: MakeVoidCall
Public Function MakeVoidCall(ByVal lpfnProc As Long) As Long
End Function

Private Function CallDllFunction(ByVal szFile As String, ByVal szFuncName As String) As ResultCode
Dim hMod As Long
Dim pfnProc As Long

On Error GoTo EFileException
If Len(Dir(szFile)) = 0 Then
EFileException:
    CallDllFunction = ERROR_FILE_NOT_FOUND
    Exit Function
End If
On Error GoTo 0

hMod = LoadLibrary(szFile)
If hMod Then
    pfnProc = GetProcAddress(hMod, szFuncName)
    
    If pfnProc Then
        ' DLL 함수 호출
        CallDllFunction = MakeVoidCall(pfnProc)
    Else
        CallDllFunction = ERROR_FILE_CORRUPT
    End If
    
    FreeLibrary hMod
Else
    CallDllFunction = ERROR_FILE_INVALID
End If
End Function

Public Function RegisterServer(ByVal szFile As String) As ResultCode
RegisterServer = CallDllFunction(szFile, "DllRegisterServer")
End Function

Public Function UnregisterServer(ByVal szFile As String) As ResultCode
UnregisterServer = CallDllFunction(szFile, "DllUnregisterServer")
End Function

Posted by koinit
,