加载控件，弹出“拒绝的权限”？搜索过、前人提过仍未解决的ocx权限问题（帮顶有分）

在工具箱上点右键，然后选择“部件...”，在可插入对象选项卡中选
“Microsoft Common Dialog Control 6.0(comdlg32.ocx)”或任意ocx控件，确定后均弹出“拒绝的权限 ”。我没有管理
员权限，但是dll文件所在的SYSTEM32文件和文件夹都有全部的权限。这是怎么回事？

组件服务--》计算机--》我的电脑 添加了user所有权限

装了VB6，有条件的可以在user账号下测试下

在winXP user账号下执行仍弹出“拒绝的权限”。管理员帐号则正常,这个问题困扰半个月了、google搜索遍了也没解决，求达人指点。

34 个解决方案

#1

纠正下，我有管理员权限

#2

up

#3

你在%windir%\system32\下有没有新建文件的权限？

#4

%windir%\system32\ 下可以新建文件

#5

杀毒软件有没有禁止写注册表？

#6

user 账号下进regedit 无法手工添加项 杀毒软件我用的是德国小红伞 提示"无法创建项"或者各种键值。和杀毒软件的提示不一样因为杀毒软件在管理员账号下可以正常的，可以肯定是权限问题。

#7

vb安装目录、system32目录还有保存vb源代码的目录user权限都设置为完全控制了，真奇怪。

#8

能成功调用ocx的留个名说说怎么弄得阿 

#9

只需要你的程序以管理员权限执行就可以了.

写一个启动程序,在这个程序里面使用CreateProcessWithLogon来执行你的主程序就OK.

当然,事先要在这个启动程序里设定好一个管理员账号.

#10

这可是我的一个独门招....嘿嘿

以前用在一款小玩意上的

#11

CreateProcessWithLogonW 函数在 VB自带的API阅读器win32api.txt声明中找不到呢?

#12

mark

#13

呵呵!顶

#14

顶

#15

Declare Function CreateProcessWithLogon Lib "Advapi32" Alias "CreateProcessWithLogonW" (ByVal lpUsername As Long, ByVal lpDomain As Long, ByVal lpPassword As Long, ByVal dwLogonFlags As Long, ByVal lpApplicationName As Long, ByVal lpCommandLine As Long, ByVal dwCreationFlags As Long, ByVal lpEnvironment As Long, ByVal lpCurrentDirectory As Long, lpStartupInfo As STARTUPINFO, lpProcessInfo As PROCESS_INFORMATION) As Long

这个貌似是个比较偏门的API来着...........

#16

这个声明我知道，想知道这些偏门API大家是怎么知道和找到的？VB 6自带的API阅读器win32api.txt中为何没有呢。

#17

VB6的权限设计是不是有很大问题啊? 这不又出现新问题了

相关帖子：
http://topic.csdn.net/u/20071224/12/19e0814b-37f9-46f7-a187-3d8cbd0519d6.html

#18

顶

#19

帮顶吧.

理论上来说,只要提权成功,不存在这问题的.

#20

我也碰过这问题，找不到办法，后面只能用超级用户权限。

#21

VB6的权限设计是不是有很大问题啊?   这不又出现新问题了

//

这个与VB6有什么关系呢?

你用汇编来写也是一样啊.

#22

用API來瀏覽的，沒有碰到過。

#23

给解决方法，别跑题阿

#24

这才注意到你放的控件........汗.

橙子兄真是一语惊死梦中人~~~~~

如果仅是这个控件的话~~~我这里有一个现成的类可以用~~~如下:

[code=VBScript]'*************************************************************************
'**模 块 名：ClsComdlg
'**说    明：超级公共对话框类
'**创 建 人：马大哈 http://www.m5home.com/
'**日    期：2005年6月5日
'**版    本：V1.0
'**备    注：网上搜得~~所复制的网站没有作者信息....-_-b
'*************************************************************************
Option Explicit
                                                
