?
Solved

send file to an ftp server visual basic 6

Posted on 2005-03-07
6
Medium Priority
?
622 Views
Last Modified: 2013-11-25
dear sir ,
i want a visual basic 6 code which open an mdb file and select from the database a path to a jpg file (c:\images\1.jpg " this path is recorded in the database ") and send it to an ftp server ftp://192.168.0.1 username:admin password:1234
and when it sends a file its record will be deleted from the database,
thanks
0
Comment
Question by:xodos
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 3
  • 2
6 Comments
 
LVL 14

Expert Comment

by:aelatik
ID: 13476042
Just tested it and it worked with me, jou need to add "Microsoft Internet Transfer Control (INET) "  to your form to make it workv

   
    Const DATABASE_PATH As String = "c:\database.mdb"
    Const DATABASE_PROVIDER As String = "Microsoft.Jet.OLEDB.4.0"
    Const DATABASE_USER As String = ""
    Const DATABASE_PASS As String = ""
    Const DATABASE_TABLE As String = "FILES" ' a table called files
    Const DATABASE_FIELD As String = "FILENAME" ' a field called filename within the table files
   
    Const FTP_PORT As Integer = 21
    Const FTP_SITE As String = "192.168.0.1"
    Const FTP_USER As String = "admin"
    Const FTP_PASS As String = "1234"

    Dim FILES_TO_SEND As String
    Dim CON, RS As Object
   
    Function GetFileList()
        Set CON = CreateObject("ADODB.CONNECTION")
            CON.Open "PROVIDER=" & DATABASE_PROVIDER & ";DATA SOURCE=" & DATABASE_PATH & ";USER ID=" & DATABASE_USER & ";PASSWORD=" & DATABASE_PASS & ";"
        Set RS = CON.Execute("SELECT * FROM " & DATABASE_TABLE)
        While Not RS.EOF
            FILES_TO_SEND = FILES_TO_SEND & RS("FILENAME") & ";"
            RS.Movenext
        Wend
        RS.Close
        Set RS = Nothing
        SendAndDeleteFromDB
    End Function
   
    Function SendAndDeleteFromDB()
        Dim THE_FILES() As String
            THE_FILES() = Split(FILES_TO_SEND, ";")
        Dim I As Integer
       
        Inet1.URL = "ftp://" & FTP_SITE
        Inet1.UserName = FTP_USER
        Inet1.Password = FTP_PASS
        Inet1.RemotePort = 21
        Inet1.Protocol = icFTP

        For I = 0 To UBound(THE_FILES) - 1
            Inet1.Execute , "PUT " & THE_FILES(I) & " tempje.gfi"
            While Inet1.StillExecuting: DoEvents: Wend
            CON.Execute ("DELETE FROM " & DATABASE_TABLE & " WHERE " & DATABASE_FIELD & "='" & THE_FILES(I) & "'")
        Next
        Inet1.Execute , "QUIT"
    End Function
   
    Private Sub Form_Load()
        GetFileList
    End Sub
0
 

Author Comment

by:xodos
ID: 13476599
hello aelatik
i pasted the code and i think it works , but i found on the ftp server on the file tempje.gfi but without any picture ,
0
 

Author Comment

by:xodos
ID: 13477060
i put the code in a form , and i dropped the component inet1 to the form ,
i just saw in the ftp server a file called tempje.gfi
help please
0
 [eBook] Windows Nano Server

Download this FREE eBook and learn all you need to get started with Windows Nano Server, including deployment options, remote management
and troubleshooting tips and tricks

 

Author Comment

by:xodos
ID: 13477073
but it deletes the records from the database
0
 
LVL 14

Accepted Solution

by:
aelatik earned 2000 total points
ID: 13478481
Ok, i see. I gave you my testing version. Here you go :


