Форум программистов [Powered by Invision Power Board]

Код

 Option Explicit

   ' This is the main API used to display the Insert Obj DlgBox
   Private Declare Function OleUIInsertObject Lib "oledlg.dll" _
   Alias "OleUIInsertObjectA" (inParam As Any) As Long

   ' This is used to get the ProgID from Class ID.
   ' Note that this API need us to pass LPOLESTR * from Visual Basic.
   Private Declare Function ProgIDFromCLSID Lib "ole32.dll" _
   (clsid As Any, strAddess As Long) As Long

   ' The memory allocated OLE way need to be released OLE way
   ' with this API.
   Private Declare Sub CoTaskMemFree Lib "ole32.dll" (ByVal pvoid As Long)

   ' Widely used CopyMemory API.
   Private Declare Sub CopyMemory Lib "kernel32" Alias _
   "RtlMoveMemory" (Destination As Any, Source As Any, _
   ByVal Length As Long)

   ' Note that you need to get the strlength of the UNICODE string.
   Private Declare Function lstrlenW Lib "kernel32" _
   (ByVal lpString As Long) As Long

   ' Constants used in the dwFlags of OleUIInsertObjectType.
   Const IOF_SHOWHELP = &H1
   Const IOF_SELECTCREATENEW = &H2
   Const IOF_SELECTCREATEFROMFILE = &H4
   Const IOF_CHECKLINK = &H8
   Const IOF_CHECKDISPLAYASICON = &H10
   Const IOF_CREATENEWOBJECT = &H20
   Const IOF_CREATEFILEOBJECT = &H40
   Const IOF_CREATELINKOBJECT = &H80
   Const IOF_DISABLELINK = &H100
   Const IOF_VERIFYSERVERSEXIST = &H200
   Const IOF_DISABLEDISPLAYASICON = &H400
   Const IOF_HIDECHANGEICON = &H800
   Const IOF_SHOWINSERTCONTROL = &H1000
   Const IOF_SELECTCREATECONTROL = &H2000

   ' Return codes from OleUIInsertObject
   Const OLEUI_FALSE = 0
   Const OLEUI_SUCCESS = 1               ' No error, same as OLEUI_OK.
   Const OLEUI_OK = 1                    ' OK button pressed.
   Const OLEUI_CANCEL = 2                ' Cancel button pressed.

   ' GUID, IID, CLSID, etc
   Private Type GUID
       Data1 As Long
       Data2 As Integer
       Data3 As Integer
       Data4(0 To 7) As Byte
   End Type

   ' Main UDT used in OleUIInsertObject.
   Private Type OleUIInsertObjectType
   ' These IN fields are standard across all OLEUI dialog box functions.
       cbStruct As Long
       dwFlags As Long
       hWndOwner As Long
       lpszCaption  As String    ' LPCSTR
       lpfnHook As Long          ' LPFNOLEUIHOOK
       lCustData As Long         ' LPARAM
       hInstance  As Long
       lpszTemplate As String    ' LPCSTR
       hResource As Long         ' HRSRC
       clsid As GUID

   ' Specifics for OLEUIINSERTOBJECT.
       lpszFile As String        ' LPTSTR
       cchFile As Long
       cClsidExclude As Long
       lpClsidExclude As Long    ' LPCLSID
       IID As GUID

   ' Specifics to create objects if flags say so.
       oleRender As Long
       lpFormatEtc As Long       ' LPFORMATETC
       lpIOleClientSite As Long  ' LPOLECLIENTSITE
       lpIStorage As Long        ' LPSTORAGE
       ppvObj As Long            ' LPVOID FAR *
       sc As Long                ' SCODE
       hMetaPict As Long         ' HGLOBAL
   End Type

   Private Sub Command1_Click()
   Dim UIInsertObj As OleUIInsertObjectType
   Dim retValue As Long
   Dim lpolestr As Long
   Dim strsize As Long
   Dim ProgId As String

   On Error GoTo err

   ' Prepare the OleUIInsertObjectType.
   UIInsertObj.cbStruct = LenB(UIInsertObj)   ' У меня всегда получалась равна 112 в VB 6
   UIInsertObj.dwFlags = IOF_SELECTCREATENEW
   UIInsertObj.hWndOwner = Me.hWnd ' Можно оставить нолик
   UIInsertObj.lpszFile = String(256, " ") ' Функция VB .NET StrDup делает то же самое
   UIInsertObj.cchFile = Len(UIInsertObj.lpszFile) ' = 256

   ' Call the API to display the dialog box.
   retValue = OleUIInsertObject(UIInsertObj) ' Вот тут у меня всегда запарывается

   If (retValue = OLEUI_OK) Then
       ' If we select to insert from a new object
       If ((UIInsertObj.dwFlags And IOF_SELECTCREATENEW) = _
                 IOF_SELECTCREATENEW) Then

       ' You need to get the ProgID.
       ' Note that we pass in a long byref.
         retValue = ProgIDFromCLSID(UIInsertObj.clsid, lpolestr)

       ' The size you need to initialize is the strlen + 1.
         strsize = lstrlenW(lpolestr) + 1
         ProgId = String(strsize, 0)

       ' Copy the string to BSTR. Notice the StrPtr function.
       ' Also notice that every UNICODE char is 2 bytes.
         CopyMemory ByVal StrPtr(ProgId), ByVal lpolestr, strsize * 2

       ' We need to free the memory allocated by ProgIDFromCLSID API.
         CoTaskMemFree lpolestr

         RichTextBox1.OLEObjects.add , , "", ProgId

       Else  ' If we select to insert from file
         RichTextBox1.OLEObjects.add , , UIInsertObj.lpszFile
       End If
      End If

   Exit Sub

   err:
       MsgBox err.Description
   End Sub