downloader.ctl

这是网站里可以播放不同音乐的程序

VERSION 5.00
Object = "{5E9E78A0-531B-11CF-91F6-C2863C385E30}#1.0#0"; "MSFLXGRD.OCX"
Begin VB.UserControl Downloader 
   BackColor       =   &H00FF0000&
   ClientHeight    =   3930
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   4425
   ScaleHeight     =   3930
   ScaleWidth      =   4425
   Begin MSFlexGridLib.MSFlexGrid MSlabel 
      Height          =   3855
      Left            =   0
      TabIndex        =   0
      Top             =   0
      Width           =   4335
      _ExtentX        =   7646
      _ExtentY        =   6800
      _Version        =   393216
      Cols            =   4
      FixedCols       =   0
      BackColorFixed  =   -2147483643
      BackColorSel    =   15897020
      ForeColorSel    =   16777215
      BackColorBkg    =   16777215
      GridColor       =   16777215
      GridColorFixed  =   16777215
      FillStyle       =   1
      GridLines       =   0
      ScrollBars      =   2
      AllowUserResizing=   1
      FormatString    =   ""
   End
End
Attribute VB_Name = "Downloader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
'****************************************************************************
'人人为我，我为人人
'枕善居收藏整理
'发布日期：2007/09/07
'描    述：Jiac-Net网络MP3播放器 Ver 5.0
'网    站：http://www.Mndsoft.com/  (VB6源码博客)
'网    站：http://www.VbDnet.com/   (VB.NET源码博客,主要基于.NET2005)
'e-mail  ：[e-mail]
'e-mail  ：[e-mail]
'OICQ    ：88382850
'          如果您有新的好的代码别忘记给枕善居哦!
'****************************************************************************

Option Explicit
Dim a As Integer
Dim LoadError As Boolean
Dim asd, aaa As String
Event DownloadProgress(CurBytes As Long, MaxBytes As Long, SaveFile As String)
Event DownloadComplete(MaxBytes As Long, SaveFile As String, LoadError As Boolean)


Public Function CancelAsyncRead() As Boolean
  On Error Resume Next
  UserControl.CancelAsyncRead
End Function

Private Sub MSlabel_Click()
MSlabel.ToolTipText = MSlabel.Text
End Sub

Private Sub UserControl_AsyncReadComplete(AsyncProp As AsyncProperty)
  On Error Resume Next
  Dim f() As Byte, fn As Long
  If AsyncProp.BytesMax <> 0 Then
    fn = FreeFile
    f = AsyncProp.Value
    Open AsyncProp.PropertyName For Binary Access Write As #fn
   Put #fn, , f
    Close #fn
    LoadError = True
  Else
    LoadError = False
  End If
  RaiseEvent DownloadComplete(CLng(AsyncProp.BytesMax), AsyncProp.PropertyName, LoadError)
     For a = 0 To MSlabel.Rows - 1
         If MSlabel.TextMatrix(a, 0) = AsyncProp.PropertyName Then MSlabel.RemoveItem a: Exit For
     Next a
          MSlabel.Refresh
End Sub
Private Sub UserControl_AsyncReadProgress(AsyncProp As AsyncProperty)
  On Error Resume Next
   If AsyncProp.BytesMax > 0 Then
    RaiseEvent DownloadProgress(CLng(AsyncProp.BytesRead), CLng(AsyncProp.BytesMax), AsyncProp.PropertyName)
     For a = 0 To MSlabel.Rows - 1
      If MSlabel.TextMatrix(a, 0) = AsyncProp.PropertyName Then
         MSlabel.TextMatrix(a, 1) = AsyncProp.BytesRead \ 1000
         MSlabel.TextMatrix(a, 2) = AsyncProp.BytesMax \ 1000
      End If
     Next a
   End If
End Sub

Public Sub BeginDownload(url As String, SaveFile As String)
  On Error GoTo ErrorBeginDownload
  UserControl.AsyncRead url, vbAsyncTypeByteArray, SaveFile, vbAsyncReadForceUpdate
     For a = 0 To MSlabel.Rows - 1
         If MSlabel.TextMatrix(a, 0) = SaveFile Then Exit Sub
     Next a
     If MSlabel.TextMatrix(MSlabel.Rows - 1, 0) <> "" Then MSlabel.AddItem ""
     MSlabel.TextMatrix(MSlabel.Rows - 1, 0) = SaveFile
     MSlabel.TextMatrix(MSlabel.Rows - 1, 3) = url
     MSlabel.Refresh
 Exit Sub
ErrorBeginDownload:
    LoadError = False
         For a = 1 To MSlabel.Rows - 1
         If MSlabel.TextMatrix(a, 0) = SaveFile Then MSlabel.RemoveItem a: Exit For
     Next a
          MSlabel.Refresh
End Sub

Private Sub UserControl_Resize()
MSlabel.Top = 0
MSlabel.Left = 0
MSlabel.Height = UserControl.Height
MSlabel.Width = UserControl.Width
MSlabel.TextMatrix(0, 0) = "保存路径"
MSlabel.TextMatrix(0, 1) = "下载(KB)"
MSlabel.TextMatrix(0, 2) = "文件(KB)"
MSlabel.TextMatrix(0, 3) = "下载路径"
MSlabel.ColWidth(0) = 1350
MSlabel.ColWidth(1) = 800
MSlabel.ColWidth(2) = 800


End Sub