[VB2010]HyperURLGetter─專門讀取網路資源的類別

現在網際網路十分發達,一個程式往往需要結合網路功能,可能會需要連上網路來檢查程式更新,也有可能需要從網路上下載某些檔案。先前本站便有提供  CheckNew Class Downloader Class 的程式碼,但二者的效能均不佳,常會造成視窗沒有回應。為此我又重新將它們改寫,並整合到HyperURLGetter Class上,應用領域十分廣泛,如不久前發佈的Wallpaper Downloader,主要就是使用HyperURLGetter來完成,給各位做個參考。

若不想依靠HyperURLGetter下載檔案,你可能會需要自行產生一個WebClient實體,且要帶有事件(Event),才可以及時得知網路狀況。我們要宣告一個WebClient的全域變數,宣告式如下:

Dim WithEvents Client As New Net.WebClient()

WebClient提供了DownloadFile和DownloadFileAsync方法讓使用者呼叫,只要傳入URL和儲存路徑,就可以進行下載。前者會鎖定執行緒,也就是當下載進行的時候程式會無法進行其它工作;後者不會鎖定執行緒,程式可以一邊下載一邊做其它的事。DownloadFileAsync的呼叫方法如下:

Client.DownloadFileAsync(New Uri("網址輸入在此"), "儲存路徑輸入在此")

如果要中斷下載,可以呼叫CancelAsync方法。呼叫方法如下:

Client.CancelAsync()

如果要取得目前的下載狀態,例如已下載的檔案大小或是進度百分比,需使用DownloadProgressChanged事件。當WebClient的進度改變時,就會觸發這個事件。使用方式如下:

Private Sub Client_DownloadProgressChanged(ByVal sender As Object, ByVal e As System.Net.DownloadProgressChangedEventArgs) Handles Client.DownloadProgressChanged '當Client正在下載時
'e.BytesReceived 取得已下載的檔案大小
'e.TotalBytesToReceive 取得總共要下載的檔案大小
'e.ProgressPercentage 取得目前的下載進度百分比(整數)
End Sub

當WebClient的下載進度完成時,會觸發DownloadFileCompleted事件。這時使用者要自行寫程式判斷下載結果是成功還是失敗。使用方式如下:

Private Sub Client_DownloadFileCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.AsyncCompletedEventArgs) Handles Client.DownloadFileCompleted '當Clien結束下載
'e.Cancelled 判斷是否為中斷(取消)下載
'e.Error '判斷下載過程是否因發生錯誤而停止下載
End Sub

