给爸妈下载评书写的程序,很卡!!新手求助
Private Declare Function URLDownloadToFile Lib "urlmon" Alias "URLDownloadToFileA" (ByVal pCaller As Long, ByVal szURL As String, ByVal szFileName As String, ByVal dwReserved As Long, ByVal lpfnCB As Long) As LongPrivate Const ERROR_SUCCESS As Long = 0
Private Const BINDF_GETNEWESTVERSION As Long = &H10
Private Const INTERNET_FLAG_RELOAD As Long = &H80000000
'-----------------------------------------------主程序---------------------------------------------------
'-----------------------------------------------Command1
Private Sub Command1_Click()
If bu = 0 Then bu = 1
La.Visible = True
TEX.Visible = False
Text2.Visible = False
If TEX.Text = "在此输入第一集下载页面网址" Then
MsgBox "请输入网址!"
TEX.Visible = True
Text2.Visible = True
Exit Sub
End If
If Text2.Text = "输入总章节数" Then
MsgBox "请输入要下载的集数"
TEX.Visible = True
Text2.Visible = True
Exit Sub
End If
La.Caption = "主程序执行中···" & Chr(13) & "正在尝试下载第一个···"
Timer2.Enabled = True
TEX.Visible = True
Text2.Visible = True
Cls
Print "下载成功!"
End Sub
'-----------------------------------------------Timer2_Timer()
Private Sub Timer2_Timer()
Static bu As Integer
Dim i As Integer
Static CuoWu As Integer
bu = bu + 1
i = bu - 1 + Val(Text1.Text)
Dim st As String
Dim XZDZ As String
Dim Fk As Integer
Dim Fj As Integer
If i > Val(Text2.Text) Then '退出
MsgBox "所有文件下载完成"
Timer2.Enabled = False
Exit Sub
End If
La.Caption = "主程序执行中···" & Chr(13) & "第" & bu & "个文件报告:" & Chr(13)
st = Trim(Str(i))
If i < 100 Then st = "0" & i
If i < 10 Then st = "0" & st
If YuanM(HC(TEX.Text, st)) Then '下载页面网页
La.Caption = La.Caption & "成功下载网页···" & Chr(13)
Else
i = i - 1
End If
XZDZ = Fenli() '分离文件下载地址
La.Caption = La.Caption & "分离出网址:" & XZDZ & Chr(13)
If XiaZai(XZDZ, , st) Then '下载文件
La.Caption = La.Caption & "文件下载成功保存为:" & st & Chr(13)
Else
CuoWu = CuoWu + 1
MsgBox "下载第" & st & " 个文件时出现错误,正重新下载此文件"
If CuoWu >= 3 Then Exit Sub
End If
End Sub
'-----------------------------------------------YuanM
Public Function YuanM(ByVal DZ As String) As Boolean
Dim strLa As String: strLa = La.Caption
YuanM = DownloadFile(DZ, "linshi.txt") '下载网页代码
End Function
Public Function Fenli() As String
Dim Db As String
FileNum = FreeFile
Open "linshi.txt" For Input As #FileNum '打开代码并查找下载地址
Do While Not EOF(1)
Line Input #1, Db
If InStr(Db, "下载方式一(网通下载") Then
Line Input #1, Db
Fk = InStr(Db, "http")
Fj = InStr(Fk, Db, Chr(34))
Fenli = Mid(Db, Fk, Fj - Fk)
Close #FileNum
Exit Do
End If
Loop
Kill "linshi.txt"
End Function
'-----------------------------------------------XiaZai
Public Function XiaZai(ByVal DZ As String, _
Optional ByVal FilePath As String = "d:\来风下载\", _
Optional ByVal FileName As String = "") _
As Boolean
If FileName = "" Then FileName = Right(DZ, 10)
FileName = FileName & ".mp3"
If DownloadFile(DZ, FilePath & FileName) = True Then
XiaZai = True
Else
XiaZai = False
End If
End Function
'-----------------------------------------------退出
Private Sub TC_Click()
End
End Sub
'-----------------------------------------------主程序---------------------------------END---------------
'-----------------------------------------------初始化及外观控制---------------------------------------------------
Private Sub form_load()
Command1.Enabled = False
TC.Enabled = False
TEX.Visible = False
TEX.Text = "在此输入第一集下载页面网址"
Text2.Visible = False
Text2.Text = "输入总章节数"
Text1.Visible = False
Text1.Text = "1起始章节(默认在第一集开始)"
With La
.Top = 200
.Left = 200
.Height = 3500
.Width = 10000 - 100
.Caption = ""
.Visible = False
End With
Me.Height = La.Height + 1200
Me.Width = La.Width + 1200
Timer1.Enabled = True
End Sub
Private Sub TEX_GotFocus()
TEX.Text = ""
End Sub
Private Sub TEX_LostFocus()
If Trim(TEX.Text) = "" Then TEX.Text = "在此输入第一集下载页面网址"
End Sub
Private Sub Text1_GotFocus()
If Text1.Text = "1起始章节(默认在第一集开始)" Then Text1.Text = ""
End Sub
Private Sub Text1_LostFocus()
If Trim(Text1.Text) = "" Then Text1.Text = "1起始章节(默认在第一集开始)"
End Sub
Private Sub Text2_GotFocus()
If Text2.Text = "输入总章节数" Then Text2.Text = ""
End Sub
Private Sub Text2_LostFocus()
If Trim(Text2.Text) = "" Then Text2.Text = "输入总章节数"
End Sub
Private Sub Timer1_Timer()
Static i As Integer
Static spa1 As String: Dim spa2 As String: Static spa3 As String
i = i + 1
If i <= 40 Then
Cls
n = 6 * (40 - i)
spa1 = spa1 + " >"
spa3 = spa3 + "< "
For k = 1 To n
spa2 = spa2 + " "
Next
Print " " & spa1 & spa2 & spa3
Else
Command1.Enabled = True
TC.Enabled = True
TEX.Visible = True
Text1.Visible = True
Text2.Visible = True
Timer1.Enabled = False
End If
End Sub
'-----------------------------------------------初始化及外观控制----------------------------------END--------------
'-----------------------------------------------自定义函数---------------------------------------------------
Public Function DownloadFile(sSourceUrl As String, _
sLocalFile As String) As Boolean
DownloadFile = URLDownloadToFile(0&, _
sSourceUrl, _
sLocalFile, _
BINDF_GETNEWESTVERSION, _
0&) = ERROR_SUCCESS
End Function
Public Function HC(ByVal DZ As String, ByVal k As String) As String
Dim QS As Integer
Dim QSa As Integer
Dim WJ As String
Dim TQQ As String
Dim TQH As String
For i = 1 To Len(DZ)
If Mid(TEX.Text, i, 1) = "/" Then QS = i + 1
Next
WJ = Mid(TEX.Text, QS)
For i = 1 To Len(WJ)
If Mid(WJ, i, 1) = "_" Then QSa = i
Next
HC = Mid(DZ, 1, QS + QSa - 1) & k & ".html"
End Function
'-----------------------------------------------自定义函数----------------------------------END--------------