send file to an ftp server visual basic 6

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
xodosAsked:
Who is Participating?
I wear a lot of hats...

"The solutions and answers provided on Experts Exchange have been extremely helpful to me over the last few years. I wear a lot of hats - Developer, Database Administrator, Help Desk, etc., so I know a lot of things but not a lot about one thing. Experts Exchange gives me answers from people who do know a lot about one thing, in a easy to use platform." -Todd S.

aelatikCommented:
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
xodosAuthor Commented:
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
xodosAuthor Commented:
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
Ultimate Tool Kit for Technology Solution Provider

Broken down into practical pointers and step-by-step instructions, the IT Service Excellence Tool Kit delivers expert advice for technology solution providers. Get your free copy now.

xodosAuthor Commented:
but it deletes the records from the database
0
aelatikCommented:
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

Experts Exchange Solution brought to you by

Your issues matter to us.

Facing a tech roadblock? Get the help and guidance you need from experienced professionals who care. Ask your question anytime, anywhere, with no hassle.

Start your 7-day free trial
nffvrxqgrcfqvvcCommented:
'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
It's more than this solution.Get answers and train to solve all your tech problems - anytime, anywhere.Try it for free Edge Out The Competitionfor your dream job with proven skills and certifications.Get started today Stand Outas the employee with proven skills.Start learning today for free Move Your Career Forwardwith certification training in the latest technologies.Start your trial today
Microsoft Development

From novice to tech pro — start learning today.

Question has a verified solution.

Are you are experiencing a similar issue? Get a personalized answer when you ask a related question.

Have a better answer? Share it in a comment.