'Private Function ShowOpenDlg(ByVal dlgTitle As String, Optional MultSelect As Boolean = False, Optional ByVal dlgFilter As String) As String
'    Dim LoadF As ClsComdlg
'    Dim I As Long
'
'    Set LoadF = New ClsComdlg
'    If MultSelect = False Then
'        I = OFN_EXPLORER Or OFN_PATHMUSTEXIST
'    Else
'        I = OFN_EXPLORER Or OFN_PATHMUSTEXIST Or OFN_ALLOWMULTISELECT
'    End If
'    LoadF.Filter = IIf(dlgFilter = "", "", AddStrToStr(dlgFilter, "|")) & "所有文件(*.*)|*.*"            '过滤器
'    LoadF.flags = I  '样式
'    LoadF.DialogTitle = dlgTitle                                      '标题
'    LoadF.ShowOpen                                                         '调用ShowOpen显示窗体
'    ShowOpenDlg = LoadF.FileName                                              '返回带路径文件名
'    Set LoadF = Nothing
'End Function
'
'Private Function ShowSaveDlg(ByVal dlgTitle As String, Optional ByVal dlgFilter As String) As String
'    Dim SaveF As ClsComdlg
'    Set SaveF = New ClsComdlg
'
'    SaveF.Filter = IIf(dlgFilter = "", "", AddStrToStr(dlgFilter, "|")) & "所有文件(*.*)|*.*"               '过滤器
'    SaveF.flags = OFN_EXPLORER + OFN_PATHMUSTEXIST
'    SaveF.InitDir = App.Path
'    SaveF.DialogTitle = dlgTitle
'    SaveF.ShowSave
'    ShowSaveDlg = SaveF.FileName
'
'    Set SaveF = Nothing
'End Function

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type OpenFileName
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Type PRINTDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hdc As Long
    flags As Long
    nFromPage As Integer
    nToPage As Integer
    nMinPage As Integer
    nMaxPage As Integer
    nCopies As Integer
    hInstance As Long
    lCustData As Long
    lpfnPrintHook As Long
    lpfnSetupHook As Long
    lpPrintTemplateName As String
    lpSetupTemplateName As String
    hPrintTemplate As Long
    hSetupTemplate As Long
End Type

Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 31
End Type

Private Type CHOOSEFONT
    lStructSize As Long
    hwndOwner As Long          '  caller's window handle
    hdc As Long                '  printer DC/IC or NULL
    lpLogFont As Long
    iPointSize As Long         '  10 * size in points of selected font
    flags As Long              '  enum. type flags
    rgbColors As Long          '  returned text color
    lCustData As Long          '  data passed to hook fn.
    lpfnHook As Long           '  ptr. to hook function
    lpTemplateName As String     '  custom template name
    hInstance As Long          '  instance handle of.EXE that
                                   '    contains cust. dlg. template
    lpszStyle As String          '  return the style field here
                                   '  must be LF_FACESIZE or bigger
    nFontType As Integer          '  same value reported to the EnumFonts
                                   '    call back with the extra FONTTYPE_
                                   '    bits added
    MISSING_ALIGNMENT As Integer
    nSi* As Long           '  minimum pt size allowed &
    nSizeMax As Long           '  max pt size allowed if
                                       '    CF_LIMITSIZE is used
End Type

Private Type FINDREPLACE
    lStructSize As Long        '  size of this struct 0x20
    hwndOwner As Long          '  handle to owner's window
    hInstance As Long          '  instance handle of.EXE that
                                '    contains cust. dlg. template
    flags As Long              '  one or more of the FR_??
    lpstrFindWhat As String      '  ptr. to search string
    lpstrReplaceWith As String   '  ptr. to replace string
    wFindWhatLen As Integer       '  size of find buffer
    wReplaceWithLen As Integer    '  size of replace buffer
    lCustData As Long          '  data passed to hook fn.
    lpfnHook As Long            '  ptr. to hook fn. or NULL
    lpTemplateName As String     '  custom template name
End Type

Private Type PAGESETUPDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    flags As Long
    ptPaperSize As POINTAPI
    rtMinMargin As RECT
    rtMargin As RECT
    hInstance As Long
    lCustData As Long
    lpfnPageSetupHook As Long
    lpfnPagePaintHook As Long
    lpPageSetupTemplateName As String
    hPageSetupTemplate As Long
End Type

Public Enum FileFlags
    OFN_ALLOWMULTISELECT = &H200
    OFN_CREATEPROMPT = &H2000
    OFN_ENABLEHOOK = &H20
    OFN_ENABLETEMPLATE = &H40
    OFN_ENABLETEMPLATEHANDLE = &H80
    OFN_EXPLORER = &H80000                         '  new look commdlg
    OFN_EXTENSIONDIFFERENT = &H400
    OFN_FILEMUSTEXIST = &H1000
    OFN_HIDEREADONLY = &H4
    OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
    OFN_NOCHANGEDIR = &H8
    OFN_NODEREFERENCELINKS = &H100000
    OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
    OFN_NONETWORKBUTTON = &H20000
    OFN_NOREADONLYRETURN = &H8000
    OFN_NOTESTFILECREATE = &H10000
    OFN_NOVALIDATE = &H100
    OFN_OVERWRITEPROMPT = &H2
    OFN_PATHMUSTEXIST = &H800
    OFN_READONLY = &H1
    OFN_SHAREAWARE = &H4000
    OFN_SHAREFALLTHROUGH = 2
    OFN_SHARENOWARN = 1
    OFN_SHAREWARN = 0
    OFN_SHOWHELP = &H10
    
    PD_ALLPAGES = &H0
    PD_COLLATE = &H10
    PD_DISABLEPRINTTOFILE = &H80000
    PD_ENABLEPRINTHOOK = &H1000
    PD_ENABLEPRINTTEMPLATE = &H4000
    PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
    PD_ENABLESETUPHOOK = &H2000
    PD_ENABLESETUPTEMPLATE = &H8000
    PD_ENABLESETUPTEMPLATEHANDLE = &H20000
    PD_HIDEPRINTTOFILE = &H100000
    PD_NONETWORKBUTTON = &H200000
    PD_NOPAGENUMS = &H8
    PD_NOSELECTION = &H4
    PD_NOWARNING = &H80
    PD_PAGENUMS = &H2
    PD_PRINTSETUP = &H40
    PD_PRINTTOFILE = &H20
    PD_RETURNDC = &H100
    PD_RETURNDEFAULT = &H400
    PD_RETURNIC = &H200
    PD_SELECTION = &H1
    PD_SHOWHELP = &H800
    PD_USEDEVMODECOPIES = &H40000
    PD_USEDEVMODECOPIESANDCOLLATE = &H40000
