CHttpClient - A Helper Class Using WinInet

'
' file:     HttpUpload.vbs
' brief:    A HTTP UPLOAD demo script for the HttpClient component edition.
' author:   Jo Hyeong-ryeol
' since:    2006.01.09
' version:  $LastChangedRevision: 94 $
'           $LastChangedDate: 2006-01-30 23:52:44 +0900 (월, 30 1 2006) $
' 
' This file contains a HTTP UPLOAD demo script for the HttpClient component edition.
' 
' Copyright (c) 2006 by Jo Hyeong-ryeol (hyeongryeol@gmail.com)
' Permission to copy, use, modify, sell and distribute this software is
' granted provided this copyright notice appears in all copies.
' This software is provided "as is" without express or implied warranty,
' and with no claim as to its suitability for any purpose.
'

    Const   HttpClientParamNormal           = 0
    Const   HttpClientParamFile             = 1
    Const   HttpClientParamEncodedName      = 2
    Const   HttpClientParamEncodedValue     = 4
    Dim     HttpClientParamEncoded
    HttpClientParamEncoded =  HttpClientParamEncodedName Or HttpClientParamEncodedValue

    
    Dim     objHttpClient, objHttpResponse, objPostStat

    ' Create the HttpClient object
    Set objHttpClient = CreateObject ("Ryeol.HttpClient2")
    
    ' Initialize the User Agent
    objHttpClient.InternetUserAgent = "My User Agent v1.0"
    
    ' Add user's custom HTTP headers
    Call objHttpClient.AddHeader ("Ryeol-Magic", "My Magic Header")
    Call objHttpClient.AddHeader ("User-Magic", "User's Magic Header")

    ' Add user's parameters
    Call objHttpClient.AddParam ("nohtml", "1")
    Call objHttpClient.AddParam ("title", "The K-NET photo")
    Call objHttpClient.AddParam ("content", "A photo of the K-NET")

    ' Specifies a file to upload
    Call objHttpClient.AddParam ("ufile01", "HttpUpload.vbs", HttpClientParamFile)

    ' Start a new request
    Const   TargetURL       = "http://club.hooriza.com/cmd/box.html?clubid=1&boxid=53&action=store&link="
    Call WScript.Echo ("HTTP UPLOAD " & TargetURL)

    Call objHttpClient.BeginUpload (TargetURL)

    '
    ' Reports progress information
    '

    Const       cbProceed = 1024        ' 1K

    ' Create a HttpPostStat Object
    Set objPostStat = CreateObject ("Ryeol.HttpPostStat2")
    
    Do
        Call objHttpClient.Query (objPostStat)

        Call WScript.Echo ("")
        Call WScript.Echo ("Post in progress... " & CLng (objPostStat.PostedCount) & "/" & CLng (objPostStat.TotalCount))

        Call WScript.Echo (objPostStat.CurrParam _
                & ": " & CLng (objPostStat.CurrParamPostedByte) _
                & "/" & CLng (objPostStat.CurrParamTotalByte) _
                & " " & CLng (objPostStat.PostedByte) _
                & "/" & CLng (objPostStat.TotalByte) _
                & " " & CLng (objPostStat.ActualPostedByte) _
                & "/" & CLng (objPostStat.ActualTotalByte))

        If objPostStat.CurrParamIsFile Then
            Call WScript.Echo ("-->" & objPostStat.CurrFile)
        End if

        Set objHttpResponse = objHttpClient.Proceed (cbProceed)

        On Error Resume Next
        Call objHttpResponse.HasContentLength ()

        ' If an error is not occurred, we can assume that objHttpResponse is a correct object.
        If Err.Number = 0 then
            On Error Goto 0
            Exit Do
        End if

        On Error Goto 0     
    Loop While True
'   Loop While Not IsObject (objHttpResponse)       ' So bad.. IsObject doesn't work correctly.

    
    '
    ' Reports results
    '

    Call WScript.Echo (CStr (objHttpResponse.Status) & " " & objHttpResponse.StatusText)

    Dim             knownHeaderNames
    knownHeaderNames = Array _
        ( _
            "Server", "Date", "X-Powered-By", "Content-Length", "Set-Cookie" _
            , "Expires", "Cache-control", "Connection", "Transfer-Encoding" _
            , "Content-Type" _
        )
    Dim             knownHeaderString
    knownHeaderString = ""
        
    For i = 0 To UBound (knownHeaderNames) Step 1

        If i <> 0 then
            knownHeaderString = knownHeaderString & vbCrLf
        End if
        
        If objHttpResponse.HeaderExists (knownHeaderNames(i)) then
            knownHeaderString = knownHeaderString & knownHeaderNames(i) & ": " & objHttpResponse.GetHeader (knownHeaderNames(i))
        Else
            ' If the header is not found..
            knownHeaderString = knownHeaderString & "'" & knownHeaderNames(i) & "' header does not exist.."
        End if

    Next

    ' writes known headers
    Call WScript.Echo (knownHeaderString)
    

    ' checks the returned data type
    Dim         isText
    isText = False
    If objHttpResponse.HeaderExists ("Content-Type") then
        
        If InStr (objHttpResponse.GetHeader ("Content-Type"), "text/") = 1 then
            isText = True
        End if

    End if

    ' checks the returned stream size
    Dim         contentLength
    If objHttpResponse.HasContentLength () then
        contentLength = CLng (objHttpResponse.ContentLength)
    Else
        contentLength = "Unknown"
    End if

    
    If isText then
        Call WScript.Echo ("The content stream is a text. (" & contentLength & " bytes)")
    Else
        Call WScript.Echo ("The content stream is a binary. (" & contentLength & " bytes)")
    End if


    ' Saves the returned content stream
    const       FilePath = "ReturnedContent.HttpUpload.vbs.dat"

    Call objHttpResponse.SaveContent (FilePath)
    Call WScript.Echo ("The content stream is saved to a file '" & FilePath & "'")