Having a tough time with the Internet Transfer Control using FTP 4

[BobRodes]

I'm having trouble with the internet transfer control. I have the following code for testing:

Option Explicit

Private Sub Command1_Click()
Inet1.Execute "ftp://xx.xx.xx.xx", "GET /test/test.txt c:\temp\test.txt"
End Sub

Private Sub Inet1_StateChanged(ByVal State As Integer)
MsgBox State
If State = 12 Or State = 11 Then Inet1.Execute "ftp://xx.xx.xx.xx", "CLOSE"
End Sub

where inet1 is an internet transfer control on the form, and xx.xx.xx.xx is a valid ftp site. The test.txt file exists also, and is 25 bytes long. I find that sometimes this code works, and more often doesn't. It always seems to establish a connection, but then sometimes transfers the file, and sometimes returns an error, and sometimes doesn't return an error and also fails to transfer the file. I have never gotten a file of 250k to transfer.

Is this control not particularly robust, or are there things I need to know about it before using it in a production application effectively? If the former, does anyone have a suggestion of how to programmatically transfer files from an ftp site to a local client?

TIA

Bob

 

[yongbum]

I have the following batch file:

echo open 192.168.102.xxx > supftp.txt
echo super >> supftp.txt
echo enosh >> supftp.txt
echo prompt >> supftp.txt
echo mdelete * >> supftp.txt
echo ascii >> supftp.txt
echo put %1 >> supftp.txt
echo put c:\prt\mifalid.dat >> supftp.txt
echo bye >> supftp.txt
0d_0a_1a supftp.txt
%windir%\ftp -s:supftp.txt

which i use in my vb app:

retval = Shell("c:\prt\supftp.bat " & strRemote, 0)

seems to work ok - no messing around with ftp classes and modules, just input the actual commands to the ftp.exe utility installed on most window systems.
Hope this is of use to someone.

 

[BobRodes]

That's nice. I'll give it a try sometime.

Thanks for sharing,

Bob

 

[DonVee]

I need some ideas on how to use WinInet to HTTP GET a 8M MOV file directly to a file.

I found this but I am afraid I will overrun the PUT file buffer:

***********************************************

'Example: POST a Form

Dim h As HTTPClass
Set h = New HTTPClass

h.Fields("Username") = "Andrew"
h.Fields("Email") = "andrew@paradoxes.info"
h.Fields("Password") = "Secret"

