title image


Smiley Re: FTPCommant
Hi!FTPModul.bas :Option ExplicitDim hOpen As Long, hConnection As Long, hFile As LongDim dwType As LongDim dwSeman As LongDeclare Function FileTimeToLocalFileTime Lib "kernel32" (lpFileTime As Any, lpLocalFileTime As Any) As LongPublic Const INTERNET_OPEN_TYPE_PRECONFIG = 0Public Const INTERNET_INVALID_PORT_NUMBER = 0Public Const INTERNET_SERVICE_FTP = 1Public Const FTP_TRANSFER_TYPE_BINARY = &H2Public Const FTP_TRANSFER_TYPE_ASCII = &H1Public Declare Function FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" _ (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As BooleanPublic Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" _ (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As BooleanPublic Declare Function InternetWriteFile Lib "wininet.dll" _(ByVal hFile As Long, ByRef sBuffer As Byte, ByVal lNumBytesToWite As Long, _dwNumberOfBytesWritten As Long) As IntegerPublic Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" _(ByVal hFtpSession As Long, ByVal sBuff As String, ByVal Access As Long, ByVal Flags As Long, ByVal Context As Long) As LongPublic Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" _(ByVal hFtpSession As Long, ByVal lpszLocalFile As String, _ ByVal lpszRemoteFile As String, _ ByVal dwFlags As Long, ByVal dwContext As Long) As BooleanPublic Declare Function FtpDeleteFile Lib "wininet.dll" _ Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, _ ByVal lpszFileName As String) As BooleanPublic Declare Function InternetCloseHandle Lib "wininet.dll" _(ByVal hInet As Long) As LongPublic 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 LongPublic 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 LongPublic Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _(ByVal hFtpSession As Long, ByVal lpszRemoteFile As String, _ ByVal lpszNewFile As String, ByVal fFailIfExists As Boolean, ByVal dwFlagsAndAttributes As Long, _ ByVal dwFlags As Long, ByVal dwContext As Long) As BooleanConst rDayZeroBias As Double = 109205# ' Abs(CDbl(#01-01-1601#))Const rMillisecondPerDay As Double = 10000000# * 60# * 60# * 24# / 10000#Declare Function InternetGetLastResponseInfo Lib "wininet.dll" _ Alias "InternetGetLastResponseInfoA" _ (ByRef lpdwError As Long, _ ByVal lpszErrorBuffer As String, _ ByRef lpdwErrorBufferLength As Long) As BooleanDeclare Function FormatMessage Lib "kernel32" Alias "FormatMessageA" _(ByVal dwFlags As Long, ByVal lpSource As Long, ByVal dwMessageId As Long, _ ByVal dwLanguageId As Long, ByVal lpBuffer As String, ByVal nSize As Long, _ Arguments As Long) As LongDeclare Function GetModuleHandle Lib "kernel32" Alias "GetModuleHandleA" (ByVal lpLibFileName As String) As LongFunction Win32ToVbTime(ft As Currency) As Date Dim ftl As Currency ' Call API to convert from UTC time to local time If FileTimeToLocalFileTime(ft, ftl) Then ' Local time is nanoseconds since 01-01-1601 ' In Currency that comes out as milliseconds ' Divide by milliseconds per day to get days since 1601 ' Subtract days from 1601 to 1899 to get VB Date equivalent Win32ToVbTime = CDate((ftl / rMillisecondPerDay) - rDayZeroBias) Else MsgBox Err.LastDllError End IfEnd FunctionPublic Function FtpUpload(LokaleDatei As String, ServerUp As String, Verzeichnisn As String) As Boolean 'Initaliesieren dwType = FTP_TRANSFER_TYPE_BINARY dwSeman = 0 hConnection = 0 'Prüfe If InStr(Verzeichnisn, "\") 0 Then Verzeichnisn = Replace(Verzeichnisn, "\", "/") If Right(Verzeichnisn, 1) "/" Then Verzeichnisn = Verzeichnisn + "/" If Left(Verzeichnisn, 1) = "/" Then Verzeichnisn = Right(Verzeichnisn, Len(Verzeichnisn) - 1) If InStr(Verzeichnisn, "//") 0 Then ErrorOut 21, "Üngültiges Verzeichnis!" FtpUpload = False Exit Function End If If Dir(LokaleDatei) = "" Then ErrorOut 21, "Uploaddatei nicht gefunden!" FtpUpload = False Exit Function End If 'OnLoad hOpen = InternetOpen("WebCam", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0) If hOpen = 0 Then ErrorOut Err.LastDllError, "InternetOpen" FtpUpload = False Exit Function End If 'Verbinden If Verbinden = False Then FtpUpload = False GoTo EndeFtp: End If 'Upload 'Verzeichnis auswählen If Verzeichnis(Verzeichnisn) = False Then FtpUpload = False GoTo EndeFtp: End If 'Datei uploaden If DateiUpl(LokaleDatei, ServerUp) = False Then FtpUpload = False GoTo EndeFtp: End If 'Trennen If Trennen = False Then FtpUpload = False GoTo EndeFtp: End If 'Clear FtpUpload = TrueEndeFtp: InternetCloseHandle hOpenEnd FunctionPrivate Sub ErrorOut(ByVal dwError As Long, ByRef szFunc As String) frmMain.List1.Text = frmMain.List1.Text + CStr(dwError) + ": " + szFunc + vbCrLfEnd SubPrivate Function Verbinden() As Boolean If hConnection 0 Then InternetCloseHandle hConnection End If hConnection = InternetConnect(hOpen, frmMain.Text1(0).Text, INTERNET_INVALID_PORT_NUMBER, _ frmMain.Text1(1).Text, frmMain.Text1(2).Text, INTERNET_SERVICE_FTP, dwSeman, 0) If hConnection = 0 Then ErrorOut Err.LastDllError, "InternetConnect" Verbinden = False Else ErrorOut 21, "Connected!" Verbinden = True End IfEnd FunctionPrivate Function Verzeichnis(Verzeichni As String) As Boolean If (FtpSetCurrentDirectory(hConnection, Verzeichni) = False) Then ErrorOut Err.LastDllError, "FtpSetCurrentDirectory" Verzeichnis = False Else ErrorOut 21, "Directory is changed to " & Verzeichni Verzeichnis = True End IfEnd FunctionPrivate Function DateiUpl(OFFline As String, ONline As String) As Boolean If (FtpPutFile(hConnection, OFFline, ONline, dwType, 0) = False) Then ErrorOut Err.LastDllError, "FtpPutFile" DateiUpl = False Else ErrorOut 21, "File transfered!" DateiUpl = True End IfEnd FunctionPrivate Function Trennen() As Boolean If hConnection 0 Then InternetCloseHandle hConnection End If hConnection = 0 ErrorOut 21, "Disconnected."End FunctionMr. SICQ #67858520

geschrieben von

Login

E-Mail:
  

Passwort:
  

Beitrag anfügen

Symbol:
 
 
 
 
 
 
 
 
 
 
 
 
 

Überschrift: