VB调用迅雷开放下载组件异常！

2021-05-16 01:04:07 3.2k 阅读 AI 写同款 · GEO 优化AI 选题数据监测一键分发 ›
ccc598914010 ccc598914010 墨衍会员 · AI 创作全网分发 墨衍智能分发 通过墨衍一键同步至各平台 可同步平台 CSDN微信公众号微博知乎掘金百家号博客园抖音小红书 你的文章也可以这样分发 墨衍会员 ¥399起/年，写一次发全网 我也要 + 加入社区
Win10 22H2系统镜像迅雷下载与优化指南 操作系统镜像下载是系统部署的基础环节，其核心在于确保文件完整性与下载效率。P2SP技术通过整合P2P与服务器资源，显著提升大文件传输速度，这在Windows系统镜像等GB级文件下载中尤为关键。迅雷作为典型下载工具，其智能调度算法能自动选择最优节点，配合SHA1校验机制保障数据安全。实际应用中，通过调整并发任务数、优化磁盘缓存等参数，可使200M带宽下的下载速度提升近100%。本文以Win10 22H2为例，详解从微软官方获取ISO链接到迅雷17配置优化的全流程，包括开发者订阅直链提取、TCP连接监控等实用技 阅读详情
因为要下载程序，属于局域网，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
...全文
来，新手们，Internet Download Manager，艺术升华 这篇文章更新过后，我就准备回家过年了，你们好好的在整个春节慢慢研究。 我说过，技术的人总要有一些特例独行的思维产生，比如脑袋开始想起了一个技巧，爬虫。 爬啊爬啊，东西很多，有些地址我不好意思放出来，这个心里想想就好，但有人就是手痒，想把它Down下来当成犯罪证据。 下载工具Internet Download Manager（简称IDM）可以说是强大无比，当然你要拿BT种子，它是没辙就是了。 我们得做好公民应尽的职责，不要用BT去乱搞，人人影视网都被抓了，你还不老实，就因为BT太好用。 所以爬虫与I 阅读详情

相关推荐

调用迅雷下载vb6.0

调用迅雷下载,是用visual basic6.0编写的调用迅雷下载的例子。

Zhping_8109

VS2012迅雷下载地址

Visual Studio 2012 迅雷下载地址，官方原版镜像。新款黑色配色看着非常舒服。

Washington Hua

VB仿迅雷下载悬浮框

VB仿迅雷下载悬浮框 VB完美模拟迅雷透明下载悬浮框。

jiongjionger

VB调用迅雷API 全部攻略（不可用，你喷我）

1，VB调用迅雷API 函数全部攻略，带中文注解 2，详细的，可用的解决方案 3，比起网上的那些东西，一步到位的告诉你如何使用，并且保证可用 -------------------------------- 使用要求 1，必须安装压缩包里面的迅雷版本。 2，安装迅雷后，必须在"工具"-"配置"-"高级"-取消"通过IE右键菜单'使用迅雷下载'" 3，必须复制 迅雷DLL 文件目录下 DLL文件到 迅雷的ComDlls下，并且通过CMD进行注册 4，对的其10分，不解释！

keelding

迅雷专用下载链接URL转换解密的VB源代码.rar

关于迅雷专用链接的解密，烈火站长工具有此服务，今天再来介绍一下VB编写的小程序，用来实现迅雷下载地址URL转换及解密功能，大家知道吧，迅雷的下载地址是经过特殊处理的，我们平时是看不到的，使用这个小程序可看到迅雷真正的下载地址，其实本程序也没什么重要的用途，只不过是想学习一下字符处理方面的知识，同时也送给大家去研究。

weixin_39841848
评论 9
收藏 已收藏
分享
返回顶部
ccc598914010
ccc598914010
网络编程 1,502 成员 18,427 内容
+ 加入社区