End Enum[code]

#25

咦?????怎么搞的???怎么会少个/?

汗.重来.

'*************************************************************************
'**模 块 名：ClsComdlg
'**说    明：超级公共对话框类
'**创 建 人：马大哈 http://www.m5home.com/
'**日    期：2005年6月5日
'**版    本：V1.0
'**备    注：网上搜得~~所复制的网站没有作者信息....-_-b
'*************************************************************************
Option Explicit
                                                
'Private Function ShowOpenDlg(ByVal dlgTitle As String, Optional MultSelect As Boolean = False, Optional ByVal dlgFilter As String) As String
'    Dim LoadF As ClsComdlg
'    Dim I As Long
'
'    Set LoadF = New ClsComdlg
'    If MultSelect = False Then
'        I = OFN_EXPLORER Or OFN_PATHMUSTEXIST
'    Else
'        I = OFN_EXPLORER Or OFN_PATHMUSTEXIST Or OFN_ALLOWMULTISELECT
'    End If
'    LoadF.Filter = IIf(dlgFilter = "", "", AddStrToStr(dlgFilter, "|")) & "所有文件(*.*)|*.*"            '过滤器
'    LoadF.flags = I  '样式
'    LoadF.DialogTitle = dlgTitle                                      '标题
'    LoadF.ShowOpen                                                         '调用ShowOpen显示窗体
'    ShowOpenDlg = LoadF.FileName                                              '返回带路径文件名
'    Set LoadF = Nothing
'End Function
'
'Private Function ShowSaveDlg(ByVal dlgTitle As String, Optional ByVal dlgFilter As String) As String
'    Dim SaveF As ClsComdlg
'    Set SaveF = New ClsComdlg
'
'    SaveF.Filter = IIf(dlgFilter = "", "", AddStrToStr(dlgFilter, "|")) & "所有文件(*.*)|*.*"               '过滤器
'    SaveF.flags = OFN_EXPLORER + OFN_PATHMUSTEXIST
'    SaveF.InitDir = App.Path
'    SaveF.DialogTitle = dlgTitle
'    SaveF.ShowSave
'    ShowSaveDlg = SaveF.FileName
'
'    Set SaveF = Nothing
'End Function

Private Type POINTAPI
    x As Long
    y As Long
End Type

Private Type RECT
    Left As Long
    Top As Long
    Right As Long
    Bottom As Long
End Type

Private Type OpenFileName
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    lpstrFilter As String
    lpstrCustomFilter As String
    nMaxCustFilter As Long
    nFilterIndex As Long
    lpstrFile As String
    nMaxFile As Long
    lpstrFileTitle As String
    nMaxFileTitle As Long
    lpstrInitialDir As String
    lpstrTitle As String
    flags As Long
    nFileOffset As Integer
    nFileExtension As Integer
    lpstrDefExt As String
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Type PRINTDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    hdc As Long
    flags As Long
    nFromPage As Integer
    nToPage As Integer
    nMinPage As Integer
    nMaxPage As Integer
    nCopies As Integer
    hInstance As Long
    lCustData As Long
    lpfnPrintHook As Long
    lpfnSetupHook As Long
    lpPrintTemplateName As String
    lpSetupTemplateName As String
    hPrintTemplate As Long
    hSetupTemplate As Long
End Type

Private Type CHOOSECOLOR
    lStructSize As Long
    hwndOwner As Long
    hInstance As Long
    rgbResult As Long
    lpCustColors As String
    flags As Long
    lCustData As Long
    lpfnHook As Long
    lpTemplateName As String
End Type

Private Type LOGFONT
    lfHeight As Long
    lfWidth As Long
    lfEscapement As Long
    lfOrientation As Long
    lfWeight As Long
    lfItalic As Byte
    lfUnderline As Byte
    lfStrikeOut As Byte
    lfCharSet As Byte
    lfOutPrecision As Byte
    lfClipPrecision As Byte
    lfQuality As Byte
    lfPitchAndFamily As Byte
    lfFaceName As String * 31
End Type