Const DATABASE_PATH As String = "c:\database.mdb"
    Const DATABASE_PROVIDER As String = "Microsoft.Jet.OLEDB.4.0"
    Const DATABASE_USER As String = ""
    Const DATABASE_PASS As String = ""
    Const DATABASE_TABLE As String = "FILES" ' a table called files
    Const DATABASE_FIELD As String = "FILENAME" ' a field called filename within the table files
   
    Const FTP_PORT As Integer = 21
    Const FTP_SITE As String = "192.168.0.1"
    Const FTP_USER As String = "admin"
    Const FTP_PASS As String = "1234"

    Dim FILES_TO_SEND As String
    Dim CON, RS As Object
   
    Function GetFileList()
        Set CON = CreateObject("ADODB.CONNECTION")
            CON.Open "PROVIDER=" & DATABASE_PROVIDER & ";DATA SOURCE=" & DATABASE_PATH & ";USER ID=" & DATABASE_USER & ";PASSWORD=" & DATABASE_PASS & ";"
        Set RS = CON.Execute("SELECT * FROM " & DATABASE_TABLE)
        While Not RS.EOF
            FILES_TO_SEND = FILES_TO_SEND & RS("FILENAME") & ";"
            RS.Movenext
        Wend
        RS.Close
        Set RS = Nothing
        SendAndDeleteFromDB
    End Function
   
    Function SendAndDeleteFromDB()
        Dim THE_FILES() As String
            THE_FILES() = Split(FILES_TO_SEND, ";")
        Dim I As Integer
       
        Inet1.URL = "ftp://" & FTP_SITE
        Inet1.UserName = FTP_USER
        Inet1.Password = FTP_PASS
        Inet1.RemotePort = 21
        Inet1.Protocol = icFTP

        For I = 0 To UBound(THE_FILES) - 1
            Inet1.Execute , "PUT " & THE_FILES(I) & " " & Right(THE_FILES(I), InStr(1, StrReverse(THE_FILES(I)), "\") - 1)
            While Inet1.StillExecuting: DoEvents: Wend
            CON.Execute ("DELETE FROM " & DATABASE_TABLE & " WHERE " & DATABASE_FIELD & "='" & THE_FILES(I) & "'")
        Next
        Inet1.Execute , "QUIT"
    End Function
   
    Private Sub Form_Load()
        GetFileList
    End Sub
0
 
LVL 29

Expert Comment

by:nffvrxqgrcfqvvc
ID: 13479297
'add the following code to the form_declerations
'for FTP file uploads and downloads and deleting files

Const INTERNET_DEFAULT_FTP_PORT = 21            
Const INTERNET_SERVICE_FTP = 1
Const INTERNET_FLAG_PASSIVE = &H8000000          
Const INTERNET_OPEN_TYPE_PRECONFIG = 0                  
Const INTERNET_OPEN_TYPE_DIRECT = 1                      
Const INTERNET_OPEN_TYPE_PROXY = 3                        
Const INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = 4  
Const MAX_PATH = 260
Private Type FILETIME
    dwLowDateTime As Long
    dwHighDateTime As Long
End Type
Private Type WIN32_FIND_DATA
    dwFileAttributes As Long
    ftCreationTime As FILETIME
    ftLastAccessTime As FILETIME
    ftLastWriteTime As FILETIME
    nFileSizeHigh As Long
    nFileSizeLow As Long
    dwReserved0 As Long
    dwReserved1 As Long
    cFileName As String * MAX_PATH
    cAlternate As String * 14
End Type

Private Declare Function InternetCloseHandle Lib "wininet" (ByRef hInet 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
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 FtpSetCurrentDirectory Lib "wininet.dll" Alias "FtpSetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpGetCurrentDirectory Lib "wininet.dll" Alias "FtpGetCurrentDirectoryA" (ByVal hFtpSession As Long, ByVal lpszCurrentDirectory As String, lpdwCurrentDirectory As Long) As Long
Private Declare Function FtpCreateDirectory Lib "wininet.dll" Alias "FtpCreateDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpRemoveDirectory Lib "wininet.dll" Alias "FtpRemoveDirectoryA" (ByVal hFtpSession As Long, ByVal lpszDirectory As String) As Boolean
Private Declare Function FtpDeleteFile Lib "wininet.dll" Alias "FtpDeleteFileA" (ByVal hFtpSession As Long, ByVal lpszFileName As String) As Boolean
Private Declare Function FtpRenameFile Lib "wininet.dll" Alias "FtpRenameFileA" (ByVal hFtpSession As Long, ByVal lpszExisting As String, ByVal lpszNew As String) As Boolean
Private Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" (ByVal hConnect As Long, ByVal lpszRemoteFile As String, ByVal lpszNewFile As String, ByVal fFailIfExists As Long, ByVal dwFlagsAndAttributes As Long, ByVal dwFlags As Long, ByRef dwContext As Long) As Boolean
Private Declare Function FtpPutFile Lib "wininet.dll" Alias "FtpPutFileA" (ByVal hConnect As Long, ByVal lpszLocalFile As String, ByVal lpszNewRemoteFile As String, ByVal dwFlags As Long, ByVal dwContext As Long) As Boolean
Private Declare Function InternetGetLastResponseInfo Lib "wininet.dll" Alias "InternetGetLastResponseInfoA" (lpdwError As Long, ByVal lpszBuffer As String, lpdwBufferLength As Long) As Boolean
Private Declare Function FtpFindFirstFile Lib "wininet.dll" Alias "FtpFindFirstFileA" (ByVal hFtpSession As Long, ByVal lpszSearchFile As String, lpFindFileData As WIN32_FIND_DATA, ByVal dwFlags As Long, ByVal dwContent As Long) As Long
Private Declare Function InternetFindNextFile Lib "wininet.dll" Alias "InternetFindNextFileA" (ByVal hFind As Long, lpvFindData As WIN32_FIND_DATA) As Long
Const PassiveConnection As Boolean = True

Public Sub EnumFiles(hConnection As Long)
    Dim pData As WIN32_FIND_DATA, hFind As Long, lRet As Long
    'set the graphics mode to persistent
    Me.AutoRedraw = True
    'create a buffer
    pData.cFileName = String(MAX_PATH, 0)
    'find the first file
    hFind = FtpFindFirstFile(hConnection, "*.*", pData, 0, 0)
    'if there's no file, then exit sub
    If hFind = 0 Then Exit Sub
    'show the filename
    Me.Print Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
    Do
   
        pData.cFileName = String(MAX_PATH, 0)
 
        lRet = InternetFindNextFile(hFind, pData)
     
        If lRet = 0 Then Exit Do
       
        Me.Print Left(pData.cFileName, InStr(1, pData.cFileName, String(1, 0), vbBinaryCompare) - 1)
    Loop
    'close the search handle
    InternetCloseHandle hFind
End Sub

Sub ShowError()
    Dim lErr As Long, sErr As String, lenBuf As Long
    'get the required buffer size
    InternetGetLastResponseInfo lErr, sErr, lenBuf
    'create a buffer
    sErr = String(lenBuf, 0)
    'retrieve the last respons info
    InternetGetLastResponseInfo lErr, sErr, lenBuf
    'show the last response info
    MsgBox "Error " + CStr(lErr) + ": " + sErr, vbOKOnly + vbCritical
End Sub

'add a command button to form1
'add the following code inside the command button
'use any of the following to achieve whatever action you want, example: ftpgetfile downloads a file, ftpputfile uploads a file,ftpremovedirectory removes a directory on ftp server,ftpdeletefile deletes a file on ftp server
Dim hConnection As Long, hOpen As Long, sOrgPath  As String
    'open an internet connection
    hOpen = InternetOpen("FTP", INTERNET_OPEN_TYPE_PRECONFIG, vbNullString, vbNullString, 0)
    'connect to the FTP server
    hConnection = InternetConnect(hOpen, "your ftp server", INTERNET_DEFAULT_FTP_PORT, "your login", "your password", INTERNET_SERVICE_FTP, IIf(PassiveConnection, INTERNET_FLAG_PASSIVE, 0), 0)
    'create a buffer to store the original directory
    sOrgPath = String(MAX_PATH, 0)
    'get the directory
    FtpGetCurrentDirectory hConnection, sOrgPath, Len(sOrgPath)
   
    'FtpCreateDirectory hConnection, "database"
    'set the current directory to 'root/testing'
    FtpSetCurrentDirectory hConnection, "database"
    'upload the file 'test.htm'
    FtpPutFile hConnection, "C:\putfile.htm", "putfile.htm", FTP_TRANSFER_TYPE_UNKNOWN, 0
    'rename 'test.htm' to 'apiguide.htm'
    'FtpRenameFile hConnection, "test.htm", "test123.htm"
   
    EnumFiles hConnection
    'retrieve the file from the FTP server
    'FtpGetFile hConnection, "getfile.htm", "c:\savefile.htm", False, 0, FTP_TRANSFER_TYPE_UNKNOWN, 0
    'delete the file from the FTP server
    'FtpDeleteFile hConnection, "deletefile.htm"
    'set the current directory back to the root
    FtpSetCurrentDirectory hConnection, sOrgPath
 
   ' FtpRemoveDirectory hConnection, "removedirectory"
 
    InternetCloseHandle hConnection
 
    InternetCloseHandle hOpen
0

Featured Post

Free Tool: Subnet Calculator

The subnet calculator helps you design networks by taking an IP address and network mask and returning information such as network, broadcast address, and host range.

One of a set of tools we're offering as a way of saying thank you for being a part of the community.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Entering time in Microsoft Access can be difficult. An input mask often bothers users more than helping them and won't catch all typing errors. This article shows how to create a textbox for 24-hour time input with full validation politely catching …
This article describes how to use a set of graphical playing cards to create a Draw Poker game in Excel or VB6.
As developers, we are not limited to the functions provided by the VBA language. In addition, we can call the functions that are part of the Windows operating system. These functions are part of the Windows API (Application Programming Interface). U…
Get people started with the process of using Access VBA to control Excel using automation, Microsoft Access can control other applications. An example is the ability to programmatically talk to Excel. Using automation, an Access application can laun…

777 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question