[es] - kod za visual basic

Eurora3D Team
Nebojsa - Programer & Vodja tima
Beograd

Član broj: 120376
Poruke: 900
91.148.114.*

+7 Profil

^{07.12.2007. u 21:27 - pre 199 meseci}

Ovaj kod ispod salje podatke na FTP server
Za citanje fajla upotrebi funkciju koju ti je dao @The_End_is_close
Na formu stavi jedan TextBox Text1 (za unos teksta koji ce biti poslat) i jedno CommandButton Command1.
Prekopiraj kod u kod sekciju forme i ispravi parametre za tvoj FTP server u Command1_Click subrutini.
Pozdrav

Code:

'(c) Eurora3D 2007
Const FTP_TRANSFER_TYPE_UNKNOWN As Long = &H0
Const FTP_TRANSFER_TYPE_ASCII As Long = &H1
Const FTP_TRANSFER_TYPE_BINARY  As Long = &H2
Const INTERNET_FLAG_RAW_DATA = &H40000000
Const INTERNET_FLAG_EXISTING_CONNECT = &H20000000
Const INTERNET_OPEN_TYPE_DIRECT = 1
Const INTERNET_FLAG_NO_CACHE_WRITE = &H4000000
Const INTERNET_SERVICE_FTP = 1
Const GENERIC_WRITE = &H40000000
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 pub_lngInternetSession 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 InternetCloseHandle Lib "wininet.dll" (ByVal hInet As Long) As Integer
Private Declare Function FtpOpenFile Lib "wininet.dll" Alias "FtpOpenFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String, ByVal fdwAccess As Long, ByVal dwFlags As Long, ByVal dwContext As Long) As Long
Private Declare Function InternetWriteFile Lib "wininet.dll" (ByVal hFile As Long, ByVal sBuffer As String, ByVal lNumBytesToWrite As Long, dwNumberOfBytesWritten As Long) As Integer

Public Function UploadToFTP(WebSite As String, FTPServer As String, UserName As String, Password As String, FileName As String, Data As String) As Boolean
On Error GoTo err
Dim Service As Long, hFile As Long, nRet As Long
Dim Adresa As String, ID As String, Pass As String, Port As Integer
Adresa = FTPServer
ID = UserName
Pass = Password
Port = 21
Transfer = FTP_TRANSFER_TYPE_BINARY
Service = INTERNET_FLAG_EXISTING_CONNECT
'conn
session = InternetOpen(WebSite, INTERNET_OPEN_TYPE_DIRECT, "", "", INTERNET_FLAG_NO_CACHE_WRITE)
If session <> 0 Then
    server = InternetConnect(session, Adresa, Port, ID, Pass, INTERNET_SERVICE_FTP, Service, &H0)
    If server = 0 Then
     UploadToFTP = False
     Exit Function
    End If
Else
    InternetCloseHandle session
     UploadToFTP = False
     Exit Function
End If
'file transfer
hFile = FtpOpenFile(server, FileName, GENERIC_WRITE, FTP_TRANSFER_TYPE_BINARY, 0)
If hFile = 0 Then
   InternetCloseHandle server
   InternetCloseHandle session
   UploadToFTP = False
   Exit Function
End If
If InternetWriteFile(hFile, Data, Len(Data), nRet) = 0 Then
    InternetCloseHandle server
    InternetCloseHandle session
    UploadToFTP = False
    Exit Function
End If
'
InternetCloseHandle hFile
InternetCloseHandle server
InternetCloseHandle session

UploadToFTP = True
Exit Function
err:
UploadToFTP = False
Debug.Print err.Description
End Function

'KORISCENJE FUNKCIJE UploadToFTP
'Prvi parametar - http adresa sajta, sa ili bez http:// na pocetku, Ako nemate sajt stavite adresu FTP servera ovde
'Drugi parametar - adresa ftp servera sa ili bez ftp:// na pocetku
'Treci parametar - FTP UserName
'Cetvrti parametar - FTP Password
'Peti parametar - puna putanja do fajla uljucuci i root folder i / na pocetku i fajl ekstenziju na kraju, sve posle ftp://myserver.com
'Root folder je obicno www, ali moze da bude i drugacije nazvan
'Sesti parametar - Podatci fajla u String bufferu

Private Sub Command1_Click()
'Koriscenje, naravno ovi parametri su pogesni
'Peti parametar je sadrzaj text boxa ali moze da bude bilo sta (npr fajl ucitan sa HD-a u String buffer)
Dim ret As Boolean
ret = UploadToFTP("http://www.eurora3d.com", "ftp://ftp.eurora3d.com", "UserNeme", "PassWord", "/www/myfiles/testfile.txt", Text1.Text)
'ili
'ret = UploadToFTP("ftp://ftp.eurora3d.com", "ftp://ftp.eurora3d.com", "UserNeme", "PassWord", "/www/myfiles/testfile.txt", Text1.Text)
End Sub

HomePage http://www.eurora3d.com

Odgovor na temu