Private Type CHOOSEFONT
    lStructSize As Long
    hwndOwner As Long          '  caller's window handle
    hdc As Long                '  printer DC/IC or NULL
    lpLogFont As Long
    iPointSize As Long         '  10 * size in points of selected font
    flags As Long              '  enum. type flags
    rgbColors As Long          '  returned text color
    lCustData As Long          '  data passed to hook fn.
    lpfnHook As Long           '  ptr. to hook function
    lpTemplateName As String     '  custom template name
    hInstance As Long          '  instance handle of.EXE that
                                   '    contains cust. dlg. template
    lpszStyle As String          '  return the style field here
                                   '  must be LF_FACESIZE or bigger
    nFontType As Integer          '  same value reported to the EnumFonts
                                   '    call back with the extra FONTTYPE_
                                   '    bits added
    MISSING_ALIGNMENT As Integer
    nSi* As Long           '  minimum pt size allowed &
    nSizeMax As Long           '  max pt size allowed if
                                       '    CF_LIMITSIZE is used
End Type

Private Type FINDREPLACE
    lStructSize As Long        '  size of this struct 0x20
    hwndOwner As Long          '  handle to owner's window
    hInstance As Long          '  instance handle of.EXE that
                                '    contains cust. dlg. template
    flags As Long              '  one or more of the FR_??
    lpstrFindWhat As String      '  ptr. to search string
    lpstrReplaceWith As String   '  ptr. to replace string
    wFindWhatLen As Integer       '  size of find buffer
    wReplaceWithLen As Integer    '  size of replace buffer
    lCustData As Long          '  data passed to hook fn.
    lpfnHook As Long            '  ptr. to hook fn. or NULL
    lpTemplateName As String     '  custom template name
End Type

Private Type PAGESETUPDLG
    lStructSize As Long
    hwndOwner As Long
    hDevMode As Long
    hDevNames As Long
    flags As Long
    ptPaperSize As POINTAPI
    rtMinMargin As RECT
    rtMargin As RECT
    hInstance As Long
    lCustData As Long
    lpfnPageSetupHook As Long
    lpfnPagePaintHook As Long
    lpPageSetupTemplateName As String
    hPageSetupTemplate As Long
End Type

Public Enum FileFlags
    OFN_ALLOWMULTISELECT = &H200
    OFN_CREATEPROMPT = &H2000
    OFN_ENABLEHOOK = &H20
    OFN_ENABLETEMPLATE = &H40
    OFN_ENABLETEMPLATEHANDLE = &H80
    OFN_EXPLORER = &H80000                         '  new look commdlg
    OFN_EXTENSIONDIFFERENT = &H400
    OFN_FILEMUSTEXIST = &H1000
    OFN_HIDEREADONLY = &H4
    OFN_LONGNAMES = &H200000                       '  force long names for 3.x modules
    OFN_NOCHANGEDIR = &H8
    OFN_NODEREFERENCELINKS = &H100000
    OFN_NOLONGNAMES = &H40000                      '  force no long names for 4.x modules
    OFN_NONETWORKBUTTON = &H20000
    OFN_NOREADONLYRETURN = &H8000
    OFN_NOTESTFILECREATE = &H10000
    OFN_NOVALIDATE = &H100
    OFN_OVERWRITEPROMPT = &H2
    OFN_PATHMUSTEXIST = &H800
    OFN_READONLY = &H1
    OFN_SHAREAWARE = &H4000
    OFN_SHAREFALLTHROUGH = 2
    OFN_SHARENOWARN = 1
    OFN_SHAREWARN = 0
    OFN_SHOWHELP = &H10
    
    PD_ALLPAGES = &H0
    PD_COLLATE = &H10
    PD_DISABLEPRINTTOFILE = &H80000
    PD_ENABLEPRINTHOOK = &H1000
    PD_ENABLEPRINTTEMPLATE = &H4000
    PD_ENABLEPRINTTEMPLATEHANDLE = &H10000
    PD_ENABLESETUPHOOK = &H2000
    PD_ENABLESETUPTEMPLATE = &H8000
    PD_ENABLESETUPTEMPLATEHANDLE = &H20000
    PD_HIDEPRINTTOFILE = &H100000
    PD_NONETWORKBUTTON = &H200000
    PD_NOPAGENUMS = &H8
    PD_NOSELECTION = &H4
    PD_NOWARNING = &H80
    PD_PAGENUMS = &H2
    PD_PRINTSETUP = &H40
    PD_PRINTTOFILE = &H20
    PD_RETURNDC = &H100
    PD_RETURNDEFAULT = &H400
    PD_RETURNIC = &H200
    PD_SELECTION = &H1
    PD_SHOWHELP = &H800
    PD_USEDEVMODECOPIES = &H40000
    PD_USEDEVMODECOPIESANDCOLLATE = &H40000
End Enum

#26

续上.

Const FW_NORMAL = 400
Const DEFAULT_CHARSET = 1
Const OUT_DEFAULT_PRECIS = 0
Const CLIP_DEFAULT_PRECIS = 0
Const DEFAULT_QUALITY = 0
Const DEFAULT_PITCH = 0
Const FF_ROMAN = 16
Const GMEM_MOVEABLE = &H2
Const GMEM_ZEROINIT = &H40
Const CF_PRINTERFONTS = &H2
Const CF_SCREENFONTS = &H1
Const CF_BOTH = (CF_SCREENFONTS Or CF_PRINTERFONTS)
Const CF_EFFECTS = &H100&
Const CF_FORCEFONTEXIST = &H10000
Const CF_INITTOLOGFONTSTRUCT = &H40&
Const CF_LIMITSIZE = &H2000&
Const REGULAR_FONTTYPE = &H400

