主頁 > 軟體工程 > VB呼叫迅雷開放下載組件例外!

VB呼叫迅雷開放下載組件例外!

2021-05-17 01:00:38 軟體工程

因為要下載程式,屬于局域網,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熱心網友回復:

參考 1 樓 milaoshu1020 的回復:
呼叫aria2命令列下載即可:
aria2c http://xz.lpxt.com/win10/WINDOWS10_X64_20H2ZJB.iso
迅雷的開放組件不支持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熱心網友回復:

參考 4 樓 milaoshu1020 的回復:
直接呼叫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來實作這些功能;


我看了下,網上沒有這個示例,這個需要下載aria2安裝,才能呼叫吧!哎!我在琢磨琢磨吧!

轉載請註明出處,本文鏈接:https://www.uj5u.com/gongcheng/284157.html

標籤:網絡編程

上一篇:為實作bt下載,取得了許多 peer 的ip 地址及 port 埠,卻次次都連接不上peer,為什么?

下一篇:VC:呼叫DoModal()函式,程式崩潰無反應。

標籤雲
其他(123570) Java(13369) Python(12731) C(7545) 區塊鏈(7372) JavaScript(7059) 基礎類(6313) AI(6244) 腳本語言(PerlPython)(5129) 非技術區(4971) Android(4120) MySQL(4012) Linux(3394) C語言(3288) C++語言(3117) Java相關(2746) 疑難問題(2699) 單片機工控(2479) Web開發(1951) 網絡通信(1793) 數據庫相關(1767) VB基礎類(1755) PHP(1727) 開發(1646) 系統維護與使用區(1617) .NETCore(1586) 基礎和管理(1579) JavaEE(1566) C++(1527) 專題技術討論區(1515) Windows客戶端使用(1484) HtmlCss(1466) ASP.NET(1428) Unity3D(1354) VCL組件開發及應用(1353) HTML(CSS)(1220) 其他技術討論專區(1200) WindowsServer(1192) .NET技术(1165) 交換及路由技術(1149) 語言基礎算法系統設計(1133) WindowsSDKAPI(1124) 界面(1088) JavaSE(1075) Qt(1074) VBA(1048) 新手樂園(1016) 其他開發語言(947) Go(907) HTML5(901) 新技術前沿(898) 硬件設計(872) 區塊鏈技術(860) 網絡編程(857) 非技術版(846) 一般軟件使用(839) 網絡協議與配置(835) Eclipse(790) Spark(750) 下載資源懸賞專區(743)

熱門瀏覽
  • Git本地庫既關聯GitHub又關聯Gitee

    創建代碼倉庫 使用gitee舉例(github和gitee差不多) 1.在gitee右上角點擊+,選擇新建倉庫 ? 2.選擇填寫倉庫資訊,然后進行創建 ? 3.服務端已經準備好了,本地開始作準備 (1)Git 全域設定 git config --global user.name "成鈺" git c ......

    uj5u.com 2020-09-10 05:04:14 more
  • CODING DevOps 代碼質量實戰系列第二課,相約周三

    隨著 ToB(企業服務)的興起和 ToC(消費互聯網)產品進入成熟期,線上故障帶來的損失越來越大,代碼質量越來越重要,而「質量內建」正是 DevOps 核心理念之一。**《DevOps 代碼質量實戰(PHP 版)》**為 CODING DevOps 代碼質量實戰系列的第二課,同時也是本系列的 PHP ......

    uj5u.com 2020-09-10 05:07:43 more
  • 推薦Scrum書籍

    推薦Scrum書籍 直接上干貨,推薦書籍清單如下(推薦有順序的哦) Scrum指南 Scrum精髓 Scrum敏捷軟體開發 Scrum捷徑 硝煙中的Scrum和XP : 我們如何實施Scrum 敏捷軟體開發:Scrum實戰指南 Scrum要素 大規模Scrum:大規模敏捷組織的設計 用戶故事地圖 用 ......

    uj5u.com 2020-09-10 05:07:45 more
  • CODING DevOps 代碼質量實戰系列最后一課,周四發車

    隨著 ToB(企業服務)的興起和 ToC(消費互聯網)產品進入成熟期,線上故障帶來的損失越來越大,代碼質量越來越重要,而「質量內建」正是 DevOps 核心理念之一。 **《DevOps 代碼質量實戰(Java 版)》**為 CODING DevOps 代碼質量實戰系列的最后一課,同時也是本系列的 ......

    uj5u.com 2020-09-10 05:07:52 more
  • 敏捷軟體工程實踐書籍

    Scrum轉型想要做好,第一步先了解并真正落實Scrum,那么我推薦的Scrum書籍是要看懂并實踐的。第二步是團隊的工程實踐要做扎實。 下面推薦工程實踐書單: 重構:改善既有代碼的設計 決議極限編程 : 擁抱變化 代碼整潔代碼 程式員的職業素養 修改代碼的藝術 撰寫可讀代碼的藝術 測驗驅動開發 : ......

    uj5u.com 2020-09-10 05:07:55 more
  • Jenkins+svn+nginx實作windows環境自動部署vue前端專案

    前面文章介紹了Jenkins+svn+tomcat實作自動化部署,現在終于有空抽時間出來寫下Jenkins+svn+nginx實作自動部署vue前端專案。 jenkins的安裝和配置已經在前面文章進行介紹,下面介紹實作vue前端專案需要進行的哪些額外的步驟。 注意:在安裝jenkins和nginx的 ......

    uj5u.com 2020-09-10 05:08:49 more
  • CODING DevOps 微服務專案實戰系列第一課,明天等你

    CODING DevOps 微服務專案實戰系列第一課**《DevOps 微服務專案實戰:DevOps 初體驗》**將由 CODING DevOps 開發工程師 王寬老師 向大家介紹 DevOps 的基本理念,并探討為什么現代開發活動需要 DevOps,同時將以 eShopOnContainers 項 ......

    uj5u.com 2020-09-10 05:09:14 more
  • CODING DevOps 微服務專案實戰系列第二課來啦!

    近年來,工程專案的結構越來越復雜,需要接入合適的持續集成流水線形式,才能滿足更多變的需求,那么如何優雅地使用 CI 能力提升生產效率呢?CODING DevOps 微服務專案實戰系列第二課 《DevOps 微服務專案實戰:CI 進階用法》 將由 CODING DevOps 全堆疊工程師 何晨哲老師 向 ......

    uj5u.com 2020-09-10 05:09:33 more
  • CODING DevOps 微服務專案實戰系列最后一課,周四開講!

    隨著軟體工程越來越復雜化,如何在 Kubernetes 集群進行灰度發布成為了生產部署的”必修課“,而如何實作安全可控、自動化的灰度發布也成為了持續部署重點關注的問題。CODING DevOps 微服務專案實戰系列最后一課:**《DevOps 微服務專案實戰:基于 Nginx-ingress 的自動 ......

    uj5u.com 2020-09-10 05:10:00 more
  • CODING 儀表盤功能正式推出,實作作業資料可視化!

    CODING 儀表盤功能現已正式推出!該功能旨在用一張張統計卡片的形式,統計并展示使用 CODING 中所產生的資料。這意味著無需額外的設定,就可以收集歸納寶貴的作業資料并予之量化分析。這些海量的資料皆會以圖表或串列的方式躍然紙上,方便團隊成員隨時查看各專案的進度、狀態和指標,云端協作迎來真正意義上 ......

    uj5u.com 2020-09-10 05:11:01 more
