downloader.ctl

星子行主机控制系统用于主机管理,方便远程操作,通信等功能.更 方便用于局域网,管理速度快,连接简单方便.注意:星子行连接可用 于带路由主机与带路由主机之间连接,非路由与非路由之间连接.带

VERSION 5.00
Begin VB.UserControl Downloader 
   ClientHeight    =   990
   ClientLeft      =   0
   ClientTop       =   0
   ClientWidth     =   990
   ScaleHeight     =   990
   ScaleWidth      =   990
   Begin VB.Timer Timer1 
      Interval        =   500
      Left            =   0
      Top             =   2160
   End
   Begin VB.Image P1 
      Height          =   720
      Index           =   3
      Left            =   0
      Picture         =   "Downloader.ctx":0000
      Top             =   1920
      Width           =   720
   End
   Begin VB.Image P1 
      Height          =   720
      Index           =   2
      Left            =   0
      Picture         =   "Downloader.ctx":57E2
      Top             =   1920
      Width           =   720
   End
   Begin VB.Image P1 
      Height          =   480
      Index           =   1
      Left            =   120
      Picture         =   "Downloader.ctx":CCD4
      Top             =   2040
      Width           =   480
   End
   Begin VB.Image P1 
      Height          =   720
      Index           =   0
      Left            =   0
      Picture         =   "Downloader.ctx":127AE
      Top             =   1920
      Width           =   720
   End
End
Attribute VB_Name = "Downloader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit
Event DownloadProgress(CurBytes As Long, MaxBytes As Long, SaveFile As String)
Event DownloadError(SaveFile As String)
Event DownloadComplete(MaxBytes As Long, SaveFile As String)
Public downStat As Boolean


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

Private Sub Image2_Click(Index As Integer)

End Sub

Private Sub Timer1_Timer()

   If Not downStat Then
   Timer1.Enabled = False
   
 Exit Sub
 
 End If
 
 Static Cs As Integer
If Cs > 2 Then Cs = 0
 UserControl.Picture = P1(Cs).Picture
 Cs = Cs + 1
 DoEvents
 
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
  Else
    RaiseEvent DownloadError(AsyncProp.PropertyName)
  End If
  RaiseEvent DownloadComplete(CLng(AsyncProp.BytesMax), AsyncProp.PropertyName)
  downStat = False
  UserControl.Picture = P1(3).Picture
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)
    downStat = True: Timer1.Enabled = True
  End If
End Sub
'Private Sub UserControl_Resize()
' SizeIt
'End Sub

Public Sub BeginDownload(url As String, SaveFile As String)
  On Error GoTo ErrorBeginDownload
  downStat = True
  UserControl.AsyncRead url, vbAsyncTypeByteArray, SaveFile, vbAsyncReadForceUpdate
  Timer1.Enabled = True
  Exit Sub
ErrorBeginDownload:
  downStat = False
  MsgBox Err & "下载数据失败！" _
& vbCrLf & vbCrLf & "错误：" & Err.Description, vbCritical, "提示"
End Sub

'Public Sub SizeIt()
' On Error GoTo ErrorSizeIt
' With UserControl
' .Width = ScaleX(32, vbPixels, vbTwips)
' .Height = ScaleY(32, vbPixels, vbTwips)
' End With
' Exit Sub
'ErrorSizeIt:
'End Sub
'Public Sub kill()
' downStat = False
' Dim m As AsyncProperty
' MsgBox m.Value
'End Sub