序：笔者(airon,softWorker)注意到，在VB6中，要实现文件下载，一般用和方法都是使用第三方控件，比如IE控件呀，winscok呀，但在本文中，不用添加任何控件，也不引用任何object，就可实现文件下载，而且程序不支持文件下载进度，捕获下载错误，激活下载完成事件等。
具体方法：
1.新建一VB6工程(默认有一个Form1窗体)
2.选择工程菜单的“添加用户控件”来添加一个用户控件。
3.更改Activex用户控件的名称，更改为
Downloader (此项可省) 。
4.输入代码：(在用户控件的代码窗口中)
Option Explicit
Event DownloadProgress(CurBytes As Long, MaxBytes
As Long, SaveFile As String)
Event DownloadError(SaveFile As
String)
Event DownloadComplete(MaxBytes As Long, SaveFile As
String)
'Public downStat As Boolean
Public Function
CancelAsyncRead() As Boolean
On Error Resume
Next
UserControl.CancelAsyncRead
End Function
'Private Sub
Timer1_Timer()
' If Not downStat Then
' Timer1.Enabled =
False
' Exit Sub
' End If
' Static Cs As Integer
' If Cs >
2 Then Cs = 0
' UserControl.Picture = P1(Cs).Picture
' Cs = Cs +
1
' DoEvents
'End Sub
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, SaveFile As String)
On Error GoTo
ErrorBeginDownload
downStat = True
UserControl.AsyncRead url,
vbAsyncTypeByteArray, SaveFile, vbAsyncReadForceUpdate
Timer1.Enabled
= True
Exit Sub
ErrorBeginDownload:
downStat = False
MsgBox
Err & "开始下载数据失败！" _
& vbCrLf & vbCrLf & "错误：" &
Err.Description, vbCritical, "错误"
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:
'End
Sub
'Public Sub kill()
' downStat = False
' Dim m As
AsyncProperty
' MsgBox m.Value
'End
Sub
-----------------------------------------------------
|