Private Declare Function GetOpenFileName Lib "comdlg32.dll" Alias "GetOpenFileNameA" (pOpenfilename As OpenFileName) As Long
Private Declare Function GetSaveFileName Lib "comdlg32.dll" Alias "GetSaveFileNameA" (pOpenfilename As OpenFileName) As Long
Private Declare Function PrintDialog Lib "comdlg32.dll" Alias "PrintDlgA" (pPrintdlg As PRINTDLG) As Long
Private Declare Function ChooseColorDialog Lib "comdlg32.dll" Alias "ChooseColorA" (pChoosecolor As CHOOSECOLOR) As Long
Private Declare Function CHOOSEFONT Lib "comdlg32.dll" Alias "ChooseFontA" (pChoosefont As CHOOSEFONT) As Long
Private Declare Function FindText Lib "comdlg32.dll" Alias "FindTextA " (pFindreplace As FINDREPLACE) As Long
Private Declare Function PAGESETUPDLG Lib "comdlg32.dll" Alias "PageSetupDlgA" (pPagesetupdlg As PAGESETUPDLG) As Long
Private Declare Function ReplaceText Lib "comdlg32.dll" Alias "ReplaceTextA" (pFindreplace As FINDREPLACE) As Long
Private Declare Function GetForegroundWindow Lib "user32" () As Long
Private Declare Function GlobalAlloc Lib "kernel32" (ByVal wFlags As Long, ByVal dwBytes As Long) As Long
Private Declare Function GlobalFree Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalLock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Function GlobalUnlock Lib "kernel32" (ByVal hMem As Long) As Long
Private Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (hpvDest As Any, hpvSource As Any, ByVal cbCopy As Long)

' FileOpen 类成员变量 =====================================================
Private m_lngHwnd As Long
Private m_lngInstance As Long
Private m_strFileName As String
Private m_strFileTitle As String
Private m_strInitDir As String
Private m_strDialogTitle As String
Private m_strFilter As String
Private m_lngFlags As Long

' Print 类成员变量 =====================================================
Private m_lngCopies As Long
Private m_lngFromPage As Long
Private m_lngToPage As Long
Private m_lngMaxPage As Long
Private m_lngMinPage As Long

' Print 类成员变量 =====================================================
Private m_lngColor As Long

' Font 类成员变量 =====================================================
Private m_strFontName As String
Private m_lngFontColor As Long
Private m_lngFontSize As Long
Private m_lngCharSet As Long
Private m_bolItalic As Boolean
Private m_bolStrikeOut As Boolean
Private m_bolUnderline As Boolean
Private m_bolBlob As Boolean

' PageSetup 类成员变量 =====================================================
Private m_lngPaperWidth As Long
Private m_lngPaperHeight As Long
Private m_lngMarginLeft As Long
Private m_lngMarginTop As Long
Private m_lngMarginRight As Long
Private m_lngMarginBottom As Long
' FileOpen 类实现 =========================================================
Public Function ShowOpen() As Boolean
    Dim fName As String, sName As String, OFName As OpenFileName, I As Long
    
    OFName.lStructSize = Len(OFName)
    OFName.hwndOwner = GetForegroundWindow()
    OFName.hInstance = m_lngInstance
    OFName.lpstrInitialDir = m_strInitDir
    OFName.lpstrFilter = m_strFilter
    OFName.lpstrFile = Space(255) & Chr(0)
    OFName.nMaxFile = 256
    OFName.lpstrFileTitle = Space(255) & Chr(0)
    OFName.nMaxFileTitle = 256
    OFName.lpstrTitle = m_strDialogTitle
    OFName.flags = m_lngFlags
    
    If GetOpenFileName(OFName) Then
        I = InStr(OFName.lpstrFile, Chr(0))
        Do                                                      '*****************      多文件返回 FIX BY 马大哈
            If Mid(OFName.lpstrFile, I + 1, 1) Like "[" & Chr(0) & Chr(32) & "]" Then
                Exit Do
            Else
                I = InStr(I + 1, OFName.lpstrFile, Chr(0))
            End If
        Loop                                                    '*****************      多文件返回 FIX BY 马大哈
        m_strFileName = Left(OFName.lpstrFile, I - 1)
        
        I = InStr(OFName.lpstrFileTitle, Chr(0))
        m_strFileTitle = Left(OFName.lpstrFileTitle, I - 1)

        ShowOpen = True
    Else
        ShowOpen = False
    End If
End Function

Public Property Get Filter() As String
    Filter = m_strFilter
End Property

Public Property Let Filter(ByVal vNewValue As String)
    m_strFilter = Replace(vNewValue, "|", Chr(0)) & Chr(0)
End Property