最新发布
  • 在執行com.android.build.gradle.internal.tasks.Workers$Action

    我創建的安卓應用有兩種產品口味,一種是生產型,一種是暫存型,當我為生產型設定動態鏈接時,我在清單中使用了以下資料代碼
    android:scheme="https"。
    />...

    uj5u.com 2021-10-16 15:31:15 more
  • 向kotlin springboot gradle匯入jar檔案

    請幫助,我有兩個使用Kotlin DSL Gradle的spring boot專案,但是,我需要將其中一個專案匯入另一個專案,但是,這不起作用。
    向 IntelliJ IDEA 專案添加外部 jars(lib/*.jar)的正確...

    uj5u.com 2021-10-16 15:30:34 more
  • 賽普拉斯測驗在iframe處掛起

    當我運行這個測驗時,一切似乎都很正常,直到我嘗試點擊iframe中的按鈕。我從下拉選單中選擇沒有問題,但是當我走到最后一步想點擊按鈕時,測驗在加載iframe后掛起。
    另外,是否有更...

    uj5u.com 2021-10-16 15:29:36 more
  • 如何復制HttpRequest

    PayPal提供了如何接收購買通知的示例代碼(或類似的)。遺憾的是,我沒有看到手動測驗的方法,我很難看到如何復制Microsoft.AspNetCore.Http HttpRequest。
    https://github.com/pay...

    uj5u.com 2021-10-16 15:29:15 more
  • 是否有適合測驗的WindowsActiveDirectory容器?

    我正在尋找一個像 openshift/openldap-2441-centos7 或 https://github.com/osixia/docker-openldap 的容器,它將運行一個 Windows 作業系統并具有一些合理的默認值。
    我想添...

    uj5u.com 2021-10-16 15:29:12 more
  • cypress上的invoke()方法如果呼叫兩次就不作業了

    我是Cypress的新手,我想用一個已經存在的網頁來實作一些簡單的測驗。我對結果有點困惑,因為我呼叫了兩次invoke():第一次是檢查初始值(0%),第二次是設定一個新的值并檢查變化,但是...

    uj5u.com 2021-10-16 15:29:08 more
  • 我如何測驗CriteriaBuidler查詢?

    如果我有一個需要測驗的方法,它依賴于用criticalBuilder和criticalQuery進行的查詢,我如何做到這一點? 我遇到的問題是,在測驗環境中的entityManager將是空的。模擬EntityManage...

    uj5u.com 2021-10-16 15:28:34 more
  • 從基類重寫通用方法

    我有一個類的繼承關系,定義如下: 我有一個類的繼承關系,定義如下: 我有一個類的繼承關系。
    class ClassA{}。

    class ClassB extends ClassA{}。

    class BaseClass{}。
    {
    pu...

    uj5u.com 2021-10-16 15:27:43 more
  • 為什么一個帶有常量通用布林值的方法不能呼叫一個對真和假都實作

    這段代碼完美地作業(playground):
    struct MyStruct<const B: bool> 。

    impl MyStruct<false> {
    pub fn bar() {
    println!("false") 。
    }
    }
    impl MyStruct<tru...

    uj5u.com 2021-10-16 15:26:44 more
  • Swift5-通過泛型分配相同型別的屬性值時出錯

    class SQS_Record {
    var table: SQS_Table? = nil?
    }

    class SQS_Table<RecordType: SQS_Record> {

    func newRecord() -> RecordType {
    let new = RecordType()...

    uj5u.com 2021-10-16 15:26:36 more