InternetReadFile issue (bad char issue cont.)

[Joy]

InternetReadFile issue

days ago, I posted sth here to ask about the bad char issue.
I did a lot of experiments then and found MS map works OK, and did not cause
any problems.

then, I read posts online and looks like InternetReadFile may cause bad char
issue during net transmission.
in our codes (see below), we use InternetReadFile to post data to web server.
when the file is very large and network connection is bad, the bad char
issue is most likely to occur.

is there any better way to get a more stable function to post data to
server? thank you so much in advance!

' This function posts the data to the web server.
' 1. Call InternetConnect to get session handle.
' 2. Call HttpOpenRequest to define all desired request parameters and
request type (HTTP or FTP).
' 3. Call HttpSendRequest or HttpSendRequestEx to send the request to the
remote host.
' 4. Read the possible answer with InternetReadFile.
' 5. Close the request handle.
' 6. Repeat all from Step 2.
' 7. Close the session handle.
Public Function PostInfo(srv$, script$, postdat$, Optional posttype$,
Optional boundary$) As String

Dim hInternetOpen As Long
Dim hInternetConnect As Long
Dim hHttpOpenRequest As Long
Dim bRet As Boolean

hInternetOpen = 0
hInternetConnect = 0
hHttpOpenRequest = 0

On Error GoTo errorHandler

'Use registry access settings.
Const INTERNET_OPEN_TYPE_PRECONFIG = 0
hInternetOpen = InternetOpen("text", _
INTERNET_OPEN_TYPE_PRECONFIG, _
vbNullString, _
vbNullString, _
0)

If hInternetOpen <> 0 Then

Const INTERNET_OPTION_CONNECT_TIMEOUT = 2
Const INTERNET_OPTION_SEND_TIMEOUT = 5
Const INTERNET_OPTION_RECEIVE_TIMEOUT = 6
Dim dwTimeOut As Long
dwTimeOut = 500000 'ms
bRet = InternetSetOption(hInternetOpen,
INTERNET_OPTION_CONNECT_TIMEOUT, dwTimeOut, 4)

bRet = InternetSetOption(hInternetOpen, INTERNET_OPTION_SEND_TIMEOUT,
dwTimeOut, 4)

bRet = InternetSetOption(hInternetOpen,
INTERNET_OPTION_RECEIVE_TIMEOUT, dwTimeOut, 4)

'Type of service to access.
Const INTERNET_SERVICE_HTTP = 3

'Change the server to your server name
hInternetConnect = InternetConnect(hInternetOpen, _
srv$, _
program_mgmt_PORT, _
vbNullString, _
"HTTP/1.0", _
INTERNET_SERVICE_HTTP, _
0, _
0)

If hInternetConnect <> 0 Then
'Brings the data across the wire even if it locally cached.
Const INTERNET_FLAG_RELOAD = &H80000000
hHttpOpenRequest = HttpOpenRequest(hInternetConnect, _
"POST", _
script$, _
"HTTP/1.0", _
vbNullString, _
0, _
INTERNET_FLAG_RELOAD, _
0)

If hHttpOpenRequest <> 0 Then
Dim sHeader As String
Const HTTP_ADDREQ_FLAG_ADD = &H20000000
Const HTTP_ADDREQ_FLAG_REPLACE = &H80000000

If (posttype$ = "multipart") Then
sHeader = "Content-Type: multipart/form-data; boundary=" _
& boundary$ & vbCrLf
Else
sHeader = "Content-Type: application/x-www-form-urlencoded" _
& vbCrLf
End If

bRet = HttpAddRequestHeaders(hHttpOpenRequest, _
sHeader, Len(sHeader), HTTP_ADDREQ_FLAG_REPLACE _
Or HTTP_ADDREQ_FLAG_ADD)

Dim lpszPostData As String
Dim lPostDataLen As Long

lpszPostData = postdat$
lPostDataLen = Len(lpszPostData)
bRet = HttpSendRequest(hHttpOpenRequest, _
vbNullString, _
0, _
lpszPostData, _
lPostDataLen)

Dim bDoLoop As Boolean
Dim sReadBuffer As String * 2048
Dim lNumberOfBytesRead As Long
Dim sBuffer As String

sBuffer = ""
bDoLoop = True

While bDoLoop
sReadBuffer = vbNullString
bDoLoop = InternetReadFile(hHttpOpenRequest, _
sReadBuffer, Len(sReadBuffer), lNumberOfBytesRead)

If bDoLoop Then
If lNumberOfBytesRead > 0 Then
sBuffer = sBuffer & Left(sReadBuffer, lNumberOfBytesRead)
Else
bDoLoop = False
End If
Else
bDoLoop = True
End If

Wend

PostInfo = sBuffer
bRet = InternetCloseHandle(hHttpOpenRequest)
End If
bRet = InternetCloseHandle(hInternetConnect)
End If
bRet = InternetCloseHandle(hInternetOpen)
End If

Exit Function

errorHandler:
Dim errorDescription As String

If (err.LastDllError < 12000) Then
errorDescription = "Unknown Error " & err.LastDllError
Else
If (err.LastDllError = 12003) Then
errorDescription = "WinInet Error -" & err.LastDllError & " - "
& GetLastResponse()
Else
errorDescription = "WinInet Error -" & err.LastDllError & " - "
& GetWinInetErrDesc(err.LastDllError)
End If
End If

MsgBox errorDescription, vbExclamation, "Connection Error"

End Function

 

[Jack Dahlgren MVP]

How about some sort of checksum? Download twice and compare?

-Jack Dahlgren