| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 368 人关注过本帖
标题:给爸妈下载评书写的程序,很卡!!新手求助
只看楼主 加入收藏
来风
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2013-2-6
结帖率:0
收藏
 问题点数:0 回复次数:2 
给爸妈下载评书写的程序,很卡!!新手求助
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 Long
Private 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--------------
搜索更多相关主题的帖子: 主程序 
2013-02-16 21:48
zhengang1026
Rank: 6Rank: 6
等 级:侠之大者
威 望:1
帖 子:136
专家分:409
注 册:2013-2-6
收藏
得分:0 
同我一样,写得太乱、不规范,看起来也累。还是要养成规范写法,容易看明白,也好维护。
2013-02-16 23:17
来风
Rank: 1
等 级:新手上路
帖 子:6
专家分:0
注 册:2013-2-6
收藏
得分:0 
回复 2楼 zhengang1026
这还乱么。。
2013-02-18 13:37
快速回复:给爸妈下载评书写的程序,很卡!!新手求助
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.012603 second(s), 7 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved