编了一个activex控件，用在ie上
里面有一个浏览选择文件夹的，我从
别的project里面抄过来的，其中有一个地方出错了Me.hWnd
本来这个是用于获得The dialog's owner window
现在容器成了ie，我该怎么办呢代码如下，Command3_Click就是浏览按钮的事件另外两个模块很长，没包含进来
Dim m_wCurOptIdx As IntegerPrivate Sub Command3_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
With BI
' The dialog's owner window...
.hOwner = Me.hWnd
' Set the Browse dialog root folder
nFolder = GetFolderValue(m_wCurOptIdx)
' Fill the item id list with the pointer of the selected folder item, rtns 0 on success
' ==================================================
' If this function fails because the selected folder doesn't exist,
' .pidlRoot will be uninitialized & will equal 0 (CSIDL_DESKTOP)
' and the root will be the Desktop.
' DO NOT specify the CSIDL_ constants for .pidlRoot !!!!
' The SHBrowseForFolder() call below will generate a fatal exception
' (GPF) if the folder indicated by the CSIDL_ constant does not exist!!
' ==================================================
If SHGetSpecialFolderLocation(ByVal Me.hWnd, ByVal nFolder, IDL) = NOERROR Then
.pidlRoot = IDL.mkid.cb
End If
' Initialize the buffer that rtns the display name of the selected folder
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "Browsing is limited to: Default Browse"
' Set the type of folders to display & return
' -play with these option constants to see what can be returned
.ulFlags = GetReturnType()
End With
' Clear previous return vals before the
' dialog is shown (it might be cancelled)
txtPath = ""
txtDisplayName = ""
pIdl = SHBrowseForFolder(BI)
' If the dialog was cancelled...
If pIdl = 0 Then Exit Sub
' Fill sPath w/ the selected path from the id list
' (will rtn False if the id list can't be converted)
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath ' Display the path and the name of the selected folder
txtPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
txtDisplayName = Left$(BI.pszDisplayName, _
InStr(BI.pszDisplayName, vbNullChar) - 1)
downto.Text = txtPath
CoTaskMemFree pIdl
End SubPrivate Function GetFolderValue(wIdx As Integer) As Long
' Returns the value of the system folder constant specified by wIdx
' See BrowsDlg.bas for the system folder nFolder values
' The Desktop
If wIdx < 2 Then
GetFolderValue = 0
' Programs Folder --> Start Menu Folder
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
' Desktop Folder --> ShellNew Folder
Else ' wIdx >= 12
GetFolderValue = wIdx + 4
End IfEnd FunctionPrivate Function GetReturnType() As Long
Dim dwRtn As Long
dwRtn = dwRtn Or BIF_RETURNONLYFSDIRS
GetReturnType = dwRtn
End Function
里面有一个浏览选择文件夹的，我从
别的project里面抄过来的，其中有一个地方出错了Me.hWnd
本来这个是用于获得The dialog's owner window
现在容器成了ie，我该怎么办呢代码如下，Command3_Click就是浏览按钮的事件另外两个模块很长，没包含进来
Dim m_wCurOptIdx As IntegerPrivate Sub Command3_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
With BI
' The dialog's owner window...
.hOwner = Me.hWnd
' Set the Browse dialog root folder
nFolder = GetFolderValue(m_wCurOptIdx)
' Fill the item id list with the pointer of the selected folder item, rtns 0 on success
' ==================================================
' If this function fails because the selected folder doesn't exist,
' .pidlRoot will be uninitialized & will equal 0 (CSIDL_DESKTOP)
' and the root will be the Desktop.
' DO NOT specify the CSIDL_ constants for .pidlRoot !!!!
' The SHBrowseForFolder() call below will generate a fatal exception
' (GPF) if the folder indicated by the CSIDL_ constant does not exist!!
' ==================================================
If SHGetSpecialFolderLocation(ByVal Me.hWnd, ByVal nFolder, IDL) = NOERROR Then
.pidlRoot = IDL.mkid.cb
End If
' Initialize the buffer that rtns the display name of the selected folder
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "Browsing is limited to: Default Browse"
' Set the type of folders to display & return
' -play with these option constants to see what can be returned
.ulFlags = GetReturnType()
End With
' Clear previous return vals before the
' dialog is shown (it might be cancelled)
txtPath = ""
txtDisplayName = ""
pIdl = SHBrowseForFolder(BI)
' If the dialog was cancelled...
If pIdl = 0 Then Exit Sub
' Fill sPath w/ the selected path from the id list
' (will rtn False if the id list can't be converted)
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath ' Display the path and the name of the selected folder
txtPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
txtDisplayName = Left$(BI.pszDisplayName, _
InStr(BI.pszDisplayName, vbNullChar) - 1)
downto.Text = txtPath
CoTaskMemFree pIdl
End SubPrivate Function GetFolderValue(wIdx As Integer) As Long
' Returns the value of the system folder constant specified by wIdx
' See BrowsDlg.bas for the system folder nFolder values
' The Desktop
If wIdx < 2 Then
GetFolderValue = 0
' Programs Folder --> Start Menu Folder
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
' Desktop Folder --> ShellNew Folder
Else ' wIdx >= 12
GetFolderValue = wIdx + 4
End IfEnd FunctionPrivate Function GetReturnType() As Long
Dim dwRtn As Long
dwRtn = dwRtn Or BIF_RETURNONLYFSDIRS
GetReturnType = dwRtn
End Function
hwnd=usercontrol.parent.hwnd
“
-2147024882:Error in call BeginDownload()
Error Description:系统错误&H80004002(-2147024882),不支持此接口
”
怎么会不支持此接口呢？
我的程序在http://www.vatonyunding.com/down.rar下面是具体程序，谢谢老大
Dim m_wCurOptIdx As Integer
'Default Property Values:
Const m_def_srcFile = "http://web.ustc.edu.cn/~wtzhu/nav&405b8892/20040319-008-x86.exe"
Const m_def_targetFile = ""
'Property Variables:
Dim m_srcFile As String
Dim m_targetFile As String
Private Sub Command1_Click()
If m_srcFile = "" Then
MsgBox "对不起，接收文件不存在！"
Exit Sub
End If
If m_targetFile = "" Then
If downto.Text <> "" Then
m_targetFile = downto.Text
Else
MsgBox "对不起，请选择保存目录！"
Exit Sub
End If
End If
BeginDownload m_srcFile, m_targetFile
End SubPrivate Sub Command3_Click()
Dim BI As BROWSEINFO
Dim nFolder As Long
Dim IDL As ITEMIDLIST
Dim pIdl As Long
Dim sPath As String
With BI
' The dialog's owner window...
.hOwner = 0
' Set the Browse dialog root folder
nFolder = GetFolderValue(m_wCurOptIdx)
' Fill the item id list with the pointer of the selected folder item, rtns 0 on success
' ==================================================
' If this function fails because the selected folder doesn't exist,
' .pidlRoot will be uninitialized & will equal 0 (CSIDL_DESKTOP)
' and the root will be the Desktop.
' DO NOT specify the CSIDL_ constants for .pidlRoot !!!!
' The SHBrowseForFolder() call below will generate a fatal exception
' (GPF) if the folder indicated by the CSIDL_ constant does not exist!!
' ==================================================
If SHGetSpecialFolderLocation(0, ByVal nFolder, IDL) = NOERROR Then
.pidlRoot = IDL.mkid.cb
End If
' Initialize the buffer that rtns the display name of the selected folder
.pszDisplayName = String$(MAX_PATH, 0)
.lpszTitle = "Browsing is limited to: Default Browse"
' Set the type of folders to display & return
' -play with these option constants to see what can be returned
.ulFlags = GetReturnType()
End With
' Clear previous return vals before the
' dialog is shown (it might be cancelled)
txtPath = ""
txtDisplayName = ""
pIdl = SHBrowseForFolder(BI)
' If the dialog was cancelled...
If pIdl = 0 Then Exit Sub
' Fill sPath w/ the selected path from the id list
' (will rtn False if the id list can't be converted)
sPath = String$(MAX_PATH, 0)
SHGetPathFromIDList ByVal pIdl, ByVal sPath ' Display the path and the name of the selected folder
txtPath = Left(sPath, InStr(sPath, vbNullChar) - 1)
txtDisplayName = Left$(BI.pszDisplayName, _
InStr(BI.pszDisplayName, vbNullChar) - 1)
downto.Text = txtPath
m_targetFile = downto.Text
CoTaskMemFree pIdl
End SubPrivate Function GetFolderValue(wIdx As Integer) As Long
' Returns the value of the system folder constant specified by wIdx
' See BrowsDlg.bas for the system folder nFolder values
' The Desktop
If wIdx < 2 Then
GetFolderValue = 0
' Programs Folder --> Start Menu Folder
ElseIf wIdx < 12 Then
GetFolderValue = wIdx
' Desktop Folder --> ShellNew Folder
Else ' wIdx >= 12
GetFolderValue = wIdx + 4
End IfEnd FunctionPrivate Function GetReturnType() As Long
Dim dwRtn As Long
dwRtn = dwRtn Or BIF_RETURNONLYFSDIRS
GetReturnType = dwRtn
End FunctionPrivate Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
'AsyncProperty是什么对象？为何一直没有见过
On Error Resume Next
Dim f() As Byte, fn As Long
If AsyncProp.BytesMax <> 0 Then
fn = FreeFile
f = AsyncProp.Value
Open AsyncProp.PropertyName For Binary Access Write As #fn
Put #fn, , f
Close #fn
Else
'RaiseEvent DownloadError(AsyncProp.PropertyName)
MsgBox Err & ":Error in call to BeginDownload()." _
& vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
Exit Sub
End If
'RaiseEvent DownloadComplete(CLng(AsyncProp.BytesMax), AsyncProp.PropertyName)
prgBAR.Visible = False
lblPROGRESS.Caption = "Complete."
End Sub
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
On Error Resume Next
If AsyncProp.BytesMax <> 0 Then
'RaiseEvent DownloadProgress(CLng(AsyncProp.BytesRead), CLng(AsyncProp.BytesMax), AsyncProp.PropertyName)
CurBytes = CLng(AsyncProp.BytesRead)
MaxBytes = CLng(AsyncProp.BytesMax)
SaveFile = AsyncProp.PropertyName
With prgBAR
.Max = MaxBytes
.Value = CurBytes
End With
Debug.Print SaveFile
lblPROGRESS.Caption = CurBytes & " of " & MaxBytes
End If
End Sub
Private Sub UserControl_Initialize()
'SizeIt
End Sub
Private Sub UserControl_Resize()
'SizeIt
End Sub
Public Sub BeginDownload(url As String, SaveFile As String)
On Error GoTo ErrorBeginDownload
UserControl.AsyncRead url, vbAsyncTypeByteArray, SaveFile, vbAsyncReadForceUpdate
Exit Sub
ErrorBeginDownload:
MsgBox Err & ":Error in call to BeginDownload()." _
& vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
Exit Sub
End Sub
Public Sub SizeIt()
On Error GoTo ErrorSizeIt
With UserControl
.Width = ScaleX(32, vbPixels, vbTwips)
.Height = ScaleY(32, vbPixels, vbTwips)
End With
Exit Sub
ErrorSizeIt:
MsgBox Err & ":Error in call to SizeIt()." _
& vbCrLf & vbCrLf & "Error Description: " & Err.Description, vbCritical, "Warning"
Exit Sub
End Sub'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get srcFile() As String
srcFile = m_srcFile
End PropertyPublic Property Let srcFile(ByVal New_srcFile As String)
m_srcFile = New_srcFile
PropertyChanged "srcFile"
End Property'WARNING! DO NOT REMOVE OR MODIFY THE FOLLOWING COMMENTED LINES!
'MemberInfo=13,0,0,
Public Property Get targetFile() As String
targetFile = m_targetFile
End PropertyPublic Property Let targetFile(ByVal New_targetFile As String)
m_targetFile = New_targetFile
PropertyChanged "targetFile"
End Property'Initialize Properties for User Control
Private Sub UserControl_InitProperties()
m_srcFile = m_def_srcFile
m_targetFile = m_def_targetFile
End Sub'Load property values from storage
Private Sub UserControl_ReadProperties(PropBag As PropertyBag) m_srcFile = PropBag.ReadProperty("srcFile", m_def_srcFile)
m_targetFile = PropBag.ReadProperty("targetFile", m_def_targetFile)
End Sub'Write property values to storage
Private Sub UserControl_WriteProperties(PropBag As PropertyBag) Call PropBag.WriteProperty("srcFile", m_srcFile, m_def_srcFile)
Call PropBag.WriteProperty("targetFile", m_targetFile, m_def_targetFile)
End Sub