lobbezoo
asked on
FTP Transfer with WININET.DLL
Hi,
I'm using wininit to transfer for- and back-wards binary and ascii files with a server on the internet.
My code calls a piece of coding, i think i got from MS (called IDBAS_WININET.BAS ), to do low-level functions.
This is the one to xfer to the net :
Public Function PutFtpFile(HostName As String, Username As String, UserPassword As String, HostFilename As String, localFilename As String, Optional TransferMode As eFtpTransferType = FTP_TRANSFER_TYPE_ASCII) As Long
hInternet = InternetOpen(App.title, 0, "", "", 0)
hFTP = InternetConnect(hInternet, HostName, INTERNET_DEFAULT_FTP_PORT, Username, UserPassword, INTERNET_SERVICE_FTP, 0, 0)
PutFtpFile = FtpPutFile(hFTP, localFilename, HostFilename, INTERNET_FLAG_DONT_CACHE + TransferMode, 0)
DoEvents
Call InternetCloseHandle(hInter net)
End Function
It works o.k., but as soon as i try to send images of more than a few k's (22K for example), i get timeouts, and the transfer function generates an error.
Now my question :
Are their parms i can give to these Wininit.dll functions, to prevent timeouts from happening?
Or is their a better wrapper - module ?
Thanks in advance.
Steven
I'm using wininit to transfer for- and back-wards binary and ascii files with a server on the internet.
My code calls a piece of coding, i think i got from MS (called IDBAS_WININET.BAS ), to do low-level functions.
This is the one to xfer to the net :
Public Function PutFtpFile(HostName As String, Username As String, UserPassword As String, HostFilename As String, localFilename As String, Optional TransferMode As eFtpTransferType = FTP_TRANSFER_TYPE_ASCII) As Long
hInternet = InternetOpen(App.title, 0, "", "", 0)
hFTP = InternetConnect(hInternet,
PutFtpFile = FtpPutFile(hFTP, localFilename, HostFilename, INTERNET_FLAG_DONT_CACHE + TransferMode, 0)
DoEvents
Call InternetCloseHandle(hInter
End Function
It works o.k., but as soon as i try to send images of more than a few k's (22K for example), i get timeouts, and the transfer function generates an error.
Now my question :
Are their parms i can give to these Wininit.dll functions, to prevent timeouts from happening?
Or is their a better wrapper - module ?
Thanks in advance.
Steven
<ping>
This is some code I wrote. I was not getting any timeout errors, just wanted to fire an event more frequently than allowed by FtpPutFile.
If it does not make any sense let me know and I will explain, but I suspect you have already a fair grip of the subtleties of WinInet.
Private Sub PutLongFile(ByVal sSrcFilename As String, _
ByVal sDstFilename As String, _
ByVal lTransferType As Long, _
ByVal FileSize As Currency)
Const BufferLen = 2048
Dim hFtpFile As Long
Dim hLocalFile As Integer
Dim Buffer As String
Dim BytesRead As Long
Dim BytesWritten As Long
Dim BytesTransferred As Currency
Dim CancelCopy As Boolean
CancelCopy = False
hFtpFile = FtpOpenFile(hConnect, _
sDstFilename, _
GENERIC_WRITE, _
lTransferType Or INTERNET_FLAG_RELOAD, _
0&)
If hFtpFile Then
hLocalFile = CreateFile(sSrcFilename, _
GENERIC_READ, _
0&, _
0&, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, _
0&)
If hLocalFile Then
Buffer = Space$(BufferLen)
BytesWritten = 0
BytesTransferred = 0
CancelCopy = False
Do
If ReadFile(hLocalFile, Buffer, BufferLen, BytesRead, 0&) Then
If InternetWriteFile(hFtpFile , Buffer, BytesRead, BytesWritten) Then
BytesTransferred = BytesTransferred + BytesWritten
RaiseEvent Progress(BytesTransferred, FileSize, CancelCopy)
End If
Else
Call RaiseError
CancelCopy = True 'To exit loop (although bytes read should also be 0) and delete file
End If
DoEvents
Loop While BytesRead = BufferLen And Not CancelCopy
Call CloseHandle(hLocalFile)
Else
Call RaiseError
End If
Call InternetCloseHandle(hFtpFi le)
If CancelCopy Then
FtpDeleteFile hConnect, sDstFilename
End If
hFtpFile = 0
Else
Call RaiseError
End If
End Sub
Anthony
If it does not make any sense let me know and I will explain, but I suspect you have already a fair grip of the subtleties of WinInet.
Private Sub PutLongFile(ByVal sSrcFilename As String, _
ByVal sDstFilename As String, _
ByVal lTransferType As Long, _
ByVal FileSize As Currency)
Const BufferLen = 2048
Dim hFtpFile As Long
Dim hLocalFile As Integer
Dim Buffer As String
Dim BytesRead As Long
Dim BytesWritten As Long
Dim BytesTransferred As Currency
Dim CancelCopy As Boolean
CancelCopy = False
hFtpFile = FtpOpenFile(hConnect, _
sDstFilename, _
GENERIC_WRITE, _
lTransferType Or INTERNET_FLAG_RELOAD, _
0&)
If hFtpFile Then
hLocalFile = CreateFile(sSrcFilename, _
GENERIC_READ, _
0&, _
0&, _
OPEN_EXISTING, _
FILE_ATTRIBUTE_NORMAL, _
0&)
If hLocalFile Then
Buffer = Space$(BufferLen)
BytesWritten = 0
BytesTransferred = 0
CancelCopy = False
Do
If ReadFile(hLocalFile, Buffer, BufferLen, BytesRead, 0&) Then
If InternetWriteFile(hFtpFile
BytesTransferred = BytesTransferred + BytesWritten
RaiseEvent Progress(BytesTransferred,
End If
Else
Call RaiseError
CancelCopy = True 'To exit loop (although bytes read should also be 0) and delete file
End If
DoEvents
Loop While BytesRead = BufferLen And Not CancelCopy
Call CloseHandle(hLocalFile)
Else
Call RaiseError
End If
Call InternetCloseHandle(hFtpFi
If CancelCopy Then
FtpDeleteFile hConnect, sDstFilename
End If
hFtpFile = 0
Else
Call RaiseError
End If
End Sub
Anthony
I guess it would help if I showed you I called the previous function:
Public Sub PutFile(Optional ByVal SrcFilename As Variant, _
Optional ByVal DstFilename As Variant, _
Optional ByVal TransferType As TransferTypesEnum = FTP_TRANSFER_TYPE_UNKNOWN)
Dim sSrcFilename As String
Dim sDstFilename As String
Dim lTransferType As Long
'Dim hFind As Long
'Dim pData As WIN32_FIND_DATA
'Dim PutOk As Boolean
Dim FileSize As Currency ' Needed for the Progress Event
mvarLastMethod = MethodsEnum.ActionPutFile
If IsMissing(SrcFilename) Or IsNull(SrcFilename) Then
sSrcFilename = mvarSrcFilename
Else
sSrcFilename = CStr(SrcFilename)
End If
If IsMissing(DstFilename) Or IsNull(DstFilename) Then
sDstFilename = mvarDstFilename
Else
sDstFilename = CStr(DstFilename)
End If
If TransferType = FTP_TRANSFER_TYPE_UNKNOWN Then
lTransferType = mvarTransferType
Else
lTransferType = TransferType
End If
'hFind = FtpFindFirstFile(hConnect, _
' sDstFilename, _
' pData, _
' INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRI TE, _
' 0&)
'
'If hFind Then
' PutOk = Overwrite
' 'clean up by closing the handles used in this routine
' Call InternetCloseHandle(hFind)
' hFind = 0
'Else
' If Err.LastDllError = ERROR_NO_MORE_FILES Then
' PutOk = True
' Else
' PutOk = False
' Call RaiseError
' End If
'End If
'
'If PutOk Then
' FileLen function could be a problem for files greater than 2GB, in which case
' it should be replaced with CreateFile, GetFileSizeEx, CloseHandle
FileSize = FileLen(sSrcFilename)
If FileSize < MaxShortCopySize Then
If FtpPutFile(hConnect, _
sSrcFilename, _
sDstFilename, _
lTransferType Or INTERNET_FLAG_RELOAD, _
0&) Then
RaiseEvent Progress(FileSize, FileSize, False)
Else
Call RaiseError
End If
Else
Call PutLongFile(sSrcFilename, sDstFilename, lTransferType, FileSize)
End If
'Else
' Err.Raise vbObjectError + 1, "FTP Put File", "Remote file already exists and 'Overwrite' flag is off !"
'End If
RaiseEvent Done
End Sub
Evidently, I had some problem with the overwrite flag not working.
Anthony
Public Sub PutFile(Optional ByVal SrcFilename As Variant, _
Optional ByVal DstFilename As Variant, _
Optional ByVal TransferType As TransferTypesEnum = FTP_TRANSFER_TYPE_UNKNOWN)
Dim sSrcFilename As String
Dim sDstFilename As String
Dim lTransferType As Long
'Dim hFind As Long
'Dim pData As WIN32_FIND_DATA
'Dim PutOk As Boolean
Dim FileSize As Currency ' Needed for the Progress Event
mvarLastMethod = MethodsEnum.ActionPutFile
If IsMissing(SrcFilename) Or IsNull(SrcFilename) Then
sSrcFilename = mvarSrcFilename
Else
sSrcFilename = CStr(SrcFilename)
End If
If IsMissing(DstFilename) Or IsNull(DstFilename) Then
sDstFilename = mvarDstFilename
Else
sDstFilename = CStr(DstFilename)
End If
If TransferType = FTP_TRANSFER_TYPE_UNKNOWN Then
lTransferType = mvarTransferType
Else
lTransferType = TransferType
End If
'hFind = FtpFindFirstFile(hConnect,
' sDstFilename, _
' pData, _
' INTERNET_FLAG_RELOAD Or INTERNET_FLAG_NO_CACHE_WRI
' 0&)
'
'If hFind Then
' PutOk = Overwrite
' 'clean up by closing the handles used in this routine
' Call InternetCloseHandle(hFind)
' hFind = 0
'Else
' If Err.LastDllError = ERROR_NO_MORE_FILES Then
' PutOk = True
' Else
' PutOk = False
' Call RaiseError
' End If
'End If
'
'If PutOk Then
' FileLen function could be a problem for files greater than 2GB, in which case
' it should be replaced with CreateFile, GetFileSizeEx, CloseHandle
FileSize = FileLen(sSrcFilename)
If FileSize < MaxShortCopySize Then
If FtpPutFile(hConnect, _
sSrcFilename, _
sDstFilename, _
lTransferType Or INTERNET_FLAG_RELOAD, _
0&) Then
RaiseEvent Progress(FileSize, FileSize, False)
Else
Call RaiseError
End If
Else
Call PutLongFile(sSrcFilename, sDstFilename, lTransferType, FileSize)
End If
'Else
' Err.Raise vbObjectError + 1, "FTP Put File", "Remote file already exists and 'Overwrite' flag is off !"
'End If
RaiseEvent Done
End Sub
Evidently, I had some problem with the overwrite flag not working.
Anthony
Oh, and one final note. I used:
Const MaxShortCopySize = 2048
But you can use what ever you consider appropriate.
Anthony
Const MaxShortCopySize = 2048
But you can use what ever you consider appropriate.
Anthony
Interesting...
ping
ASKER
Hi Anthony,
This is very interesting. I'll think your routines will work. However, a small (important) bit is missing :
Your RaiseEvent routine! Could you tell me what you do there ?
Thanks,
Steven
This is very interesting. I'll think your routines will work. However, a small (important) bit is missing :
Your RaiseEvent routine! Could you tell me what you do there ?
Thanks,
Steven
Sure. The code I posted is part of a class that I use to emulate the Mabry FTP control object model. It has over 30 Properties, Methods and Events. So this particular RaiseEvent fires an event (Progress) that notifies the client of bytes transferred. This allows the client to update a progress bar for example.
In summary, it is not required and would only work in a class module.
Anthony
In summary, it is not required and would only work in a class module.
Anthony
ASKER
Thanks, but why not use the whole class if it works fine.
Are you willing to share it?
And if so what conditions ?
I also need to do something about informing users how things are going.
Steven
Are you willing to share it?
And if so what conditions ?
I also need to do something about informing users how things are going.
Steven
You are welcome to it. It is made up of one main class and two supporting classes and over 1000 lines of code, so I do not think it appropriate to post here.
A word of caution I wrote this as a personal challenge. It is not as efficient as Mabry's FTP control. For one it is synchronous, as I understand that the alternative is near impossible using Visual Basic. So if you are considering an FTP control for an important task do your self a favor and buy a commercial product that is well supported and documented.
Anthony
A word of caution I wrote this as a personal challenge. It is not as efficient as Mabry's FTP control. For one it is synchronous, as I understand that the alternative is near impossible using Visual Basic. So if you are considering an FTP control for an important task do your self a favor and buy a commercial product that is well supported and documented.
Anthony
ASKER
Ok, maybe you could send it here :
steven@la-france.net
You're right about marbry, but the users of the sofware i'm writing donnot pay me anything (;-((), it's just a club for free-time.
So i'll have to do my thing without buying anything. It's all a question of time, if it takes me too long, ... Anyway with your help i might arrive like this.
Let me know how many points you consider appriopriate.
Thanks a lot,
Steven
steven@la-france.net
You're right about marbry, but the users of the sofware i'm writing donnot pay me anything (;-((), it's just a club for free-time.
So i'll have to do my thing without buying anything. It's all a question of time, if it takes me too long, ... Anyway with your help i might arrive like this.
Let me know how many points you consider appriopriate.
Thanks a lot,
Steven
ASKER CERTIFIED SOLUTION
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
ASKER
Thanks a lot Anthony
Hope i can return the favor one day.
Steven
Hope i can return the favor one day.
Steven