因為要下載程式，屬于局域網，VB無法下載超過2G檔案，不然就報錯。
就想著利用迅雷開放組件下載超過2G的檔案，但是無法正常下載。
有沒有高手看看這個代碼哪里出問題了。
此代碼來源于網路！
下載win10的ISO鏡像時，雖然能下載下來，但是資料有問題！好像沒有完全下載。也沒有下載完成提示。
http://www.vbgood.com/forum.php?mod=attachment&aid=NDAzNTR8NTNlMDUxOGZ8MTYyMTA5NTIyOHwwfDEwNDM0Mw%3D%3D
Option Explicit
Public Declare Function XLInitDownloadEngine Lib "XLDownload.dll" () As Long
Public Declare Function XLURLDownloadToFile Lib "XLDownload.dll" (ByRef pszFileName As Any, ByRef pszUrl As Any, ByRef pszRefUrl As Any, ByRef lTaskId As Long) As Long
Public Declare Function XLQueryTaskInfo Lib "XLDownload.dll" (ByVal lTaskId As Long, ByRef plStatus As Long, ByRef pullFileSize As Currency, ByRef pullRecvSize As Currency) As Long
Public Declare Function XLPauseTask Lib "XLDownload.dll" (ByVal lTaskId As Long, ByRef lNewTaskId As Long) As Long
Public Declare Function XLContinueTask Lib "XLDownload.dll" (ByVal lTaskId As Long) As Long
Public Declare Function XLContinueTaskFromTdFile Lib "XLDownload.dll" (ByRef pszTdFileFullPath As Any, ByRef lTaskId As Long) As Long
Public Declare Sub XLStopTask Lib "XLDownload.dll" (ByVal lTaskId As Long)
Public Declare Function XLUninitDownloadEngine Lib "XLDownload.dll" () As Long
Public Declare Function XLGetErrorMsg Lib "XLDownload.dll" (ByVal dwErrorId As Long, ByVal pszBuffer As Any, ByRef dwSize As Long) As Long
Public Enum enumTaskStatus
enumTaskStatus_Connect = 0 ', // 已經建立鏈接
enumTaskStatus_Download = 2 ', // 開始下載
enumTaskStatus_Pause = 10 ', // 暫停
enumTaskStatus_Success = 11 ', //成功下載
enumTaskStatus_Fail = 12 ', // 下載失敗
End Enum
Public Const XL_SUCCESS As Long = 0
Public Const XL_ERROR_FAIL As Long = &H10000000
'//尚未進行初始化
Public Const XL_ERROR_UNINITAILIZE As Long = XL_ERROR_FAIL + 1
'// 不支持的協議，只支持HTTP與FTP
Public Const XL_ERROR_UNSPORTED_PROTOCOL As Long = XL_ERROR_FAIL + 2
'// 初始化托盤圖示失敗
Public Const XL_ERROR_INIT_TASK_TRAY_ICON_FAIL As Long = XL_ERROR_FAIL + 3
'//添加托盤圖示失敗
Public Const XL_ERROR_ADD_TASK_TRAY_ICON_FAIL As Long = XL_ERROR_FAIL + 4
'// 指標為空
Public Const XL_ERROR_POINTER_IS_NULL As Long = XL_ERROR_FAIL + 5
'// 字串是空串
Public Const XL_ERROR_STRING_IS_EMPTY As Long = XL_ERROR_FAIL + 6
'// 傳入的路徑沒有包含檔案名
Public Const XL_ERROR_PATH_DONT_INCLUDE_FILENAME As Long = XL_ERROR_FAIL + 7
'// ′創建目錄失敗
Public Const XL_ERROR_CREATE_DIRECTORY_FAIL As Long = XL_ERROR_FAIL + 8
'//記憶體不足
Public Const XL_ERROR_MEMORY_ISNT_ENOUGH As Long = XL_ERROR_FAIL + 9
'// 引數不合法
Public Const XL_ERROR_INVALID_ARG As Long = XL_ERROR_FAIL + 10
'// 任務不存在
Public Const XL_ERROR_TASK_DONT_EXIST As Long = XL_ERROR_FAIL + 11
'//檔案名不合法
Public Const XL_ERROR_FILE_NAME_INVALID As Long = XL_ERROR_FAIL + 12
'// 沒有實作
Public Const XL_ERROR_NOTIMPL As Long = XL_ERROR_FAIL + 13
'// 創建的任務達到上限，無法繼續創建
Public Const XL_ERROR_TASKNUM_EXCEED_MAXNUM As Long = XL_ERROR_FAIL + 14
Option Explicit
Dim lTaskId As Long
Dim dwRet As Long
Dim ullFileSize As Currency
Dim ullRecvSize As Currency
Dim lStatus As Long
Dim Inited As Boolean
Dim Paused As Boolean
Private Sub Command1_Click()
If XLInitDownloadEngine = 0 Then
Label1.Caption = "初始化引擎失敗"
Exit Sub
Else
Inited = True
End If
Dim tdFilePath As String
tdFilePath = App.Path & "\hfyg.exe.td"
dwRet = XLContinueTaskFromTdFile(ByVal StrPtr(tdFilePath), lTaskId)
If dwRet <> XL_SUCCESS Then
MsgBox "繼續任務失敗"
Else
Timer1.Enabled = True
Timer1.Interval = 1000
Label1.Caption = "繼續下載, TaskId=" & lTaskId
Command4.Enabled = False
End If
End Sub
Private Sub Command2_Click()
If XLInitDownloadEngine = 0 Then
Label1.Caption = "初始化引擎失敗."
Exit Sub
Else
Inited = True
End If
Dim url As String
Dim filePath As String
filePath = Text2.Text
url = Text1.Text
dwRet = XLURLDownloadToFile(ByVal StrPtr(filePath), ByVal StrPtr(url), ByVal StrPtr(""), lTaskId)
If dwRet <> XL_SUCCESS Then
MsgBox "添加任務失敗"
Else
Timer1.Enabled = True
Timer1.Interval = 1000
Label1.Caption = "開始下載, TaskId=" & lTaskId
Command3.Enabled = True
End If
End Sub
Private Sub Command3_Click()
Dim lNewTaskId As Long
If Paused = True Then
dwRet = XLContinueTask(lTaskId)
If dwRet <> XL_SUCCESS Then
Label1.Caption = "繼續失敗"
Exit Sub
Else
Label1.Caption = "繼續下載, TaskId=" & lTaskId
Paused = False
Timer1.Enabled = True
End If
Else
Timer1.Enabled = False
dwRet = XLPauseTask(lTaskId, lNewTaskId)
If dwRet <> XL_SUCCESS Then
Label1.Caption = "暫停失敗"
Exit Sub
Else
Label1.Caption = "暫停下載"
lTaskId = lNewTaskId
Paused = True
End If
End If
End Sub
Private Sub Form_Load()
lTaskId = -1
Call Text1_Change
End Sub
Private Sub Form_Unload(Cancel As Integer)
If lTaskId <> -1 Then
Label1.Caption = "停止任務, TaskId=" & lTaskId
Me.Refresh
XLStopTask lTaskId
End If
If Inited Then
XLUninitDownloadEngine
End If
End Sub
Private Sub Text1_Change()
On Error Resume Next
Text2.Text = App.Path & "\" & Mid(Text1.Text, InStrRev(Text1.Text, "/") + 1)
If Dir(Text2.Text) <> "" Or Dir(Text2.Text & ".td") <> "" Then
Command4.Enabled = True
If Dir(Text2.Text & ".td") <> "" Then
Command1.Enabled = True
Else
End If
Else
Command2.Enabled = True
Command1.Enabled = False
Command3.Enabled = False
Command4.Enabled = False
End If
End Sub
Private Sub Command4_Click()
On Error Resume Next
If Dir(Text2.Text) <> "" Then
Kill Text2.Text
End If
If Dir(Text2.Text & ".td") <> "" Then
Kill Text2.Text & ".td"
Kill Text2.Text & ".td.cfg"
End If
Call Text1_Change
End Sub
Private Sub Timer1_Timer()
dwRet = XLQueryTaskInfo(lTaskId, lStatus, ullFileSize, ullRecvSize)
If XL_SUCCESS = dwRet Then
'// 輸入進度資訊
Label1.Caption = "正在下載 " & ullRecvSize & "/" & ullFileSize
Else
Label1.Caption = "查詢狀態失敗"
End If
End Sub
uj5u.com熱心網友回復：
呼叫aria2命令列下載即可:aria2c http://xz.lpxt.com/win10/WINDOWS10_X64_20H2ZJB.iso
uj5u.com熱心網友回復：
迅雷的開放組件不支持Aria2！有支持VB的aria2c組件嗎？
uj5u.com熱心網友回復：
迅雷的開放組件不支持Aria2！有支持VB的aria2c組件嗎？
uj5u.com熱心網友回復：
直接呼叫shell函式運行就行了,不用組件:第1種方式:
Shell("aria2c http://xz.lpxt.com/win10/WINDOWS10_X64_20H2ZJB.iso",VbNormalFocus)
第2種方式:
set wsh = createobject("wscript.shell")
wsh.run "aria2c http://xz.lpxt.com/win10/WINDOWS10_X64_20H2ZJB.iso",1,True
第2種方式的好處是可以等待下載完畢,然后再繼續執行后續操作;
當然你要是想即時得到下載進度,進行暫停,繼續,洗掉任務等操作;你就需要深入研究aria2了,應該是可以的,我也再研究研究,看能不能做個ActiveX DLL來實作這些功能;
uj5u.com熱心網友回復：
我看了下，網上沒有這個示例，這個需要下載aria2安裝，才能呼叫吧！哎！我在琢磨琢磨吧！
轉載請註明出處，本文鏈接：https://www.uj5u.com/gongcheng/284157.html
標籤：網絡編程