Tsinghua
August 27th, 2001, 10:32 PM
Dear sir/madam:
I have written some codes to implement upload file wit5h big size,but it can't work,why?please give me a hand,thanks anyway!
/////////////////the code///////////////// http://support.microsoft.com/support/kb/articles/Q184/3/52.ASP
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, _
ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" _
Alias "InternetConnectA" (ByVal hInternetSession As Long, _
ByVal sServerName As String, ByVal nServerPort As Integer, _
ByVal sUsername As String, ByVal sPassword As String, _
ByVal lService As Long, ByVal lFlags As Long, _
ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _
(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Integer
Private Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As Long, _
ByVal lNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_INVALID_PORT_NUMBER = 0 '// use the protocol-specific default
Private Const INTERNET_DEFAULT_FTP_PORT = 21 ' // default for FTP servers
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70 ' // " " gopher "
Private Const INTERNET_DEFAULT_HTTP_PORT = 80 ' // " " HTTP "
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443
Private Const INTERNET_SERVICE_URL = 0
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const HSR_ASYNC = &H1 ' // force async
Private Const HSR_SYNC = &H4 ' // force sync
Private Const HSR_USE_CONTEXT = &H8
Private Const HSR_INITIATE = &H8 ' // iterative operation (completed by HttpEndRequest)
Private Const HSR_DOWNLOAD = &H10 ' // download to file
Private Const HSR_CHUNKED = &H20 ' // operation is send of chunked data
Private Const BUFFSIZE = 500
Private Type INTERNET_BUFFERS
dwStructSize As Long
Next As Long
lpcszHeader As Long
dwHeadersLength As Long
dwHeadersTotal As Long
lpvBuffer As Long
dwBufferLength As Long
dwBufferTotal As Long
dwOffsetLow As Long
dwOffsetHigh As Long
End Type
Private Declare Function HttpSendRequestEx Lib "wininet.dll" Alias "HttpSendRequestExA" (ByVal hRequest As Long, ByVal lpBuffersIn As Long, ByVal lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpEndRequest Lib "wininet.dll" Alias "HttpEndRequestA" (ByVal hRequest As Long, lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
Private Declare Function FillMemory Lib "KERNEL32.DLL" Alias "RtlFillMemory" ( _
Destination As Any, _
ByVal Length As Long, _
Fill As Byte) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) _
As Long
Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const INVALID_HANDLE_VALUE = -1
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOVERLAPPED As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub PostFile(strServer As String, strLocalFile As String, strURL As String, Optional strUser As String, Optional strPass As String)
Dim hSession, hConnect, hRequest As Long
hSession = InternetOpen("HttpSendRequestEx", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hSession = 0 Then
Exit Sub
End If
hConnect = InternetConnect(hSession, strServer, INTERNET_DEFAULT_HTTP_PORT, strUser, strPass, INTERNET_SERVICE_HTTP, 0&, 0&)
If hConnect = 0 Then
Exit Sub
End If
hRequest = HttpOpenRequest(hConnect, "POST", strURL, vbNullString, vbNullString, 0&, INTERNET_FLAG_NO_CACHE_WRITE, 0)
If hRequest Then
Call UseHttpSendReqEx(hRequest, strLocalFile)
End If
Call InternetCloseHandle(hRequest)
Call InternetCloseHandle(hConnect)
Call InternetCloseHandle(hSession)
End Sub
Private Function UseHttpSendReqEx(hRequest As Long, strUpFile As String) As Boolean
Dim BufferIn As INTERNET_BUFFERS
Dim BufferOut As INTERNET_BUFFERS
Dim pp As INTERNET_BUFFERS
Dim res As Long
Dim dwBytesWritten As Long
Dim MaxTimes As Integer
Dim pBuffer(1024) As Byte
Dim bRet As Boolean
Dim lngReservedSize As Long
Dim hFile As Long
Dim Sum As Long
Dim bRead As Long
Dim lpSA As SECURITY_ATTRIBUTES
Dim lpOVERLAPPED As OVERLAPPED
Dim lngFileSize As Long
hFile = CreateFile(strUpFile, GENERIC_READ, FILE_SHARE_READ, 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)
If hFile = INVALID_HANDLE_VALUE Then
MsgBox "Error to open Upfile!"
Exit Function
End If
lngFileSize = GetFileSize(hFile, 0&)
BufferIn.dwStructSize = Len(INTERNET_BUFFERS)
BufferIn.dwBufferTotal = lngFileSize
BufferIn.dwBufferLength = 0
BufferIn.dwHeadersLength = 0
BufferIn.dwHeadersTotal = 0
BufferIn.dwOffsetHigh = 0
BufferIn.dwOffsetLow = 0
BufferIn.lpcszHeader = 0&
BufferIn.lpvBuffer = 0&
BufferIn.Next = 0&
res = HttpSendRequestEx(hRequest, VarPtr(BufferIn), VarPtr(BufferOut), HSR_INITIATE, 0&)
If res = 0 Then
MsgBox "error to HttpSendRequestEx!"
Exit Function
End If
Sum = 0
Do
bRead = ReadFile(hFile, pBuffer(0), 1024, dwBytesRead, 0&)
If bRead = 0 Then
MsgBox "Error Read File!"
Exit Function
End If
bRet = InternetWriteFile(hRequest, VarPtr(pBuffer(0)), dwBytesRead, dwBytesWritten)
If bRet = False Then
MsgBox "Error InternetWrite File!"
Exit Function
End If
Sum = Sum + dwBytesRead
Loop Until Sum = lngFileSize
Call CloseHandle(hFile)
Call HttpEndRequest(hRequest, 0&, 0, 0)
End Function
Private Sub Command1_Click()
Call PostFile("127.0.0.1", "c:\netlog.txt", "/test.htm")
End Sub
///////////////////////end of code///////
if you find the answer,please contact with me,my email is Qixh@neusoft.com,thanks again!
I have written some codes to implement upload file wit5h big size,but it can't work,why?please give me a hand,thanks anyway!
/////////////////the code///////////////// http://support.microsoft.com/support/kb/articles/Q184/3/52.ASP
Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal sAgent As String, _
ByVal lAccessType As Long, ByVal sProxyName As String, _
ByVal sProxyBypass As String, ByVal lFlags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" _
Alias "InternetConnectA" (ByVal hInternetSession As Long, _
ByVal sServerName As String, ByVal nServerPort As Integer, _
ByVal sUsername As String, ByVal sPassword As String, _
ByVal lService As Long, ByVal lFlags As Long, _
ByVal lContext As Long) As Long
Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" _
(ByVal hHttpSession As Long, ByVal sVerb As String, ByVal sObjectName As String, ByVal sVersion As String, _
ByVal sReferer As String, ByVal something As Long, ByVal lFlags As Long, ByVal lContext As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal _
hHttpRequest As Long, ByVal sHeaders As String, ByVal lHeadersLength As Long, ByVal sOptional As String, ByVal lOptionalLength As Long) As Integer
Private Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByVal sBuffer As Long, _
ByVal lNumberOfBytesToRead As Long, _
lNumberOfBytesRead As Long) As Integer
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_OPEN_TYPE_PROXY = 3
Private Const INTERNET_INVALID_PORT_NUMBER = 0 '// use the protocol-specific default
Private Const INTERNET_DEFAULT_FTP_PORT = 21 ' // default for FTP servers
Private Const INTERNET_DEFAULT_GOPHER_PORT = 70 ' // " " gopher "
Private Const INTERNET_DEFAULT_HTTP_PORT = 80 ' // " " HTTP "
Private Const INTERNET_DEFAULT_HTTPS_PORT = 443
Private Const INTERNET_SERVICE_URL = 0
Private Const INTERNET_SERVICE_FTP = 1
Private Const INTERNET_SERVICE_GOPHER = 2
Private Const INTERNET_SERVICE_HTTP = 3
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const HSR_ASYNC = &H1 ' // force async
Private Const HSR_SYNC = &H4 ' // force sync
Private Const HSR_USE_CONTEXT = &H8
Private Const HSR_INITIATE = &H8 ' // iterative operation (completed by HttpEndRequest)
Private Const HSR_DOWNLOAD = &H10 ' // download to file
Private Const HSR_CHUNKED = &H20 ' // operation is send of chunked data
Private Const BUFFSIZE = 500
Private Type INTERNET_BUFFERS
dwStructSize As Long
Next As Long
lpcszHeader As Long
dwHeadersLength As Long
dwHeadersTotal As Long
lpvBuffer As Long
dwBufferLength As Long
dwBufferTotal As Long
dwOffsetLow As Long
dwOffsetHigh As Long
End Type
Private Declare Function HttpSendRequestEx Lib "wininet.dll" Alias "HttpSendRequestExA" (ByVal hRequest As Long, ByVal lpBuffersIn As Long, ByVal lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function HttpEndRequest Lib "wininet.dll" Alias "HttpEndRequestA" (ByVal hRequest As Long, lpBuffersOut As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Long
Private Declare Function FillMemory Lib "KERNEL32.DLL" Alias "RtlFillMemory" ( _
Destination As Any, _
ByVal Length As Long, _
Fill As Byte) As Long
Private Type SECURITY_ATTRIBUTES
nLength As Long
lpSecurityDescriptor As Long
bInheritHandle As Long
End Type
Private Declare Function CreateFile Lib "kernel32" _
Alias "CreateFileA" _
(ByVal lpFileName As String, _
ByVal dwDesiredAccess As Long, _
ByVal dwShareMode As Long, _
ByVal lpSecurityAttributes As Long, _
ByVal dwCreationDisposition As Long, _
ByVal dwFlagsAndAttributes As Long, _
ByVal hTemplateFile As Long) _
As Long
Private Const GENERIC_READ = &H80000000
Private Const FILE_SHARE_READ = &H1
Private Const OPEN_EXISTING = 3
Private Const FILE_ATTRIBUTE_NORMAL = &H80
Private Const INVALID_HANDLE_VALUE = -1
Private Declare Function GetFileSize Lib "kernel32" (ByVal hFile As Long, lpFileSizeHigh As Long) As Long
Private Type OVERLAPPED
Internal As Long
InternalHigh As Long
offset As Long
OffsetHigh As Long
hEvent As Long
End Type
Private Declare Function ReadFile Lib "kernel32" (ByVal hFile As Long, lpBuffer As Any, ByVal nNumberOfBytesToRead As Long, lpNumberOfBytesRead As Long, ByVal lpOVERLAPPED As Long) As Long
Private Declare Function CloseHandle Lib "kernel32" (ByVal hObject As Long) As Long
Private Sub PostFile(strServer As String, strLocalFile As String, strURL As String, Optional strUser As String, Optional strPass As String)
Dim hSession, hConnect, hRequest As Long
hSession = InternetOpen("HttpSendRequestEx", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
If hSession = 0 Then
Exit Sub
End If
hConnect = InternetConnect(hSession, strServer, INTERNET_DEFAULT_HTTP_PORT, strUser, strPass, INTERNET_SERVICE_HTTP, 0&, 0&)
If hConnect = 0 Then
Exit Sub
End If
hRequest = HttpOpenRequest(hConnect, "POST", strURL, vbNullString, vbNullString, 0&, INTERNET_FLAG_NO_CACHE_WRITE, 0)
If hRequest Then
Call UseHttpSendReqEx(hRequest, strLocalFile)
End If
Call InternetCloseHandle(hRequest)
Call InternetCloseHandle(hConnect)
Call InternetCloseHandle(hSession)
End Sub
Private Function UseHttpSendReqEx(hRequest As Long, strUpFile As String) As Boolean
Dim BufferIn As INTERNET_BUFFERS
Dim BufferOut As INTERNET_BUFFERS
Dim pp As INTERNET_BUFFERS
Dim res As Long
Dim dwBytesWritten As Long
Dim MaxTimes As Integer
Dim pBuffer(1024) As Byte
Dim bRet As Boolean
Dim lngReservedSize As Long
Dim hFile As Long
Dim Sum As Long
Dim bRead As Long
Dim lpSA As SECURITY_ATTRIBUTES
Dim lpOVERLAPPED As OVERLAPPED
Dim lngFileSize As Long
hFile = CreateFile(strUpFile, GENERIC_READ, FILE_SHARE_READ, 0&, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0&)
If hFile = INVALID_HANDLE_VALUE Then
MsgBox "Error to open Upfile!"
Exit Function
End If
lngFileSize = GetFileSize(hFile, 0&)
BufferIn.dwStructSize = Len(INTERNET_BUFFERS)
BufferIn.dwBufferTotal = lngFileSize
BufferIn.dwBufferLength = 0
BufferIn.dwHeadersLength = 0
BufferIn.dwHeadersTotal = 0
BufferIn.dwOffsetHigh = 0
BufferIn.dwOffsetLow = 0
BufferIn.lpcszHeader = 0&
BufferIn.lpvBuffer = 0&
BufferIn.Next = 0&
res = HttpSendRequestEx(hRequest, VarPtr(BufferIn), VarPtr(BufferOut), HSR_INITIATE, 0&)
If res = 0 Then
MsgBox "error to HttpSendRequestEx!"
Exit Function
End If
Sum = 0
Do
bRead = ReadFile(hFile, pBuffer(0), 1024, dwBytesRead, 0&)
If bRead = 0 Then
MsgBox "Error Read File!"
Exit Function
End If
bRet = InternetWriteFile(hRequest, VarPtr(pBuffer(0)), dwBytesRead, dwBytesWritten)
If bRet = False Then
MsgBox "Error InternetWrite File!"
Exit Function
End If
Sum = Sum + dwBytesRead
Loop Until Sum = lngFileSize
Call CloseHandle(hFile)
Call HttpEndRequest(hRequest, 0&, 0, 0)
End Function
Private Sub Command1_Click()
Call PostFile("127.0.0.1", "c:\netlog.txt", "/test.htm")
End Sub
///////////////////////end of code///////
if you find the answer,please contact with me,my email is Qixh@neusoft.com,thanks again!