使用WebClient來下載檔案還是會有諸多不便之處,因此我就寫了一個以WebClient和System.Windows.Forms為基礎的「HyperURLGetter」類別,專門用來讀取網路上的資源。程式碼如下,需要的人自行取用,可以依用途自行修改。

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
Public Class HyperURLGetter 'v1.3
    'HyperURLGetter能輕鬆以DownloadFileAsync的方式來取得網路上的資料
 
    '-------------------------------------------- 物件(Object) ------------------------------------------------
    Private WithEvents Client As New Net.WebClient()       '宣告Client為WebClient物件,且帶有「事件」
 
    '------------------------------------------- 常數文字(Literal) --------------------------------------------
    Private Const DEFAULT_NONE_NAMED_NAME As String = "it-easy.tw"                   '預設檔名
    Private IllegalChar() As String = {"", "/", ":", "*", "?", """", "|", "<", ">"} '不合法字元陣列(用字串型態)
    Private DATE_DAY As String = " 天 "          '天
    Private DATE_HOUR As String = " 小時 "       '小時
    Private DATE_MINUTE As String = " 分鐘 "     '分
    Private DATE_SECOND As String = " 秒"        '秒
    Private DATE_LINK As String = "又 "          '又
 
    '-------------------------------------------- 事件(Event) ------------------------------------------------
    Public Event ProgressLoading()     '讀取中數值有變化時
    Public Event ProgressCompleted()   '讀取完畢時
    Public Event ProgressTimeout()     '讀取逾時
    Public Event ProgressOverWrite()   '存放檔案時發生需覆蓋檔案的狀況
 
    '----------------------------------------- 資料成員(DATA MEMBER) -----------------------------------------
    Private sSaveFileName As String = DEFAULT_NONE_NAMED_NAME      '儲存檔案存放的檔名(預先設定檔案名稱)
    Private sSaveFolderPath As String = GetMyFolderPath()          '儲存檔案存放的資料夾路徑(預先設定資料夾路徑)
    Private sTargetURL As String                                   '儲存讀取的目標網址
 
    Private lBytesReceived As Long                                 '儲存已讀取的檔案大小
    Private lTotalBytesToReceive As Long                           '儲存總共要讀取的檔案大小
    Private lStartTime As Long                                     '儲存開始讀取的時間
    Private lEndTime As Long                                       '儲存結束讀取的時間
 
    Private sTextCode As String = "UTF-8"                          '儲存預設編碼為「UTF-8」
 
    Private bAlreadyTimeOut As Boolean                             '儲存是否已經逾時
    Private lTimeOut As Long = 5000                                '儲存讀取逾時的最小值(單位毫秒),預設為5000毫秒
 
    Private lBytesEverySecond As Long                              '儲存一秒內所傳的位元組數
    Private lTempTime As Long                                      '暫存已用時間
    Private lTempBytesReceived As Long                             '暫存已讀取檔案大小
 
    Private bAutoOverWrite As Boolean = True                       '儲存是否自動覆蓋已存在的檔案(預設為True)
 
    Private nStatus As Short = -2                                  '儲存讀取狀態。如果傳回-2,代表尚未開始讀取。傳回-1,代表讀取正在進行中。傳回0,代表讀取失敗。傳回1,代表讀取成功。傳回2,代表中斷讀取。傳回3,代表取得資料與特徵不符。
 
    '-------------------------------------------- 屬性(PROPERTY) ---------------------------------------------
    Public Property AutoOverWrite() As Boolean  '取得或設定是否自動覆蓋已存在的檔案
        Set(ByVal InputAutoOverWrite As Boolean)
            If nStatus <> -1 Then '若不為讀取狀態
                bAutoOverWrite = InputAutoOverWrite '設定是否自動覆蓋已存在的檔案
            Else '若為讀取狀態
                Debug.Print([GetType].Name & ":讀取中,無法設定覆寫!")
            End If
        End Set
 
        Get
            Return bAutoOverWrite '取得是否自動覆蓋已存在的檔案
        End Get
    End Property
 
    Public Property TextCode() As String '取得或設定編碼方式
        Set(ByVal InputTextCode As String)
            If nStatus <> -1 Then '若不為讀取狀態
                sTextCode = InputTextCode '設定編碼
            End If
        End Set
 
        Get
            Return sTextCode '取得編碼
        End Get
    End Property
 
    Public Property SaveFileName() As String '取得或設定檔案存放的檔名
        Set(ByVal InputSaveFileName As String)
            If nStatus <> -1 Then '若不為讀取狀態
 
                '自動處理可能會發生的錯誤
                For Each CheckChars As String In IllegalChar '用For Each迴圈取得IllegalChar中的所有元素
                    If InStr(InputSaveFileName, CheckChars) > 0 Then '若有找到非法字元
                        Debug.Print([GetType].Name & ":輸入檔名含有非法字元!本次設定將無效。")
                        Exit Property '取消設定
                    End If
                Next
                If InputSaveFileName = "" Then '若根本沒輸入檔名
                    Debug.Print([GetType].Name & ":未輸入檔名!本次設定將無效。")
                    Exit Property '取消設定
                End If
 
                nStatus = -2 '狀態初始為尚未讀取
                sSaveFileName = InputSaveFileName '設定檔名
            Else '若為讀取狀態
                Debug.Print([GetType].Name & ":讀取中,無法更變檔名!")
            End If
        End Set
 
        Get
            Return sSaveFileName '取得檔案名稱
        End Get
    End Property
 
    Public Property SaveFolderPath() As String '取得或設定檔案存放的資料夾路徑(無法自動建立資料夾)。若指定值有誤,會自動以原本設定的路徑來做設定。
        Set(ByVal InputSaveFolderPath As String)
            If nStatus <> -1 Then '若不為讀取狀態
 
                '自動處理可能會發生的錯誤
                For Each CheckChars As String In IllegalChar '用For Each迴圈取得IllegalChar中的所有元素
                    If CheckChars = IllegalChar(0) OrElse (InStr(InputSaveFolderPath, CheckChars) = 2 AndAlso CheckChars = IllegalChar(2)) Then '若有資料夾的分隔字符(反斜線),或是磁碟機代號(冒號)
                        Continue For  '跳過下面敘述繼續執行程式
                    End If
                    If InStr(InputSaveFolderPath, CheckChars) > 0 Then '若有找到非法字元
                        Debug.Print([GetType].Name & ":輸入路徑含有非法字元!本次設定將無效。")
                        Exit Property '取消設定
                    End If
                Next
                If InputSaveFolderPath = "" Then '若根本沒輸入路徑
                    Debug.Print([GetType].Name & ":未輸入路徑!本次設定將無效。")
                    Exit Property '取消設定
                End If
 
                nStatus = -2 '狀態初始為尚未讀取
                sSaveFolderPath = CorrectFolderPath(InputSaveFolderPath) '修正並設定路徑
            Else '若為讀取狀態
                Debug.Print([GetType].Name & ":讀取中,無法更變路徑!")
            End If
        End Set
 
        Get
            Return sSaveFolderPath '取得路徑名稱
        End Get
    End Property
 
    Public Property SaveFullPath() As String '取得或設定檔案存放的完整路徑(無法自動建立資料夾)。若指定值有誤,會自動以原本設定的路徑和預設檔名做設定。
        Set(ByVal InputSaveFullPath As String)
            If nStatus <> -1 Then '若不為讀取狀態
                Dim DividePath() As String = Strings.Split(InputSaveFullPath, IllegalChar(0)) '分割路徑
                If DividePath.Count > 0 Then '若有一個以上的反斜線
                    Dim FolderPathBuffer As String = Strings.Replace(InputSaveFullPath, DividePath(DividePath.Count - 1), "") '將檔名取代為空字串
                    Me.SaveFolderPath = FolderPathBuffer '設定資料夾路徑
                    Me.SaveFileName = DividePath(DividePath.Count - 1) '設定檔案名稱
                Else '格式有誤
                    Debug.Print([GetType].Name & ":檔案完整路徑格式有誤!本次設定將無效。")
                    Exit Property '取消設定
                End If
            Else '若為讀取狀態
                Debug.Print([GetType].Name & ":讀取中,無法更變路徑!")
            End If
        End Set
 
        Get
            Return Me.SaveFolderPath & Me.SaveFileName '取得路徑名稱
        End Get
    End Property
 
    Public Property TargetURL() As String '取得或設定讀取的目標網址
        Set(ByVal InputTargetURL As String)
            If nStatus <> -1 Then '若不為讀取狀態
                sTargetURL = InputTargetURL '設定網址
            End If
        End Set
 
        Get
            Return sTargetURL '取得網址
        End Get
    End Property
 
    Public Property Timeout() As Long '取得或設定逾時判斷時間
        Set(ByVal InputTimeout As Long)
            If nStatus <> -1 Then '若不為讀取狀態
                lTimeOut = InputTimeout '設定時間
            End If
        End Set
 
        Get
            Return lTimeOut '取得逾時時間
        End Get
    End Property
 
    '------------------------------------------ 建構子(CONSTRUCTOR) ------------------------------------------
    Public Sub New() '無參數,無初始。
    End Sub
 
    Public Sub New(ByVal InputTargetURL As String) 'InputTargetURL用來載入要讀取資訊的目標網址。
        Me.TargetURL = InputTargetURL '設定網址
    End Sub
 
    Public Sub New(ByVal InputTargetURL As String, ByVal InputSaveFileName As String) 'InputTargetURL用來載入要讀取資訊的目標網址。InputSaveFileName用來載入要初始的檔案名稱。
        Me.TargetURL = InputTargetURL '設定網址
        Me.SaveFileName = InputSaveFileName
    End Sub
 
    Public Sub New(ByVal InputTargetURL As String, ByVal InputSaveFolderPath As String, ByVal InputSaveFileName As String) 'InputTargetURL用來載入要讀取資訊的目標網址。InputSaveFileName用來載入要初始的檔案名稱。
        Me.TargetURL = InputTargetURL '設定網址
        Me.SaveFolderPath = InputSaveFolderPath '設定路徑
        Me.SaveFileName = InputSaveFileName '設定檔名
    End Sub
 
    '-------------------------------------------- 函式(FUNCTION) ---------------------------------------------
    Public Function CheckLoading() As Boolean '檢查HyperURLGetter是否正在讀取中
        If nStatus = -1 Then '若正在讀取
            Return True  '傳回True布林值
        Else
            Return False '傳回False布林值
        End If
    End Function
 
    Public Function ChoseFolderPath(Optional ByVal OrginalFolder As String = "") As String '開啟FolderBrowserDialog,讓使用者選取資料夾。通常和SaveFolderPath合用。OrginalFolder可讓使用者預設FolderBrowserDialog一開始顯示的目錄
        Dim FBD As New FolderBrowserDialog
        If OrginalFolder <> "" AndAlso IO.Directory.Exists(OrginalFolder) = True Then '若有輸入值,且目標路徑存在
            FBD.SelectedPath = OrginalFolder '設定FBD的根資料夾
        End If
        FBD.ShowDialog() '顯示資料夾選取視窗方塊
 
        Dim FolderPath As String = FBD.SelectedPath '取得選取路徑
        If FolderPath = "" Then '如果沒有選擇路徑
            FolderPath = Me.SaveFolderPath '等於目前的資料夾路徑設定值
        End If
 
        Return Me.CorrectFolderPath(FolderPath)
    End Function
 
    Public Function ChoseFullPath(Optional ByVal OrginalFolder As String = "") As String '開啟FolderBrowserDialog,讓使用者選取資料夾。通常和SaveFolderPath合用。OrginalFolder可讓使用者預設FolderBrowserDialog一開始顯示的目錄
        Dim SFD As New SaveFileDialog
        If OrginalFolder <> "" AndAlso IO.Directory.Exists(OrginalFolder) = True Then '若有輸入值,且目標路徑存在
            SFD.InitialDirectory = OrginalFolder '設定FBD的根資料夾
        End If
 
        SFD.FileName = Me.SaveFileName '暫時預設檔名在文字方塊內
        SFD.ShowDialog() '顯示檔案儲存路徑方塊
 
        Dim FullPath As String = SFD.FileName '取得選取路徑
        If FullPath = "" OrElse FullPath = Me.SaveFileName Then '如果沒有選擇路徑或是按下取消
            FullPath = Me.SaveFullPath  '不改變
        End If
 
        Return FullPath
    End Function
 
    Public Function CreateFolder(ByVal FolderPath As String) As Boolean '傳入資料夾路徑,如果路徑不存在就自動建立資料夾。若有建立成功則傳回True;失敗則傳回False。
        If IO.Directory.Exists(FolderPath) = False Then '若資料夾路徑不存在
            On Error Resume Next '如果遇到錯誤繼續執行
            IO.Directory.CreateDirectory(FolderPath) '建立資料夾
        End If
 
        Return IO.Directory.Exists(FolderPath) '建立完後若資料夾存在則傳回True;否則傳回False
    End Function
 
    Public Function FormatBytes(ByVal InputBytes As Long, ByVal DecimalCount As Integer) As String '傳入要格式化的位元組數字和小數位數,傳回以TB、GB、MB、KB、B為單位的字串。算是一種自動化設定。
        '從PB開始判斷到B
        Dim Unit As String '單位
        If InputBytes > Math.Pow(2, 50) Then '若大於1PB,則以PB顯示
            Unit = "PB"
        ElseIf InputBytes > Math.Pow(2, 40) Then '若大於1TB,則以TB顯示
            Unit = "TB"
        ElseIf InputBytes > Math.Pow(2, 30) Then '若大於1GB,則以GB顯示
            Unit = "GB"
        ElseIf InputBytes > Math.Pow(2, 20) Then '若大於1MB,則以MB顯示
            Unit = "MB"
        ElseIf InputBytes > Math.Pow(2, 10) Then '若大於1KB,則以KB顯示
            Unit = "KB"
        ElseIf InputBytes >= 0 Then '若大於0B,則以B顯示
            Unit = "Bytes"
        Else
            Unit = " -Error-"
        End If
        Return TransformBytes(InputBytes, DecimalCount, Unit) & " " & Unit
    End Function
 
    Public Function FormatBytes(ByVal InputBytes As Long, ByVal DecimalCount As Integer, ByVal FormatUnit As String) As String '傳入要格式化的位元組數字、小數位數和指定單位(String型態),傳回以TB、GB、MB、KB、B為單位的字串。直接以指定的單位進行字串格式化。
        Return TransformBytes(InputBytes, DecimalCount, FormatUnit) & " " & FormatUnit
    End Function
 
    Public Function FormatTime(ByVal TimeGap As Long) As String '轉換時間格式
        Dim iDay As Integer, iHour As Integer, iMinute As Integer, iSecond As Integer
        TimeGap = TimeGap / 1000 '毫秒轉換成秒
        '天
        While TimeGap >= 86400
            iDay += 1
            TimeGap -= 86400
        End While
 
        '時
        While TimeGap >= 3600
            iHour += 1
            TimeGap -= 3600
        End While
 
        '分
        While TimeGap >= 60
            iMinute += 1
            TimeGap -= 60
        End While
 
        '秒
        iSecond = TimeGap
 
        If iDay > 0 Then
            Return iDay & DATE_DAY & DATE_LINK & iHour & DATE_HOUR & iMinute & DATE_MINUTE & iSecond & DATE_SECOND
        ElseIf iHour > 0 Then
            Return iHour & DATE_HOUR & DATE_LINK & iMinute & DATE_MINUTE & iSecond & DATE_SECOND
        ElseIf iMinute > 0 Then
            Return iMinute & DATE_MINUTE & DATE_LINK & iSecond & DATE_SECOND
        ElseIf iSecond >= 0 Then
            Return iSecond & DATE_SECOND
        Else
            Return ""
        End If
    End Function
 
    Public Function GetAverageEverySecondSpead() As Long '取得平均每秒所傳送的位元組數。
        If Math.Abs(nStatus) = 1 AndAlso Me.GetLoadingTime > 0 Then '如果正在讀取,或讀取完成,且讀取時間大於0
            Return Me.GetBytesReceived / (Me.GetLoadingTime() / 1000) '傳回接收大小(位元組)除已用時間(秒)的值
        Else
            Return 0
        End If
    End Function
 
    Public Function GetAverageLastTime() As Long '取得預估的平均剩餘時間。
        If nStatus = -1 AndAlso Me.GetAverageEverySecondSpead > 0 Then '如果正在讀取,且平均每秒傳送的位元組數大於0
            Return (Me.GetLastBytes  Me.GetAverageEverySecondSpead) * 1000 '剩餘大小/平均速率=平均剩餘時間,再乘1000轉成毫秒
        Else
            Return 0
        End If
    End Function
 
    Public Function GetBytesReceived() As Long '取得已讀取的檔案大小(單位:位元組Byte)。
        If Math.Abs(nStatus) = 1 Then '如果正在讀取或是讀取完成
            Return lBytesReceived
        Else
            Return 0
        End If
    End Function
 
    Public Function GetDoubleProgressPercentage(ByVal DecimalCount As Integer) As Double '取得目前的讀取進度百分比(浮點數),傳入小數位數
        If nStatus = -1 AndAlso Me.GetTotalBytesToReceive > 0 Then '如果正在讀取,且有取得讀取總大小
            Return Math.Round((Me.GetBytesReceived / Me.GetTotalBytesToReceive) * 100, DecimalCount) '傳回進度百分比值
        ElseIf nStatus = 1 Then '如果讀取完成
            Return 100 '直接傳回100
        Else
            Return 0
        End If
    End Function
 
    Public Function GetEverySecondSpead() As Long '取得每秒所傳送的位元組數
        If nStatus = -1 Then '如果正在讀取
            Return lBytesEverySecond '傳回每秒傳送的位元組數
        ElseIf nStatus = 1 AndAlso Me.GetLoadedTime() > 0 Then '如果成功讀取完成,且讀取時間大於0
            Return Me.GetTotalBytesToReceive / (Me.GetLoadedTime() / 1000) '直接傳回總大小(位元組)除時間(秒)的值
        Else
            Return 0
        End If
    End Function
 
    Public Function GetLastBytes() As Long '取得剩餘的位元組數
        If nStatus = -1 Then '如果正在讀取
            Return Me.GetTotalBytesToReceive - Me.GetBytesReceived '傳回總大小減掉已讀取大小的值
        Else
            Return 0
        End If
    End Function
 
    Public Function GetLastTime() As Long '取得預估的剩餘時間
        If nStatus = -1 AndAlso Me.GetEverySecondSpead > 0 Then '如果正在讀取,且每秒位元組數大於零
            Return (Me.GetLastBytes  Me.GetEverySecondSpead) * 1000 '剩餘大小/速率=剩餘時間,再乘1000轉成毫秒
        Else
            Return 0
        End If
    End Function
 
    Public Function GetLoadedTime() As Long '取得從開始讀取到讀取完成的所用時間。
        If nStatus = 1 Then '如果成功讀取
            Return lEndTime - lStartTime '傳回結束時間減掉開始時間
        Else
            Return 0
        End If
    End Function
 
    Public Function GetLoadingTime() As Long '取得讀取的已用時間
        If nStatus = -1 Then '如果正在讀取
            Return Environment.TickCount - lStartTime '傳回目前時間減掉開始時間
        ElseIf nStatus = 1 Then '如果成功讀取完成
            Return Me.GetLoadedTime '傳回從開始讀取到讀取完成的所用時間。
        Else
            Return 0
        End If
    End Function
 
    Public Function GetProgressPercentage() As Integer '取得目前的讀取進度百分比(整數)
        If Math.Abs(nStatus) = 1 Then '如果正在讀取或是讀取完成
            Return Int(Me.GetDoubleProgressPercentage(0)) '傳回四捨五入到整數的讀取進度百分比
        Else
            Return 0
        End If
    End Function
 
    Public Function GetStatus() As Short '傳回讀取器的狀態。如果傳回-2,代表尚未開始讀取;傳回-1,代表讀取正在進行中;傳回0,代表讀取失敗。傳回1;代表讀取成功。傳回2,代表中斷讀取。可用Select Case來擷取數值。
        Return nStatus '傳回短整數
    End Function
 
    Public Function GetMyFolderPath() As String '取得程式本身所在的資料夾路徑(不包括檔名)。
        Return CorrectFolderPath(Application.StartupPath) '傳回程式本身的資料夾路徑
    End Function
 
    Public Function GetMyVersion() As String '取得程式的版本號碼(格式:X.X.X)
        Return My.Application.Info.Version.Major & "." & My.Application.Info.Version.Minor & "." & My.Application.Info.Version.Build '取得版本號碼
    End Function
 
    Public Function GetTotalBytesToReceive() As Long '取得總共要讀取的檔案大小
        If Math.Abs(nStatus) = 1 Then '如果正在讀取或是讀取完成
            Return lTotalBytesToReceive
        Else
            Return 0
        End If
    End Function
 
    Public Function HyperURLText(Optional ByVal InfoFeature As String = "") As String '以純文字字串的方式傳回讀取到的資訊。可以傳入特徵判斷特徵是否相同。
        On Error Resume Next '如果遇到錯誤繼續執行
        If nStatus = 1 AndAlso IO.File.Exists(Me.SaveFullPath) Then '如果讀取成功
            '讀入檔案
            Dim Encode As System.Text.Encoding = System.Text.Encoding.GetEncoding(Me.TextCode) '設定編碼
            Dim URLText As String = IO.File.ReadAllText(Me.SaveFullPath, Encode)
 
            '判斷特徵
            If InfoFeature <> "" Then '若需要判斷特徵
                If InStr(URLText, InfoFeature) > 0 Then '若有找到特徵
                    Debug.Print([GetType].Name & "讀取成功!特徵符合!")
                Else
                    nStatus = 3 '讀取成功,但特徵不符
                    Debug.Print([GetType].Name & "讀取成功,但特徵不符。")
                End If
            End If
 
            Return URLText '傳回檔案內的文字
        Else
            Return "" '傳回空字串
        End If
    End Function
 
    Public Function StringPart(ByVal IntactString As String, ByVal LeftText As String, ByVal RightText As String, ByVal IncludeLeftText As Boolean, ByVal IncludeRightText As Boolean) As String '取得字串的某個部分
        Dim LeftPosition As Long, RightPosition As Long
        RightPosition = InStr(IntactString, RightText)
        If RightPosition <= 0 Then '未找到
            Debug.Print([GetType].Name & "找不到右特徵。")
            Return ""
        End If
        LeftPosition = InStrRev(IntactString, LeftText, RightPosition)
        If LeftPosition <= 0 Then '未找到
            Debug.Print([GetType].Name & "找不到左特徵。")
            Return ""
        End If
        If IncludeLeftText = False Then
            LeftPosition += Strings.Len(LeftText)
        End If
        If IncludeRightText = True Then
            RightPosition += Strings.Len(RightText)
        End If
        Return Strings.Mid(IntactString, LeftPosition, RightPosition - LeftPosition)
    End Function
 
    Public Function TransformBytes(ByVal InputBytes As Long, ByVal DecimalCount As Integer, ByVal FormatUnit As String) As Double '傳入要格式化的位元組數字、小數位數和指定單位,轉換位元組Byte為浮點數格式。
        FormatUnit = Strings.UCase(FormatUnit) '轉成大寫來判斷
        If Strings.Right(FormatUnit, 1) <> "B" Then '若結尾不是B
            FormatUnit = FormatUnit & "B" '加B
        End If
 
        Dim Divisor As Long '除數
        Select Case FormatUnit '選擇判斷
            Case "PB"
                Divisor = Math.Pow(2, 50)
            Case "TB"
                Divisor = Math.Pow(2, 40)
            Case "GB"
                Divisor = Math.Pow(2, 30)
            Case "MB"
                Divisor = Math.Pow(2, 20)
            Case "KB"
                Divisor = Math.Pow(2, 10)
            Case "B", "BYTEB", "BYTESB", "位元組B", "個位元組B"
                Divisor = 1
            Case Else
                Return 0
        End Select
 
        Return Math.Round(InputBytes / Divisor, DecimalCount) '傳回運算值
    End Function
 
    '---------------------------------------------- 副程式(SUB) ----------------------------------------------
    Public Sub CreateSaveFileName() '置入網址(TargetURL)中提供的檔名(如果存在)
        Dim DivideURL() As String = Strings.Split(Me.TargetURL, "/") '以斜線分割網址
        If Strings.InStrRev(DivideURL(DivideURL.Count - 1), ".") > 0 Then '網址最後一段的字串中倒數搜尋是否有副檔名專用的「.」,若有則作為檔名。
            Me.SaveFileName = DivideURL(DivideURL.Count - 1)
        Else '若沒有則用預設名稱
            Me.SaveFileName = DEFAULT_NONE_NAMED_NAME
        End If
    End Sub
 
    Public Sub KillFile() '刪除路徑SaveFullPath所指的檔案實體。
        On Error Resume Next '如果遇到錯誤繼續執行
        If IO.File.Exists(Me.SaveFullPath) Then '如果目標路徑的檔案存在
            IO.File.Delete(Me.SaveFullPath)
            If IO.File.Exists(Me.SaveFullPath) Then
                Debug.Print([GetType].Name & ":檔案存在!但無法刪除。{0}", Me.SaveFullPath)
            Else
                Debug.Print([GetType].Name & ":檔案已刪除。{0}", Me.SaveFullPath)
            End If
        Else
            Debug.Print([GetType].Name & ":檔案不存在!無法刪除!{0}", Me.SaveFullPath)
        End If
    End Sub
 
    Public Sub OpenFile() '開啟路徑SaveFullPath所指的檔案實體。
        On Error Resume Next '如果遇到錯誤繼續執行
        If IO.File.Exists(Me.SaveFullPath) Then '如果目標路徑的檔案存在
            Process.Start(Me.SaveFullPath)
            Debug.Print([GetType].Name & ":檔案存在!已執行!{0}", Me.SaveFullPath)
        Else
            Debug.Print([GetType].Name & ":檔案不存在!無法執行!{0}", Me.SaveFullPath)
        End If
    End Sub
 
    Public Sub OpenFolder() '開啟SaveFolderPath資料夾。
        On Error Resume Next '如果遇到錯誤繼續執行
        If IO.Directory.Exists(Me.SaveFolderPath) Then '如果目標路徑的檔案存在
            Process.Start(Me.SaveFolderPath)
            Debug.Print([GetType].Name & ":資料夾存在!已開啟!{0}", Me.SaveFolderPath)
        Else
            Debug.Print([GetType].Name & ":資料夾不存在!無法開啟!{0}", Me.SaveFolderPath)
        End If
    End Sub
 
    Public Sub RunWorkerAsync() '一切就緒後,使用此Sub可以呼叫DownloadFileAsync開始進行讀取程序。不會占用主執行緒的資源
        On Error Resume Next '如果遇到錯誤繼續執行
        If Me.CheckLoading = False Then '若目前沒有正在讀取
            If IO.File.Exists(Me.SaveFullPath) Then '如果目標路徑的檔案已存在
                Debug.Print([GetType].Name & ":目標檔案已存在!{0}", Me.SaveFullPath)
                If Me.AutoOverWrite = True Then '若有開啟自動覆蓋檔案功能
                    Me.KillFile() '直接刪除之
                Else '若未開啟自動覆蓋檔案功能
                    RaiseEvent ProgressOverWrite() '觸發覆寫檔案事件
                    Exit Sub '結束程序
                End If
            End If
 
            Debug.Print([GetType].Name & ":正在從「{0}」讀取資料...", Me.TargetURL)
            Application.DoEvents() '讓執行緒休息一下
            Client.DownloadFileAsync(New Uri(TargetURL), Me.SaveFullPath) '開始讀取,且不占用主執行緒
 
            '初始化變數
            lBytesReceived = 0 '已讀取的檔案大小,歸零
            lTempBytesReceived = 0 '暫存讀取的檔案大小,歸零
            lTotalBytesToReceive = 0 '總共要讀取的檔案大小,歸零
            lStartTime = Environment.TickCount '取得開始時間
            lTempTime = lStartTime '暫存開始時間
            lEndTime = 0 '結束讀取的時間,歸零
            lBytesEverySecond = 0 '一秒內所傳的位元組數,歸零
            nStatus = -1 '正在讀取
            bAlreadyTimeOut = False '尚未逾時
 
        Else '若目前已經正在讀取
            Debug.Print([GetType].Name & ":已經在讀取狀態,無法再重複執行!")
        End If
    End Sub
 
    Public Sub SetHeaders(ByVal Browser As String) '設定瀏覽器的HTTP headers。直接傳入要模擬的瀏覽器名稱。若傳入空字串,則改為預設值。
        If Me.CheckLoading = False Then '若目前沒有正在讀取
            Select Case Strings.UCase(Browser) '只以英文大寫判斷
                Case "" '空字串
                    Client.Headers.Clear() '清空Headers
                Case "GOOGLE", "CHROME", "GOOGLE瀏覽器", "GOOGLE 瀏覽器", "GOOGLE CHROME" 'Google 瀏覽器
                    Client.Headers.Clear() '清空Headers
                    Client.Headers.Add("User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64) AppleWebKit/535.2 (KHTML, like Gecko) Chrome/15.0.874.121 Safari/535.2")
                    Client.Headers.Add("Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
                    Client.Headers.Add("Accept-Encoding", "gzip,deflate,sdch")
                    Client.Headers.Add("Accept-Language", "zh-TW,zh;q=0.8,en-US;q=0.6,en;q=0.4")
                    Client.Headers.Add("Accept-Charset", "Big5,utf-8;q=0.7,*;q=0.3")
                Case "FIREFOX", "火狐" '火狐
                    Client.Headers.Clear() '清空Headers
                    Client.Headers.Add("User-Agent", "Mozilla/5.0 (Windows NT 6.1; WOW64; rv:8.0.1) Gecko/20100101 Firefox/8.0.1")
                    Client.Headers.Add("Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8")
                    Client.Headers.Add("Accept-Language", "zh-tw,en-us;q=0.7,en;q=0.3")
                    Client.Headers.Add("Accept-Encoding", "gzip, deflate")
                    Client.Headers.Add("Accept-Charset", "UTF-8,*")
                Case "IE", "INTERNET EXPLORER" '微軟IE
                    Client.Headers.Clear() '清空Headers
                    Client.Headers.Add("User-Agent", "Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; WOW64; Trident/5.0)")
                    Client.Headers.Add("Accept-Encoding", "gzip, deflate")
                Case Else '若均不是
                    Debug.Print([GetType].Name & ":HTTP Headers傳入值有誤!")
            End Select
        Else
            Debug.Print([GetType].Name & ":讀取中,無法進行HTTP Headers設定!")
        End If
    End Sub
 
    Public Sub SetTimeFormat(ByVal DayString As String, ByVal HourString As String, ByVal MinuteString As String, ByVal SecondString As String) '設定時間格式。傳入「天、小時、分鐘、秒」的顯示字串
        DATE_DAY = DayString
        DATE_HOUR = HourString
        DATE_MINUTE = MinuteString
        DATE_SECOND = SecondString
    End Sub
 
    Public Sub StopRunning() '停止讀取程序
        If nStatus = -1 Then '如果目前是正在讀取的狀態
            nStatus = 2 '中止讀取
            Client.CancelAsync() '中斷讀取
            Debug.Print([GetType].Name & ":中止讀取!")
        Else '如果目前不是正在讀取的狀態
            Debug.Print([GetType].Name & ":並非在讀取狀態,無可中止!")
        End If
    End Sub
 
    '------------------------------------------- 私有成員(PRIVATE) -------------------------------------------
    Private Function CorrectFolderPath(ByVal InputFolderPath As String) As String '更正資料夾路徑格式。(無反斜線加反斜線)
        If Strings.Right(InputFolderPath, 1) <> "" Then '判斷最後一個字元是否為"",若不是,則添加上去
            InputFolderPath = InputFolderPath & ""
        End If
        Return InputFolderPath
    End Function
 
    '---------------------------------------- 實作事件(Implement Event) --------------------------------------
    Private Sub Client_ProgressLoading(ByVal sender As Object, ByVal e As System.Net.DownloadProgressChangedEventArgs) Handles Client.DownloadProgressChanged '當Client正在讀取資料時
        On Error Resume Next '如果遇到錯誤繼續執行
 
        Dim dTime As Long = Environment.TickCount - lTempTime '取得時間差
        If dTime > 0 AndAlso e.BytesReceived > lTempBytesReceived Then '若時間差大於0,且得到的位元組數也大於暫存值
            lBytesEverySecond = (e.BytesReceived - lTempBytesReceived) / (dTime / 1000) '取得每秒所得到的位元組數
            lTempBytesReceived = e.BytesReceived '將暫存的已下載檔案大小為目前已下載檔案大小
            lTempTime = Environment.TickCount '將暫存時間於現在時間
        End If
        lBytesReceived = e.BytesReceived '儲存已下載的檔案大小
        lTotalBytesToReceive = e.TotalBytesToReceive '儲存總共要下載的檔案大小
 
        '解決有可能會發生的小於零錯誤
        If lBytesReceived < 0 Then lBytesReceived = 0
        If lTotalBytesToReceive < 0 Then
            If lBytesReceived > 0 Then
                lTotalBytesToReceive = lBytesReceived
            Else
                lTotalBytesToReceive = 1
            End If
        End If
 
        Debug.Print("已收到/總共:{0}/{1} 完成進度:{2}% 已使用:{3} 速度:{4}/s", Me.FormatBytes(Me.GetBytesReceived, 2), Me.FormatBytes(Me.GetTotalBytesToReceive, 2), Me.GetDoubleProgressPercentage(2), Me.FormatTime(Me.GetLoadingTime), Me.FormatBytes(Me.GetEverySecondSpead, 2))
 
        Application.DoEvents() '讓執行緒休息一下
        If bAlreadyTimeOut = False AndAlso Me.GetLoadingTime > lTimeOut Then '如果執行時間已逾時
            bAlreadyTimeOut = True '讓HyperURLGetter這個程序已經逾時!
            RaiseEvent ProgressTimeout() '觸發逾時事件
        End If
 
        RaiseEvent ProgressLoading() '觸發正在讀取事件
    End Sub
 
    Private Sub Client_ProgressCompleted(ByVal sender As Object, ByVal e As System.ComponentModel.AsyncCompletedEventArgs) Handles Client.DownloadFileCompleted  '當Clien結束讀取
        On Error Resume Next '如果遇到錯誤繼續執行
        Debug.Print(Me.SaveFullPath)
        If nStatus = -1 Then
            If IO.File.Exists(Me.SaveFullPath) AndAlso My.Computer.FileSystem.GetFileInfo(Me.SaveFullPath).Length > 0 AndAlso Me.GetProgressPercentage = 100 Then '若檔案存在,且大小都和網路上的相同。表示下載成功
                nStatus = 1 '讀取成功
                Debug.Print([GetType].Name & ":讀取成功!")
            Else
                nStatus = 0 '讀取失敗
                Me.KillFile() '如果有殘留的檔案存在,刪除它
                Debug.Print([GetType].Name & ":讀取失敗!")
            End If
        ElseIf nStatus = 2 Then '中止讀取
            Me.KillFile() '如果有殘留的檔案存在,刪除它
        End If
 
        lEndTime = Environment.TickCount '取得結束時間
        RaiseEvent ProgressCompleted() '觸發讀取完成事件
    End Sub
End Class

HyperURLGetter類別各項屬性方法名稱說明

屬性(Property)名稱

型態

功能說明

AutoOverWrite Boolean(布林) 取得或設定是否自動覆蓋已存在的檔案。
TextCode String(字串) 取得或設定編碼方式。
SaveFileName String(字串) 取得或設定檔案存放的檔名。
SaveFolderPath String(字串) 取得或設定檔案存放的資料夾路徑(無法自動建立資料夾)。若指定值有誤,會自動以原本設定的路徑來做設定。
SaveFullPath String(字串) 取得或設定檔案存放的完整路徑(無法自動建立資料夾)。若指定值有誤,會自動以原本設定的路徑和預設檔名做設定。
TargetURL String(字串) 取得或設定讀取的目標網址。
Timeout Long(長整數) 取得或設定逾時判斷時間。

 

函式(Function)名稱

型態

功能說明

CheckLoading Boolean(布林) 檢查程序是否正在使用網路。如果是,傳回True;否則傳回False。
ChoseFolderPath String(字串) 開啟FolderBrowserDialog,讓使用者選取資料夾。通常和SaveFolderPath合用。
ChoseFullPath String(字串) 開啟SaveFileDialog,讓使用者選取檔案存放路徑。通常和SaveFullPath合用。
CreateFolder Boolean(布林) 傳入資料夾路徑,如果路徑不存在就自動建立資料夾。若有建立成功則傳回True;失敗則傳回False。
FormatBytes String(字串) 傳入要格式化的位元組數字和小數位數,傳回以TB、GB、MB、KB、B為單位的字串。若在第三個引數有指定單位(String型態),則以指定的單位進行字串格式化。
FormatTime String(字串) 傳入毫秒數,轉換時間為字串格式。
GetAverageEverySecondSpead Long(長整數) 取得平均每秒所傳送的位元組數。
GetAverageLastTime Long(長整數) 取得預估的平均剩餘時間。
GetBytesReceived Long(長整數) 取得已讀取的檔案大小(單位:位元組Byte)。
GetDoubleProgressPercentage Double(倍精準浮點數) 取得目前的讀取進度百分比(浮點數),傳入小數位數。
GetEverySecondSpead Long(長整數) 取得每秒所傳送的位元組數。
GetLastBytes Long(長整數) 取得剩餘的位元組數。
GetLastTime Long(長整數) 取得預估的剩餘時間。
GetLoadedTime Long(長整數) 取得從開始讀取到讀取完成的所用時間。
GetLoadingTime Long(長整數) 取得讀取的已用時間。
GetMyFolderPath String(字串) 取得程式本身所在的資料夾路徑(不包括檔名)。
GetMyVersion String(字串) 取得程式的版本號碼(格式:X.X.X)
GetProgressPercentage Integer(整數) 取得目前的讀取進度百分比(整數)。
GetStatus Short(短整數) 儲存讀取狀態。如果傳回-2,代表尚未開始讀取。傳回-1,代表讀取正在進行中。傳回0,代表讀取失敗。傳回1,代表讀取成功。傳回2,代表中斷讀取。傳回3,代表取得資料與特徵不符。
GetTotalBytesToReceive Long(長整數) 取得總共要讀取的檔案大小(單位:位元組Byte)。
HyperURLText String(字串) 以純文字字串的方式傳回讀取到的資訊。可以傳入特徵判斷特徵是否相同。
StringSeparate String(字串) 取得字串的某個部分。
TransformBytes Double(倍精準浮點數) 傳入要格式化的位元組數字、小數位數和指定單位,轉換位元組Byte為浮點數格式。

 

 

副程式(Sub)名稱

功能說明

CreateSaveFileName 置入網址(TargetURL)中提供的檔名(如果存在)。
KillFile 刪除路徑SaveFullPath所指的檔案實體。
OpenFile 開啟路徑SaveFullPath所指的檔案實體。
OpenFolder 開啟SaveFolderPath資料夾。
RunWorkerAsync 一切就緒後,使用此Sub可以呼叫DownloadFileAsync開始進行讀取程序。不會占用主執行緒的資源
SetHeaders 設定瀏覽器的HTTP headers。直接傳入要模擬的瀏覽器名稱。若傳入空字串,則改為預設值。
SetTimeFormat 設定時間格式。傳入「天、小時、分鐘、秒」的顯示字串
Skip 略過讀取程序(通常用於覆蓋檔案的事件)。
StopRunning 停止讀取程序

 

建構子(Constructor)參數(Parameter)

功能說明

ByVal InputTargetURL As String InputTargetURL用來載入要讀取資訊的目標網址。
ByVal InputTargetURL As String, ByVal InputSaveFileName As String InputSaveFileName用來載入要初始的檔案名稱。
ByVal InputTargetURL As String, ByVal InputSaveFolderPath As String, ByVal InputSaveFileName As String InputSaveFolderPath用來載入檔案要存放的資料夾初始路徑。

文章分類:VB.net|標籤:, , , , , ,

迴響已關閉