VBレスキュー(花ちゃん) - VBレスキュー(花ちゃん)の投稿サンプル用掲示板

　　　　　サンプル投稿用掲示板　　 VB2005 ～用トップページ　　 VB6.0 用トップページ

Inetで進行状況等をプログレスバーで表示するには(VB6.0) ( No.0 ) 　[親スレッドへ]

日時： 2007/09/14 19:57
名前： 花ちゃん: ***********************************************************************************
* カテゴリー：[インターネット][通信][]                                            *
* キーワード：プログレスバー,WEB,HTML,読み込み状況,,                              *
***********************************************************************************

元質問：inetの進行状況 - 極悪天使  2007/09/04-14:53 No.10112
inetで指定サイトからHTMLソースなどを抽出する際に、プログレスバーで進行状況を表示させたいのですが出来ません。

-----------------------------------------------------------------------------------
Re: inetの進行状況 - 魔界の仮面弁士  2007/09/04-16:55 No.10113
-----------------------------------------------------------------------------------

> inetで指定サイトからHTMLソースなどを抽出する際に、
> プログレスバーで進行状況を表示させたいのですが出来ません。

その、「出来なかった」ソースを見せてもらえませんか?

とりあえずのサンプル。エラー処理等は含めていません。

Option Explicit

Private maxSize As Long
Private downloadData As ADODB.Stream

Private Sub Command2_Click()
    Unload Me
End Sub

Private Sub Form_Load()
    maxSize = -1
    ProgressBar1.Max = 32767
    ProgressBar1.Min = 0
    ProgressBar1.Value = 0
End Sub

Private Sub Command1_Click()
    Command1.Enabled = False
    Screen.MousePointer = vbHourglass
    Set downloadData = New ADODB.Stream
    downloadData.Type = adTypeBinary
    downloadData.Open

    '掲示板の制限回避のために、URL をわざと分割表記させています。(^^;
    Dim URL As String
    URL = "ht" & "tp://unicode.org/Public/UNIDATA/EastAsianWidth.txt"

    Inet1.Execute URL, "GET"
End Sub

Private Sub Completed()
    Screen.MousePointer = vbDefault
    downloadData.SaveToFile "C:\EastAsianWidth.txt", adSaveCreateOverWrite
    MsgBox Format(downloadData.size / 1024, "取得完了(#,0 KB)"), vbInformation
    downloadData.Close
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
    If State = icResponseReceived Then
        Dim sSize As String
        sSize = Inet1.GetHeader("Content-Length")
        If sSize = "" Then
            'サイズを返さないサーバ
            maxSize = -1
            ProgressBar1.Visible = False
        Else
            maxSize = CLng(sSize)
        End If
    ElseIf State = icResponseCompleted Then
        Const ChunkSize As Long = 4096
        Dim buf() As Byte
        Do
            buf = Inet1.GetChunk(ChunkSize, icByteArray)
            downloadData.Write buf
            ProgressBar1.Value = (downloadData.size / maxSize) * ProgressBar1.Max
        Loop Until (UBound(buf) - LBound(buf) + 1) < ChunkSize
        Completed
    End If
End Sub