지식관리, 메모장, 기억저장소, 참고자료, ... :: [Vista] VB6에서 CoCreateInstanceAsAdmin() 함수 사용

▣ ActiveX 권한 상승을 위한 The COM Elevation Moniker
Admin 권한을 가진 ActiveX를 생성하기 위해서는 CoCreateInstanceAsAdmin() 함수를 통해 호출해야한다는데 VC 소스만 난무할 뿐 VB 소스가 없어 만들었습니다.

The COM Elevation Moniker 샘플 코드로 나온 CoCreateInstanceAsAdmin() 함수를 VB로 변환한 것 입니다.

'===============================================================================

' 함 수 명 : CoCreateInstanceAsAdmin()

' 설    명 : ActiveX 권한 상승을 위한 COM Elevation Moniker

' 입 력 값 :

' 결 과 값 :

' 작 성 일 : 2007.04.09

' 작 성 자 : 제용재(182cm@korea.com)

'===============================================================================

Public Function CoCreateInstanceAsAdmin(ByVal hWnd As Long, ByVal Class As String, Optional ByVal IID As String = IID_IDispatch) As Object

    Dim wszMonikerName      As String * 300

    Dim bo                  As BIND_OPTS3

    Dim clsid               As String

    Dim riid                As GUID

    Dim ppv                 As Long

    Dim hr                  As Long

    Set CoCreateInstanceAsAdmin = Nothing

    If Left(Class, 1) = "{" And Right(Class, 1) = "}" Then

        ' CLSID

        clsid = Class

    Else

        ' ProdID로 CLSID 구함

        hr = GetCLSIDFromProgID(Class, clsid)

        If hr <> S_OK Then

            Err.Raise hr, , FormatMessage(hr)

            Exit Function

        End If

    End If

    ' IID에 대한 GUID 구함

    Call CLSIDFromString(StrPtr(IID), riid)

    '

    bo.cbStruct = Len(bo)

    bo.hWnd = hWnd

    bo.dwClassContext = CLSCTX_LOCAL_SERVER

    wszMonikerName = "Elevation:Administrator!new:" & clsid & Chr(0)

    ' Null Terminated Unicode String

    wszMonikerName = StrConv(wszMonikerName, vbUnicode)

    hr = CoGetObject(wszMonikerName, bo, riid, ppv)

    If hr <> S_OK Then

        Err.Raise hr, , FormatMessage(hr)

    Else

        Set CoCreateInstanceAsAdmin = ObjFromPtr(ppv)

    End If

End Function

Private Sub Command1_Click()

    Dim obj         As Object

    Dim StrCLSID    As String

    Dim StrIID      As String

    On Error GoTo Command1_Click_Error

    'StrCLSID = "{00000000-0000-0000-0000-000000000000}"

    StrCLSID = "vc_atl.Class1"

    '

    Set obj = CoCreateInstanceAsAdmin(Me.hWnd, StrCLSID)

    If Not obj Is Nothing Then

        ' ActiveX의 함수 실행

        Call obj.Show

        Set obj = Nothing

    End If

    Exit Sub

Command1_Click_Error:

    Debug.Print vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf & vbCrLf

    Debug.Print "0x" & Hex(Err.Number)

    Debug.Print Err.Description

    'Debug.Assert False

    MsgBox "0x" & Hex(Err.Number) & vbCrLf & Err.Description, vbCritical, "Form1.Command1_Click()"

    Exit Sub

End Sub