FTP Up- / Download - Lösungen desucht

18/03/2013 - 10:24 von Wilfried Dietrich | Report spam
Hallo Newsgroup,

ich möchte Dateien, ins besondere XML-Dateien, auf einen entfernten
FTP-Server (mit Benutzername-, Passwortangabe etc.) hochladen.
Spàter sollen dann auch àhnliche Dateien von diesem Server herunter geladen werden.

Da einige Dateien auch mal recht groß werden könnten, fànde ich es schön
wenn einen Fortschrittsanzeige enthalten wàre.

Was empfehlt Ihr?
Hat jemand besonders gute Erfahrungen mit ... gemacht?

MS Internet Transfer Control 6.0
wininet.DLL
Winsock
wput.exe...
???


Bin für jeden guten Tipp und Codebeispiele dankbar.

Gruß
Wilfried
 

Lesen sie die antworten

#1 G.Wietzorek
18/03/2013 - 16:10 | Warnen spam
Am 18.03.2013 10:24, schrieb Wilfried Dietrich:
Hallo Newsgroup,

ich möchte Dateien, ins besondere XML-Dateien, auf einen entfernten
FTP-Server (mit Benutzername-, Passwortangabe etc.) hochladen.
Spàter sollen dann auch àhnliche Dateien von diesem Server herunter geladen werden.

Da einige Dateien auch mal recht groß werden könnten, fànde ich es schön
wenn einen Fortschrittsanzeige enthalten wàre.



Verwende seit Jahren eine eigene FTP Klasse, die das seither sauber
macht und die wininet.dll verwendet. Um eine Fortschrittsanzeige
einzubinden, verwende ich für Down- bwz. Upload Internetreadfile /
InternetwriteFile mit Datenblöcken und löse nach jedem Datenblock
einfach ein Ereignis aus, das dem Aufrufer Gesamtgröße und bereits
geladene / gesendete Größe anzeigt. Das ganze ist sehr simpel zu
realisieren. Das Grundgerüst hatte ich seinerzeit mal aus dem Internet -
keine Ahnung mehr woher.

Der folgende Code ist als Beispiel gedacht... Klasseninterne
Funktionsaufrufe hab ich einfach mal alle (hoffe ich) auskommentiert.
Variable mit m_ am Anfang sind Klassenvariable, die durch Properties
gesetzt werden, sollten selbsterklàrend sein... Musste einiges
zusammenstreichen/ umschreiben, da die Klasse sehr viel mehr macht.
Möglicherweise hab ich auch etwas zu viel hier herein kopiert - wirst Du
merken. Wenn Dir etwas unklar bleibt, einfach fragen.

############################################################################
Private Const MAX_PATH = 260
Private Const INTERNET_FLAG_RELOAD = &H80000000
Private Const NO_ERROR = 0
Private Const FILE_ATTRIBUTE_OFFLINE = &H1000
Private Const INTERNET_FLAG_PASSIVE = &H8000000
Private Const FORMAT_MESSAGE_FROM_HMODULE = &H800

Private Type WIN32_FIND_DATA
dwFileAttributes As Long
ftCreationTime As Currency
ftLastAccessTime As Currency
ftLastWriteTime As Currency
nFileSizeHigh As Long
nFileSizeLow As Long
dwReserved0 As Long
dwReserved1 As Long
cFileName As String * MAX_PATH
cAlternate As String * 14
End Type

Private Const GENERIC_READ = &H80000000
Private Const GENERIC_WRITE = &H40000000
Private Const INTERNET_OPEN_TYPE_PRECONFIG = 0
Private Const INTERNET_INVALID_PORT_NUMBER = 0
Private Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Private Const INTERNET_SERVICE_FTP = 1
Private Const FTP_TRANSFER_TYPE_BINARY = &H2
Private Const FTP_TRANSFER_TYPE_ASCII = &H1
Private Declare Function InternetWriteFile Lib "wininet.dll" _
(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As
Long, _
dwNumberOfBytesWritten As Long) As Integer
Private Declare Function InternetReadFile Lib "wininet.dll" _
( _
ByVal hFile As Long, _
lpBuffer As Any, _
ByVal dwNumberOfBytesToRead As Long, _
ByRef lpdwNumberOfBytesRead As Long) As Integer
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
Public Event ProgressLoadUp(ByVal current As Double, ByVal all As Double)
Public Event ProgressLoadDown(ByVal current As Double, ByVal all As Double)
Public Event NextAction(ByVal ThisAction$)
Public Event ServerResponse(ByVal response$)
Public Event Error(ByVal ErrDescription$, ByVal Errnum&)

Private hOpen As Long
Private hConnection As Long
Private hFile As Long
Private dwSeman As Long

Private m_TransferType As Long
Private m_user As String
Private m_pwd As String
Private m_ftpserver As String
Private m_nomessages As Boolean
Private m_errinfo As String
Private m_errnum As Long

Private m_cancel As Boolean

Public Function OpenConnection(Optional Server, Optional User, Optional
Password) As Boolean
Dim cserver$
Dim cuser$
Dim cpwd$
ClearErrors
If IsMissing(Server) Then cserver = m_ftpserver
If IsMissing(User) Then cuser = m_user
If IsMissing(Password) Then cpwd = m_pwd
RaiseEvent NextAction("Open Connection (" & cserver & ", " & cuser
& ", PWD=*hidden*)")
hOpen = InternetOpen("SimpleFTP", INTERNET_OPEN_TYPE_PRECONFIG,
vbNullString, vbNullString, 0)
If hOpen = 0 Then
'ErrorOut Err.LastDllError, "InternetOpen"
Exit Function
End If
If hConnection <> 0 Then
InternetCloseHandle hConnection
End If
hConnection = InternetConnect(hOpen, cserver,
INTERNET_INVALID_PORT_NUMBER, cuser, cpwd, INTERNET_SERVICE_FTP, dwSeman, 0)
If hConnection = 0 Then
'ErrorOut Err.LastDllError, "InternetConnect"
Exit Function
Else
'IsResponse
OpenConnection = True
End If
End Function

Public Function PutFileCallback(ByVal localFilename$, ByVal
remotefilename$) As Boolean
Dim data(8192) As Byte ' array of 8193 elements 0 to 8192
Dim written As Long
Dim Sum As Long
Dim j As Long
Dim ssize As Long
Dim fnum&
Dim oldtype As CTransfer_Type
RaiseEvent NextAction("PutFile " & localFilename & " --> " &
remotefilename)
oldtype = m_Transfertype
If oldtype = FTP_Transfer_Auto Then
'oldtype = GetAutoType(localFilename)
End If
'ClearErrors
If hConnection = 0 Then
'VBErrorOut Cmd_Without_Connection, "Keine geöffnete
Verbindung", "PutFileCallback"
Exit Function
End If
Sum = 0
j = 0
hFile = FtpOpenFile(hConnection, remotefilename, GENERIC_WRITE,
oldtype Or INTERNET_FLAG_NO_CACHE_WRITE, 0)
If hFile = 0 Then
'ErrorOut Err.LastDllError, "PutFileCallback"
Exit Function
End If
'IsResponse
On Error Resume Next
fnum = FreeFile
Open localFilename For Input As #fnum
If Err Then
InternetCloseHandle hFile
'VBErrorOut Err.Number, Err.Description, "PutfileCallback"
Exit Function
End If
Close #fnum
Open localFilename For Binary Access Read As #fnum
ssize = LOF(fnum)
For j = 1 To ssize \ 8193
Get #fnum, , data
If (InternetWriteFile(hFile, data(0), 8193, written) = 0) Then
'ErrorOut Err.LastDllError, "PutFileCallback"
InternetCloseHandle hFile
Exit Function
End If
RaiseEvent ProgressLoadUp(Sum, ssize)
DoEvents
If m_cancel Then
RaiseEvent Error("Abbruch durch Benutzer", vbObjectError)
GoTo out
End If
Sum = Sum + 8193
Next j
Get #fnum, , data
If (InternetWriteFile(hFile, data(0), ssize Mod 8193, written) = 0)
Then
'ErrorOut Err.LastDllError, "PutFile"
InternetCloseHandle hFile
Exit Function
End If
Sum = Sum + (ssize Mod 8193)
RaiseEvent ProgressLoadUp(Sum, ssize)
PutFileCallback = True
out:
on error resume next
Close #fnum
InternetCloseHandle (hFile)
'IsResponse
err.clear
End Function

Public Function GetFileCallback(ByVal localFilename$, ByVal
remotefilename$) As Boolean
Dim data() As Byte ' array of 8193 elements 0 to 8192
Dim written As Long
Dim Sum As Long
Dim j As Long
Dim ssize As Double
Dim fnum&
Dim filedir$
Dim Filename$
Dim f As files
Dim oldtype As CTransfer_Type
RaiseEvent NextAction("GetFile " & remotefilename & " --> " &
localFilename)
oldtype = m_TransferType
If oldtype = FTP_Transfer_Auto Then
'oldtype = GetAutoType(localFilename)
End If
ClearErrors
If hConnection = 0 Then
'VBErrorOut Cmd_Without_Connection, "Keine geöffnete
Verbindung", "GetFileCallback"
Exit Function
End If
ReDim data(8192)
On Error Resume Next
ssize = GetFilesize(remotefilename)
If ssize=0 Then Exit Function
Sum = 0
j = 0
' for ASCII files use FTP_TRANSFER_TYPE_ASCII
hFile = FtpOpenFile(hConnection, remotefilename, GENERIC_READ,
oldtype Or INTERNET_FLAG_RELOAD, 0)
If hFile = 0 Then
'ErrorOut Err.LastDllError, "GetFileCallback"
Exit Function
End If
'IsResponse
On Error Resume Next
fnum = FreeFile
Open localFilename For Output As #fnum
If Err Then
InternetCloseHandle hFile
'VBErrorOut Err.Number, Err.Description, "GetFileCallback"
Exit Function
End If
Close #fnum
Open localFilename For Binary Access Write As #fnum
Do
If (InternetReadFile(hFile, data(0), 8193, written) = 0) Then
'ErrorOut Err.LastDllError, "GetFileCallback"
close #fnum
InternetCloseHandle hFile
Exit Function
End If
Sum = Sum + written
RaiseEvent ProgressLoadDown(Sum, ssize)
If written = 0 Then Exit Do
If written < 8193 Then
ReDim Preserve data(written - 1)
End If
Put #fnum, , data
ReDim data(8192)
DoEvents
If m_cancel Then
RaiseEvent Error("Abbruch durch Benutzer", vbObjectError)
goto out
End If
Loop
GetFileCallback = True
out:
on error resume next
Close #fnum
InternetCloseHandle (hFile)
'IsResponse
err.clear
End Function

Private Function getFileSize(byval RemoteFilename$) as double
Const maxdword = 4294967295#
Dim hFind As Long
Dim pData As WIN32_FIND_DATA
hFind = FtpFindFirstFile(hConnection, RemoteFilename, pData,
ATTRIBUTE_NORMAL, 0)
If hFind = 0 Then
else
getFileSize=(pdata.nfilesizehigh * (maxdword + 1)) + pdata.nfilesizelow
end if
end function

###############################################################

Gert

"Probleme kann man niemals mit derselben Denkweise lösen, durch die sie
entstanden sind."
Albert Einstein

Ähnliche fragen