Public Property Get flags() As FileFlags
    flags = m_lngFlags
End Property

Public Property Let flags(ByVal vNewValue As FileFlags)
    m_lngFlags = vNewValue
End Property

Public Property Get DialogTitle() As String
    DialogTitle = m_strDialogTitle
End Property

Public Property Let DialogTitle(ByVal vNewValue As String)
    m_strDialogTitle = vNewValue
End Property

Public Property Get InitDir() As String
    InitDir = m_strInitDir
End Property

Public Property Let InitDir(ByVal vNewValue As String)
    m_strInitDir = vNewValue
End Property

Public Property Get FileTitle() As String
    FileTitle = m_strFileTitle
End Property

Public Property Let FileTitle(ByVal vNewValue As String)
    m_strFileTitle = vNewValue
End Property

Public Property Get FileName() As String
    FileName = m_strFileName
End Property

Public Property Let FileName(ByVal vNewValue As String)
    m_strFileName = vNewValue
End Property

Public Property Get hWnd() As Long
    hWnd = m_lngHwnd
End Property

Public Property Let hWnd(ByVal vNewValue As Long)
    m_lngHwnd = vNewValue
End Property

Public Property Get Instance() As Long
    Instance = m_lngInstance
End Property

Public Property Let Instance(ByVal vNewValue As Long)
    m_lngInstance = vNewValue
End Property

#27

再续上.

' FileSave 类实现 =========================================================
Public Function ShowSave() As Boolean
    Dim fName As String, sName As String, OFName As OpenFileName
    
    OFName.lStructSize = Len(OFName)
    OFName.hwndOwner = GetForegroundWindow()
    OFName.hInstance = m_lngInstance
    OFName.lpstrInitialDir = m_strInitDir
    OFName.lpstrFilter = m_strFilter
    OFName.lpstrFile = Space(255) & Chr(0)
    OFName.nMaxFile = 256
    OFName.lpstrFileTitle = Space(255) & Chr(0)
    OFName.nMaxFileTitle = 256
    OFName.lpstrTitle = m_strDialogTitle
    OFName.flags = m_lngFlags
    
    If GetSaveFileName(OFName) Then
        m_strFileName = OFName.lpstrFile
        m_strFileTitle = OFName.lpstrFileTitle

        ShowSave = True
    Else
        ShowSave = False
    End If
End Function

' Print 类实现 =========================================================
Public Function ShowPrint() As Boolean
    Dim PrtDlg As PRINTDLG
    
    PrtDlg.lStructSize = Len(PrtDlg)
    PrtDlg.hwndOwner = GetForegroundWindow()
    PrtDlg.hInstance = m_lngInstance
    PrtDlg.nCopies = m_lngCopies
    PrtDlg.nFromPage = m_lngFromPage
    PrtDlg.nMaxPage = m_lngMaxPage
    PrtDlg.nMinPage = m_lngMinPage
    PrtDlg.nToPage = m_lngToPage
    PrtDlg.flags = m_lngFlags
        
    If PrintDialog(PrtDlg) Then
        m_lngCopies = PrtDlg.nCopies
        m_lngFromPage = PrtDlg.nFromPage
        m_lngMaxPage = PrtDlg.nMaxPage
        m_lngMinPage = PrtDlg.nMinPage
        m_lngToPage = PrtDlg.nToPage

        ShowPrint = True
    Else
        ShowPrint = False
    End If
End Function

Public Property Get Copies() As Long
    Copies = m_lngCopies
End Property

Public Property Let Copies(ByVal vNewValue As Long)
    m_lngCopies = vNewValue
End Property

Public Property Get FromPage() As Long
    FromPage = m_lngFromPage
End Property

Public Property Let FromPage(ByVal vNewValue As Long)
    m_lngFromPage = vNewValue
End Property

Public Property Get ToPage() As Long
    ToPage = m_lngToPage
End Property

Public Property Let ToPage(ByVal vNewValue As Long)
    m_lngToPage = vNewValue
End Property

Public Property Get MaxPage() As Long
    MaxPage = m_lngMaxPage
End Property

Public Property Let MaxPage(ByVal vNewValue As Long)
    m_lngMaxPage = vNewValue
End Property

Public Property Get MinPage() As Long
    MinPage = m_lngMinPage
End Property

Public Property Let MinPage(ByVal vNewValue As Long)
    m_lngMinPage = vNewValue
End Property

' ChooseColorDialog 类实现 =========================================================
Public Function ShowColor() As Boolean
    Dim I As Integer
    Dim ClrDlg As CHOOSECOLOR, CustomColors() As Byte

    ReDim CustomColors(0 To 63) As Byte
    For I = LBound(CustomColors) To UBound(CustomColors)
        CustomColors(I) = 0
    Next I

    ClrDlg.lStructSize = Len(ClrDlg)
    ClrDlg.hwndOwner = GetForegroundWindow()
    ClrDlg.hInstance = m_lngInstance
    ClrDlg.lpCustColors = StrConv(CustomColors, vbUnicode)
 
    If ChooseColorDialog(ClrDlg) Then
        m_lngColor = ClrDlg.rgbResult
        CustomColors = StrConv(ClrDlg.lpCustColors, vbFromUnicode)

        ShowColor = True
    Else
        ShowColor = False
    End If
