用vb开发实现http文件下载的ActiveX控件

Private Sub UserControl_AsyncReadComplete(AsyncProp As 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)
  
End If
  
RaiseEvent DownloadComplete(CLng(AsyncProp.BytesMax), AsyncProp.PropertyName)
  downStat 
= False
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)
    downStat 
= True
    
': Timer1.Enabled = True
  End If
End Sub

'Private Sub UserControl_Resize()
'
 SizeIt
'
End Sub

Public Sub BeginDownload(url As String, SaveFileDir As String, SaveFileName As String)
  
  downStat 
= True
  
   
On Error Resume Next
   
Dim fs As New FileSystemObject
   
If (Not fs.FolderExists(SaveFileDir)) Then
    
        
MkDir SaveFileDir
    
End If
  
  
  
On Error GoTo ErrorBeginDownload
  
  UserControl.AsyncRead url, vbAsyncTypeByteArray, SaveFileDir 
& SaveFileName, vbAsyncReadForceUpdate
  
'Timer1.Enabled = True
  Exit Sub
ErrorBeginDownload:
  downStat 
= False
  
MsgBox Err & "开始下载数据失败!" _
& vbCrLf & vbCrLf & "错误:" & Err.Description, vbCritical, "错误"
End Sub

posted @ 2007-05-27 15:31  simplay  阅读(2060)  评论(0编辑  收藏  举报