If h.OpenHTTP("

http://www.paradoxes.info")

Then
Debug.Print h.SendRequest("test.asp", "POST")
End If

Set h = Nothing

'Example: Download an Image to file

Dim fh As Long
Dim h As HTTPClass

Set h = New HTTPClass

If h.OpenHTTP("

http://www.paradoxes.info")

Then
fh = FreeFile
Open App.Path & "\vbcode.jpg" For Binary As #fh
Put #fh, , h.SendRequest("/pics/vbcode.jpg", "GET")
Close #fh
End If

Set h = Nothing

***************************** Class:
VERSION 1.0 CLASS
BEGIN
MultiUse = -1 'True
Persistable = 0 'NotPersistable
DataBindingBehavior = 0 'vbNone
DataSourceBehavior = 0 'vbNone
MTSTransactionMode = 0 'NotAnMTSObject
END
Attribute VB_Name = "HTTPClass"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = True
Attribute VB_PredeclaredId = False
Attribute VB_Exposed = False
Option Explicit

Public Enum ePort
INTERNET_DEFAULT_HTTP_PORT = 80
INTERNET_DEFAULT_HTTPS_PORT = 443
End Enum

Private Const INTERNET_OPEN_TYPE_DIRECT = 1
Private Const INTERNET_SERVICE_HTTP = 3

Private Const INTERNET_FLAG_PRAGMA_NOCACHE = &H100
Private Const INTERNET_FLAG_KEEP_CONNECTION = &H400000
Private Const INTERNET_FLAG_SECURE = &H800000
Private Const INTERNET_FLAG_FROM_CACHE = &H1000000
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_FLAG_RELOAD = &H80000000

Private Const BUFFER_LENGTH As Long = 1024

Private Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" (ByVal Agent As String, ByVal AccessType As Long, ByVal ProxyName As String, ByVal ProxyBypass As String, ByVal Flags As Long) As Long
Private Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" (ByVal hInternetSession As Long, ByVal ServerName As String, ByVal ServerPort As Integer, ByVal UserName As String, ByVal Password As String, ByVal Service As Long, ByVal Flags As Long, ByVal Context As Long) As Long
Private Declare Function InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Boolean

Private Declare Function InternetReadFile Lib "wininet.dll" (ByVal hConnect As Long, ByVal Buffer As String, ByVal NumberOfBytesToRead As Long, NumberOfBytesRead As Long) As Boolean

Private Declare Function HttpOpenRequest Lib "wininet.dll" Alias "HttpOpenRequestA" (ByVal hHttpSession As Long, ByVal Verb As String, ByVal ObjectName As String, ByVal Version As String, ByVal Referer As String, ByVal AcceptTypes As Long, ByVal Flags As Long, Context As Long) As Long
Private Declare Function HttpSendRequest Lib "wininet.dll" Alias "HttpSendRequestA" (ByVal hHttpRequest As Long, ByVal Headers As String, ByVal HeadersLength As Long, ByVal sOptional As String, ByVal OptionalLength As Long) As Boolean

Private hHTTP As Long
Private hConnection As Long

Private Const FIELDS_BUFFER_LENGTH As Long = 10
Private Const FIELDS_NAME_INDEX As Long = 0
Private Const FIELDS_VALUE_INDEX As Long = 1

Private DontEncode(255) As Boolean

Private FieldCount As Long
Private mFields() As String

Public Property Let Fields(Name As String, Value As String)

mFields(FIELDS_VALUE_INDEX, GetFieldIndex(Name, True)) = Value

End Property

Public Property Get Fields(Name As String) As String

Dim l As Long

l = GetFieldIndex(Name, False)
If l > -1 Then
Fields = mFields(FIELDS_VALUE_INDEX, l)
End If

End Property

Public Function OpenHTTP(Server As String, Optional Port As ePort = INTERNET_DEFAULT_HTTP_PORT, Optional UserName As String, Optional Password As String) As Boolean

CloseHTTP

hHTTP = InternetOpen("HTTP Client", INTERNET_OPEN_TYPE_DIRECT, vbNullString, vbNullString, 0)
If hHTTP <> 0 Then
hConnection = InternetConnect(hHTTP, Server, INTERNET_DEFAULT_HTTP_PORT, UserName, Password, INTERNET_SERVICE_HTTP, 0, 0)
If hConnection <> 0 Then
OpenHTTP = True
Else
InternetCloseHandle hHTTP
hHTTP = 0
End If
End If

End Function

Public Sub CloseHTTP()

If hConnection <> 0 Then
InternetCloseHandle hConnection
End If

hConnection = 0

If hHTTP Then
InternetCloseHandle hHTTP
End If

hHTTP = 0

End Sub

Public Function SendRequest(ByVal File As String, Optional Method As String = "GET", Optional Referer As String, Optional Reload As Boolean = True) As String

Dim hRequest As Long
Dim r As Boolean
Dim Buffer As String
Dim Header As String
Dim Request As String
Dim POSTData As String
Dim Response As String
Dim Read As Long
Dim Flags As Long

Method = UCase$(Method)
Request = BuildRequest
Buffer = Space$(BUFFER_LENGTH)

If Len(Request) > 0 Then
If Method = "POST" Then
Header = "Content-Type: application/x-

http://www-form-urlencoded"

POSTData = Request
Else
File = File & "?" & Request
End If
End If

If Reload Then
Flags = Flags Or INTERNET_FLAG_PRAGMA_NOCACHE Or INTERNET_FLAG_RELOAD
End If

hRequest = HttpOpenRequest(hConnection, Method, File, "HTTP/1.1", "", 0, Flags, 0)
If hRequest <> 0 Then
If HttpSendRequest(hRequest, Header, Len(Header), POSTData, Len(POSTData)) Then
r = InternetReadFile(hRequest, Buffer, BUFFER_LENGTH, Read)
While r And (Read <> 0)
Response = Response & Left$(Buffer, Read)
r = InternetReadFile(hRequest, Buffer, BUFFER_LENGTH, Read)
Wend
End If
InternetCloseHandle hRequest
End If

SendRequest = Response

End Function

Private Function GetFieldIndex(Name As String, Optional Add As Boolean) As Long

Dim l As Long

For l = 0 To FieldCount - 1
If StrComp(Name, mFields(FIELDS_NAME_INDEX, l), vbTextCompare) = 0 Then
GetFieldIndex = l
Exit Function
End If
Next

If Add Then
If FieldCount = UBound(mFields, 2) Then
ReDim Preserve mFields(1, UBound(mFields, 2) + FIELDS_BUFFER_LENGTH)
End If
mFields(FIELDS_NAME_INDEX, FieldCount) = Name
GetFieldIndex = FieldCount
FieldCount = FieldCount + 1
Else
GetFieldIndex = -1
End If

End Function

Private Function BuildRequest() As String

Dim l As Long
Dim s As String

For l = 0 To FieldCount - 1
s = s & URLEncode(mFields(FIELDS_NAME_INDEX, l)) & "=" & URLEncode(mFields(FIELDS_VALUE_INDEX, l)) & "&"
Next

If Len(s) > 0 Then
BuildRequest = Left$(s, Len(s) - 1)
End If

End Function

Public Function URLEncode(Data As String) As String

Dim l As Long
Dim b() As Byte
Dim s As String
Dim c As String

b = Data
'This is fine for encoding small strings
'To encode large ones I suggest you replace s with the String Class
For l = 0 To UBound(b) Step 2
If DontEncode(b(l)) Then
s = s & Chr(b(l))
Else
c = Hex(b(l))
While Len(c) < 2
c = "0" & c
Wend
s = s & "%" & c
End If
Next

URLEncode = s

End Function

Private Sub Class_Initialize()

Dim l As Long

ReDim mFields(1, FIELDS_BUFFER_LENGTH)

For l = Asc("0") To Asc("9")
DontEncode(l) = True
Next
For l = Asc("a") To Asc("z")
DontEncode(l) = True
Next
For l = Asc("A") To Asc("Z")
DontEncode(l) = True
Next

End Sub

Private Sub Class_Terminate()

Erase mFields

End Sub

 

[BobRodes]

I didn't read your code, but look at GetChunk.