End Function

Public Property Get Color() As Long
    Color = m_lngColor
End Property

Public Property Let Color(ByVal vNewValue As Long)
    m_lngColor = vNewValue
End Property

' Font 类实现 =========================================================
Public Function ShowFont() As Boolean
    Dim cf As CHOOSEFONT, lfont As LOGFONT, hMem As Long, pMem As Long
    Dim FontName As String, retval As Long
    
    lfont.lfHeight = 0  ' determine default height
    lfont.lfWidth = 0  ' determine default width
    lfont.lfEscapement = 0  ' angle between baseline and escapement vector
    lfont.lfOrientation = 0  ' angle between baseline and orientation vector
    lfont.lfWeight = FW_NORMAL  ' normal weight I.e. Not bold
    lfont.lfCharSet = DEFAULT_CHARSET  ' use default character set
    lfont.lfOutPrecision = OUT_DEFAULT_PRECIS  ' default precision mapping
    lfont.lfClipPrecision = CLIP_DEFAULT_PRECIS  ' default clipping precision
    lfont.lfQuality = DEFAULT_QUALITY  ' default quality setting
    lfont.lfPitchAndFamily = DEFAULT_PITCH Or FF_ROMAN  ' default pitch, proportional with serifs
    lfont.lfFaceName = "Times New Roman" & vbNullChar  ' string must be null-terminated
    ' Create the memory block which will act as the LOGFONT structure buffer.
    hMem = GlobalAlloc(GMEM_MOVEABLE Or GMEM_ZEROINIT, Len(lfont))
    pMem = GlobalLock(hMem)  ' lock and get pointer
    CopyMemory ByVal pMem, lfont, Len(lfont)  ' copy structure's contents into block
    
    ' Initialize dialog box: Screen and printer fonts, point size between 10 and 72.
    cf.lStructSize = Len(cf)  ' size of structure
    cf.hwndOwner = GetForegroundWindow()  ' window Form1 is opening this dialog box
    cf.hdc = Printer.hdc  ' device context of default printer (using VB's mechanism)
    cf.lpLogFont = pMem   ' pointer to LOGFONT memory block buffer
    cf.iPointSize = 120  ' 12 point font (in units of 1/10 point)
    cf.flags = CF_BOTH Or CF_EFFECTS Or CF_FORCEFONTEXIST Or CF_INITTOLOGFONTSTRUCT Or CF_LIMITSIZE
    cf.rgbColors = RGB(0, 0, 0)  ' black
    cf.nFontType = REGULAR_FONTTYPE  ' regular font type I.e. Not bold or anything
    cf.nSi* = 1  ' minimum point size
    cf.nSizeMax = 72  ' maximum point size
    ' Now, call the function.  If successful, copy the LOGFONT structure back into the structure
    ' and then print out the attributes we mentioned earlier that the user selected.
    
    If CHOOSEFONT(cf) Then  ' success
        CopyMemory lfont, ByVal pMem, Len(lfont)  ' copy memory back
        ' Now make the fixed-length string holding the font name into a "normal" string.
        m_strFontName = Left(lfont.lfFaceName, InStr(lfont.lfFaceName, vbNullChar) - 1)
        m_lngFontColor = cf.rgbColors
        m_lngFontSize = cf.iPointSize / 10
        m_lngCharSet = lfont.lfCharSet
        m_bolItalic = lfont.lfItalic = 255
        m_bolStrikeOut = lfont.lfStrikeOut = 1
        m_bolUnderline = lfont.lfUnderline = 1
        m_bolBlob = lfont.lfWeight >= 700
        ShowFont = True
    Else
        ShowFont = False
    End If
    ' Deallocate the memory block we created earlier.  Note that this must
    ' be done whether the function succeeded or not.
    retval = GlobalUnlock(hMem)  ' destroy pointer, unlock block
    retval = GlobalFree(hMem)  ' free the allocated memory
End Function

#28

最后一块~~~

Public Property Get FontName() As String
    FontName = m_strFontName
End Property

Public Property Let FontName(ByVal vNewValue As String)
    m_strFontName = vNewValue
End Property

Public Property Get FontColor() As Long
    FontColor = m_lngFontColor
End Property

Public Property Let FontColor(ByVal vNewValue As Long)
    m_lngFontColor = vNewValue
End Property

Public Property Get FontSize() As Long
    FontSize = m_lngFontSize
End Property

Public Property Let FontSize(ByVal vNewValue As Long)
    m_lngFontSize = vNewValue
End Property

Public Property Get CharSet() As Long
    CharSet = m_lngCharSet
End Property

Public Property Let CharSet(ByVal vNewValue As Long)
    m_lngCharSet = vNewValue
End Property

Public Property Get Italic() As Boolean
    Italic = m_bolItalic
End Property

