'-----------------
' Here are some code snippets to post some data to a web page.
'  you will have to add an internet transfer control to you your form.
' Copyright (c) dave@thehansens.com, Dave Hansen Cary, IL 847-639-0082 2006
'
Dim post_response as String
Dim in_sending as Boolean
Dim total_buf as String
Dim SendResults as String
Dim rec_buf as String
Dim received_response as Boolean

Private Sub send_post_data(TextData as string)
    Dim strURL As String
    Dim postdata As String
    Dim Headers As String
    On Error GoTo 0

    strURL = "https://www.thewebserver.com/savedata.asp"
  
	received_response = False
    postdata = "x=x&user=dave&pass=GoYahoo&age=youngenough&year=" & strYear & "&id=" & ID & _
        "&TextData=" & sURLencoded(TextData) & _
        "&submit=Save" '& vbCrLf
        
Headers = "Accept: */*" & vbCrLf & _
"Referer: https://www.thewebserver.com/forms/dataform.htm" & vbCrLf & _
"Pragma: no-cache" & vbCrLf & _
"Accept-Language: en-us" & vbCrLf & _
"Content-Length: " & Len(postdata) & vbCrLf & _
"Content-Type: application/x-www-form-urlencoded" & vbCrLf


        post_response = ""
        is_sending = True
        Call Inet1.Execute(strURL, "POST", postdata, Headers)
        While (Inet1.StillExecuting)
            DoEvents
            If post_response <> "" Then GoTo done
        Wend
done:
    SendResults = post_response
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
    Dim bDone As Boolean
    If State = 12 Then
        bDone = False
    
      ' Get first chunk.
      rec_buf = Inet1.GetChunk(1024, icString)
      DoEvents
      Do While Not bDone
         total_buf = total_buf & rec_buf
         DoEvents
         rec_buf = Inet1.GetChunk(1024, icString)
         If Len(rec_buf) = 0 Then
            bDone = True
            received_response = True
            If is_sending Then
                post_response = total_buf
                total_buf = ""
            End If
            Exit Sub
         End If
      Loop
    End If
End Sub

Public Function sURLencoded(istr As String) As String

    Dim rc As String
    Dim fd As Integer
    Dim fsize As Long
    Dim i As Long
    Dim ch As String
    Dim a As Integer
    rc = ""
    fsize = Len(istr)
    For i = 1 To fsize:
        ch = Mid$(istr, i, 1)
        a = Asc(ch)
        If a < 32 Or a > 122 Then
            ch = "%" & Hex(a)
        Else
            If ch = " " Then
                ch = "+"
            Else
                If (a > 33 And a < 48) Or (a >= 58 And a <= 64) Or (a >= 91 And a <= 96) Then
                    ch = "%" & Hex(a)
                End If
            End If
        End If
        rc = rc & ch
    Next i
    sURLencoded = rc
End Function