Public Property Let Italic(ByVal vNewValue As Boolean)
    m_bolItalic = vNewValue
End Property

Public Property Get StrikeOut() As Boolean
    StrikeOut = m_bolStrikeOut
End Property

Public Property Let StrikeOut(ByVal vNewValue As Boolean)
    m_bolStrikeOut = vNewValue
End Property

Public Property Get Underline() As Boolean
    Underline = m_bolUnderline
End Property

Public Property Let Underline(ByVal vNewValue As Boolean)
    m_bolUnderline = vNewValue
End Property

Public Property Get FontBlob() As Boolean
    FontBlob = m_bolBlob
End Property

Public Property Let FontBlob(ByVal vNewValue As Boolean)
    m_bolBlob = vNewValue
End Property

' Find 类实现 =========================================================
Public Function ShowFind() As Boolean
    Dim lFind As FINDREPLACE

    lFind.lStructSize = Len(lFind)
    lFind.hwndOwner = GetForegroundWindow()
    lFind.hInstance = m_lngInstance
    lFind.wFindWhatLen = 255
    
'    If FindText(lFind) Then
'        ShowFind = True
'    Else
'        ShowFind = False
'    End If
End Function

' Replace 类实现 =========================================================
Public Function ShowReplace() As Boolean
    Dim lFind As FINDREPLACE

    lFind.lStructSize = Len(lFind)
    lFind.hwndOwner = GetForegroundWindow()
    lFind.hInstance = m_lngInstance
    lFind.wFindWhatLen = 255
    
    If ReplaceText(lFind) Then
        ShowReplace = True
    Else
        ShowReplace = False
    End If
End Function

' Replace 类实现 =========================================================
Public Function ShowPageSetup() As Boolean
    Dim lPageSetup As PAGESETUPDLG

    lPageSetup.lStructSize = Len(lPageSetup)
    lPageSetup.hwndOwner = GetForegroundWindow()
    lPageSetup.hInstance = m_lngInstance

    If PAGESETUPDLG(lPageSetup) Then
        m_lngPaperWidth = lPageSetup.ptPaperSize.x
        m_lngPaperHeight = lPageSetup.ptPaperSize.y
        m_lngMarginLeft = lPageSetup.rtMargin.Left
        m_lngMarginTop = lPageSetup.rtMargin.Top
        m_lngMarginRight = lPageSetup.rtMargin.Right
        m_lngMarginBottom = lPageSetup.rtMargin.Bottom
        
        ShowPageSetup = True
    Else
        ShowPageSetup = False
    End If
End Function

Public Property Get PaperWidth() As Long
    PaperWidth = m_lngPaperWidth
End Property

Public Property Let PaperWidth(ByVal vNewValue As Long)
    m_lngPaperWidth = vNewValue
End Property

Public Property Get PaperHeight() As Long
    PaperHeight = m_lngPaperHeight
End Property

Public Property Let PaperHeight(ByVal vNewValue As Long)
    m_lngPaperHeight = vNewValue
End Property

Public Property Get MarginLeft() As Long
    MarginLeft = m_lngMarginLeft
End Property

Public Property Let MarginLeft(ByVal vNewValue As Long)
    m_lngMarginLeft = vNewValue
End Property

Public Property Get MarginTop() As Long
    MarginTop = m_lngMarginTop
End Property

Public Property Let MarginTop(ByVal vNewValue As Long)
    m_lngMarginTop = vNewValue
End Property

Public Property Get MarginRight() As Long
    MarginRight = m_lngMarginRight
End Property

Public Property Let MarginRight(ByVal vNewValue As Long)
    m_lngMarginRight = vNewValue
End Property

Public Property Get MarginBottom() As Long
    MarginBottom = m_lngMarginBottom
End Property

Public Property Let MarginBottom(ByVal vNewValue As Long)
    m_lngMarginBottom = vNewValue
End Property

把这些保存到一个类模块,名字取ClsComdlg.cls

然后在工程里添加,就可以像使用控件一样了,方法属性基本一样,具体自己小改一下就OK.

最上面的两块注释是"打开"与"保存"对话框的封装,其它通用对话框类似.

#29

myjian真是人才，我现在通过 CreateProcessWithLogonW 函数所有ocx都可以调用了,但用的MSXML4在user账号下保存时为空怎么解决,http://topic.csdn.net/u/20071224/12/19e0814b-37f9-46f7-a187-3d8cbd0519d6.html 

想知道CreateProcessWithLogonW 这些偏门API是怎么知道和找到的？VB 6自带的API阅读器win32api.txt中为何没有呢????????????

#30

想知道怎样找到就2种可能

1、vb开发人员告诉的

2、自己蒙的

#31

最后问题:
CreateProcessWithLogonW 在VB6自带的API阅读器win32api.txt中为何没有呢????????????

#32

在VB6自带的API阅读器win32api.txt中很多API函数都没有，至于为什么，只能问微软！

#33

一些是微软自己保留的（就是所谓的未公开功能），另一部分是之后新增的功能。

#34

ok,结帖