Announcement

Collapse

Forum Guidelines

This forum is for finished source code that is working properly. If you have questions about this or any other source code, please post it in one of the Discussion Forums, not here.
See more
See less

Unattended FTP file download

Collapse
X
 
  • Filter
  • Time
  • Show
Clear All
new posts

  • PBWin/PBCC Unattended FTP file download

    Code:
    '------------------------------------------------
    '
    ' Unattended FTP File Download
    '
    ' May 22nd, 2000
    '
    ' Developed under WinNT 4.0 SP5
    ' WININET.DLL Version 5.00.2314.1003
    '
    ' Target: PB/CC V2.0, PB/DLL V6.0
    '
    ' Public Domain - Your own risk
    '
    ' Notes:
    '  Will launch the default Internet connection
    '  dialup as written.
    '------------------------------------------------
    #COMPILE EXE
    #DIM ALL
    #INCLUDE "WIN32API.INC"
    '
    ' Access types
    %INTERNET_OPEN_TYPE_PRECONFIG                   = &H0   ' use registry configuration
    %INTERNET_OPEN_TYPE_DIRECT                      = &H1   ' direct TO net
    %INTERNET_OPEN_TYPE_PROXY                       = &H3   ' via named proxy
    %INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = &H4   ' prevent USING java/script/INS
    ' Service types
    %INTERNET_SERVICE_FTP    = &H1
    %INTERNET_SERVICE_GOPHER = &H2
    %INTERNET_SERVICE_HTTP   = &H3
    ' Port definitions
    %INTERNET_INVALID_PORT_NUMBER  = 0          ' use the protocol-specific DEFAULT
    %INTERNET_DEFAULT_FTP_PORT     = 21         ' DEFAULT FOR FTP servers
    %INTERNET_DEFAULT_GOPHER_PORT  = 70         '    "     "  gopher "
    %INTERNET_DEFAULT_HTTP_PORT    = 80         '    "     "  HTTP   "
    %INTERNET_DEFAULT_HTTPS_PORT   = 443        '    "     "  HTTPS  "
    %INTERNET_DEFAULT_SOCKS_PORT   = 1080       ' DEFAULT FOR SOCKS firewall servers.
    %INTERNET_FLAG_PASSIVE         = &H8000000  ' used FOR FTP connections
    ' File transfer methods
    %FTP_TRANSFER_TYPE_UNKNOWN     = &H0
    %FTP_TRANSFER_TYPE_ASCII       = &H1
    %FTP_TRANSFER_TYPE_BINARY      = &H2
    '
    DECLARE FUNCTION InternetOpen LIB "wininet.dll" ALIAS "InternetOpenA" _
            (lpszAgent AS LONG, _        ' Pointer to the calling entity
             dwAccessType AS LONG, _     ' Type of access required
             lpszProxyName AS LONG, _    ' Pointer to the proxy's name
             lpszProxyBypass AS LONG, _  ' Pointer to addresses to bypass proxy
             dwFlags AS LONG) AS LONG    ' Unsigned long integer
    ' Failure: %NULL, Success: Handle to the connection
    DECLARE FUNCTION InternetConnect LIB "wininet.dll" ALIAS "InternetConnectA" _
            (hInternet AS LONG, _
             lpszServerName AS LONG, _
             nServerPort AS LONG, _
             lpszUserName AS LONG, _
             lpszPassword AS LONG, _
             dwService AS LONG, _
             dwFlags AS LONG, _
             dwContext AS LONG) AS LONG
    DECLARE FUNCTION FtpGetFile LIB "wininet.dll" ALIAS "FtpGetFileA" _
            (hConnect AS LONG, _
             lpszRemoteFile AS LONG, _
             lpszNewFile AS LONG, _
             fFailIfExists AS LONG, _
             dwFlagsAndAttributes AS LONG, _
             dwFlags AS LONG, _
             dwContext AS LONG) AS LONG
    DECLARE FUNCTION InternetCloseHandle LIB "wininet.dll" ALIAS "InternetCloseHandle" _
            (hInternet AS LONG) AS LONG
    '
    ' Globals
    GLOBAL hIOpen    AS LONG
    GLOBAL hIConnect AS LONG
    '
    FUNCTION PBMAIN()
        '
        LOCAL Agent         AS ASCIIZ * 256
        LOCAL TheFtpServer  AS ASCIIZ * 256
        LOCAL rsvp          AS LONG
        LOCAL RemoteFile    AS ASCIIZ * 256
        LOCAL LocalFile     AS ASCIIZ * 256
        '
        Agent = "PB/DLL WinInet"   ' <== customize HTTP response with this
        '
        ' Open an Internet session as predefined in the registry
        hIOpen = InternetOpen(BYVAL VARPTR(Agent), _
                              BYVAL %INTERNET_OPEN_TYPE_PRECONFIG, _
                              BYVAL %NULL, _
                              BYVAL %NULL, _
                              BYVAL 0)
        ' If it fails exit
        IF hIOpen = %NULL THEN
           MSGBOX "Could not open an Internet connection"
           EXIT FUNCTION
        END IF
        '
        TheFtpServer = "152.127.113.2"   ' <=== your FTP server here
        hIConnect = InternetConnect(BYVAL hIOpen, _
                                    BYVAL VARPTR(TheFtpServer), _
                                    BYVAL %INTERNET_INVALID_PORT_NUMBER, _
                                    BYVAL %NULL, _
                                    BYVAL %NULL, _
                                    BYVAL %INTERNET_SERVICE_FTP, _
                                    BYVAL 0, _
                                    BYVAL 0)
        IF hIConnect = %NULL THEN
           InternetCloseHandle(hIOpen)
           MSGBOX "FTP Connect Failed  " & STR$(hIConnect)
           EXIT FUNCTION
        END IF
        '
        RemoteFile = "/utilities/dat-4067.zip"  ' <== the file to GET
        LocalFile  = "C:\TEMP\dat-4067.zip"     ' <== where you want to PUT it
        rsvp = FtpGetFile(BYVAL hIConnect, _
                          BYVAL VARPTR(RemoteFile), _
                          BYVAL VARPTR(LocalFile), _
                          BYVAL %FALSE, _
                          BYVAL %FILE_ATTRIBUTE_NORMAL, _
                          BYVAL %FTP_TRANSFER_TYPE_UNKNOWN, _
                          BYVAL 0)
        IF rsvp = %FALSE THEN
           MSGBOX "File Transfer failed."
        END IF
        '
        ' Close all the handles
        InternetCloseHandle(hIConnect)
        InternetCloseHandle(hIOpen)
    END FUNCTION

  • #2
    Code:
    The only modification I made was to add the username and password
    for secure sites, which sorta makes it "NOT unattended", VERY excellent code John.
    This is a PBCC 2.0 application, may work with 1.x
    
    
    '------------------------------------------------
    '
    ' Unattended FTP File Download (Sorta)
    '
    ' May 24nd, 2000
    '
    ' Developed under WinNT 4.0 SP5
    ' WININET.DLL Version 5.00.2314.1003
    '
    ' Target: PB/CC V2.0, PB/DLL V6.0
    '
    ' Public Domain - Your own risk
    '
    ' Notes:
    ' Will launch the default Internet connection
    ' dialup as written.
    '------------------------------------------------
    #Compile Exe
    #Dim All
    #Include "WIN32API.INC"
    '
    ' Access types
    %INTERNET_OPEN_TYPE_PRECONFIG = &H0 ' use registry configuration
    %INTERNET_OPEN_TYPE_DIRECT = &H1 ' direct TO net
    %INTERNET_OPEN_TYPE_PROXY = &H3 ' via named proxy
    %INTERNET_OPEN_TYPE_PRECONFIG_WITH_NO_AUTOPROXY = &H4 ' prevent USING java/script/INS
    ' Service types
    %INTERNET_SERVICE_FTP = &H1
    %INTERNET_SERVICE_GOPHER = &H2
    %INTERNET_SERVICE_HTTP = &H3
    ' Port definitions
    %INTERNET_INVALID_PORT_NUMBER = 0 ' use the protocol-specific DEFAULT
    %INTERNET_DEFAULT_FTP_PORT = 21 ' DEFAULT FOR FTP servers
    %INTERNET_DEFAULT_GOPHER_PORT = 70 ' " " gopher "
    %INTERNET_DEFAULT_HTTP_PORT = 80 ' " " HTTP "
    %INTERNET_DEFAULT_HTTPS_PORT = 443 ' " " HTTPS "
    %INTERNET_DEFAULT_SOCKS_PORT = 1080 ' DEFAULT FOR SOCKS firewall servers.
    %INTERNET_FLAG_PASSIVE = &H8000000 ' used FOR FTP connections
    ' File transfer methods
    %FTP_TRANSFER_TYPE_UNKNOWN = &H0
    %FTP_TRANSFER_TYPE_ASCII = &H1
    %FTP_TRANSFER_TYPE_BINARY = &H2
    '
    Declare Function InternetOpen Lib "wininet.dll" Alias "InternetOpenA" _
                                  (lpszAgent As Long, _ ' Pointer to the calling entity
                                   dwAccessType As Long, _ ' Type of access required
                                   lpszProxyName As Long, _ ' Pointer to the proxy's name
                                   lpszProxyBypass As Long, _ ' Pointer to addresses to bypass proxy
                                   dwFlags As Long) As Long ' Unsigned long integer
    ' Failure: %NULL, Success: Handle to the connection
    
    Declare Function InternetConnect Lib "wininet.dll" Alias "InternetConnectA" _
                                    (hInternet As Long, _
                                    lpszServerName As Long, _
                                    nServerPort As Long, _
                                    lpszUserName As Long, _
                                    lpszPassword As Long, _
                                    dwService As Long, _
                                    dwFlags As Long, _
                                    dwContext As Long) As Long
    
    Declare Function FtpGetFile Lib "wininet.dll" Alias "FtpGetFileA" _
                                (hConnect As Long, _
                                 lpszRemoteFile As Long, _
                                 lpszNewFile As Long, _
                                 fFailIfExists As Long, _
                                 dwFlagsAndAttributes As Long, _
                                 dwFlags As Long, _
                                 dwContext As Long) As Long
    
    Declare Function InternetCloseHandle Lib "wininet.dll" Alias "InternetCloseHandle" (hInternet As Long) As Long
    
    Declare Function GetUsernameAndPassword(lpszUserName As Asciiz,lpszPassword As Asciiz) As Long
    Declare Function GetPassword() As String
    '
    ' Globals
    Global hIOpen As Long
    Global hIConnect As Long
    '
    Function PbMain()
    '
    Local lResult       As Long
    Local Agent         As Asciiz * 256
    Local TheFtpServer  As Asciiz * 256
    Local rsvp          As Long
    Local RemoteFile    As Asciiz * 256
    Local LocalFile     As Asciiz * 256
    Local lpszUserName  As Asciiz * 16
    Local lpszPassword  As Asciiz * 12
    
    '
    Agent = "PB/DLL WinInet" ' <== customize HTTP response with this
    If Instr(Command$,"?") Then GoTo helpme
    '
    ' Open an Internet session as predefined in the registry
    hIOpen = InternetOpen(ByVal VarPtr(Agent), _
                          ByVal %INTERNET_OPEN_TYPE_PRECONFIG, _
                          ByVal %NULL, _
                          ByVal %NULL, _
                          ByVal 0)
    
    ' If it fails exit
    If hIOpen = %NULL Then
      StdOut "Could not open an Internet connection"
    Exit Function
    End If
    
    TheFtpServer = Parse$(Trim$(Command$)," ",1)' <=== your FTP server here
    lResult = GetUsernameAndPassword(lpszUserName,lpszPassword)
    
    hIConnect = InternetConnect(ByVal hIOpen, _
                                ByVal VarPtr(TheFtpServer), _
                                ByVal %INTERNET_INVALID_PORT_NUMBER, _
                                ByVal VarPtr(lpszUserName), _
                                ByVal VarPtr(lpszPassword), _
                                ByVal %INTERNET_SERVICE_FTP, _
                                ByVal 0, _
                                ByVal 0)
    
    If hIConnect = %NULL Then
        InternetCloseHandle(hIOpen)
        StdOut "FTP Connect Failed " & Str$(hIConnect)
        Exit Function
    End If
    '
    RemoteFile = Parse$(Trim$(Command$)," ",2)' <== the file to GET
    LocalFile = Parse$(Trim$(Command$)," ",3) ' <== where you want to PUT it
    
    StdOut "Retrieving " + RemoteFile + " from " + TheFtpServer
    
    rsvp = FtpGetFile(ByVal hIConnect, _
                      ByVal VarPtr(RemoteFile), _
                      ByVal VarPtr(LocalFile), _
                      ByVal %FALSE, _
                      ByVal %FILE_ATTRIBUTE_NORMAL, _
                      ByVal %FTP_TRANSFER_TYPE_UNKNOWN, _
                      ByVal 0)
    
    If rsvp = %FALSE Then StdOut "File Transfer failed."
    '
    ' Close all the handles
    InternetCloseHandle(hIConnect)
    InternetCloseHandle(hIOpen)
    Exit Function
    '
    '
    
    HELPME:
    StdOut "AppName v1.00"
    StdOut "Useage: PBFTP <host/ipaddress> <remotefile> <localfile>
    StdOut
    StdOut "You will be prompted for username/password"
    StdOut "If using anonymous enter ""anonymous"" for username"
    StdOut "and your email address for a password"
    End Function
    '
    '
    
    Function GetUsernameAndPassword(lpszUserName As Asciiz,lpszPassword As Asciiz) As Long
    StdOut "userName: ";
    StdIn Line lpszUserName
    lpszPassword = GetPassword
    End Function
    
    '
    '
    
    Function GetPassword() As String
    Local x As Long
    Local y As Long
    Local i As Long
    Local buff As String
    
    StdOut "Password: ";
    Do
      i = Asc(WaitKey$)
      Select Case i
             Case 8 'BACKSPACE
                  x = CursorY
                  y = CursorX
                  Locate X,Y - 1
                  StdOut Chr$(32);
                  Locate X,Y - 1
                  If Len(buff) > 0 Then buff = Left$(buff,Len(Buff) - 1)
             Case 13,27 '<ENTER><ESC>
                  StdOut
                  Exit Do
             Case Else
                  buff = buff + Chr$(i)
                  StdOut "*";
                  i = 0
      End Select
    Function = buff
    Loop
    
    End Function
    ------------------
    Scott
    mailto:[email protected][email protected]</A>



    [This message has been edited by Scott Turchin (edited May 24, 2000).]
    Scott Turchin
    MCSE, MCP+I
    http://www.tngbbs.com
    ----------------------
    True Karate-do is this: that in daily life, one's mind and body be trained and developed in a spirit of humility; and that in critical times, one be devoted utterly to the cause of justice. -Gichin Funakoshi

    Comment


    • #3
      %INTERNET_OPEN_TYPE_PROXY = &H3 ' via named proxy

      According to the API, a proxy should be no problem. I often have to go through a proxy, I'll see if I can work up an example that uses one and post it.

      ------------------

      Comment


      • #4
        WinInet Upload overwrite or append

        Code:
        ' WININET_FTP_UPLOAD.bas
        ' PURPOSE: Demonstrate FIle uploads using WinInet functions
        ' DATE     Mardh 19 2008
        ' Author: Michael Mattias Tal Systems Inc Racine WI
        ' Use: Placed in public domain by author 3/9/08
        ' Credits: John McWilliams earlier in this source code posting
        ' ----------------------------------------------
        ' COMPILER: PB/WIndows v 8.03, but should work with
        ' Just about any PB compiler or version
        ' To Run Demo
        '  MOdify the equates....
        '$FTP_SERVER, $USER_ID, $PASSWORD
        '$LOG_FILE_NAME,$FILE_FIRST, $FILE_SECOND, FILE_TARGET
        ' .. for your system and FTP server.
        
        ' Compile and execute. Review $LOG_FILE when done
        
        ' NOTES:
        ' 1. I had a heck of a time getting InternetGetLastResponseInfo
        '    to work consistently, and had to use GetLastError to
        '    get error messages.
        ' 2. Reporting could use some cleanup.
        
        #COMPILE EXE
        #DIM     ALL
        
        ' ----------------------------------------
        ' STANDARD WINDOWS HEADER FILES AND DATES
        ' ----------------------------------------
        
        #INCLUDE "WIN32API.INC"    ' 21 Feb 2005
        #IF NOT %DEF(%INVALID_HANDLE_VALUE_LONG)
          %INVALID_HANDLE_VALUE_LONG = -1&
        #ENDIF
        
        #INCLUDE "Wininet.inc"     ' 27 October 2003
        
        ' ------------------------------------------------------------------------
        ' SUpport functions used, could be #INCLUDEd from prior postings,
        ' but copied inline here for user convenience.
        ' -----------------------------------------------------------------------
        ' STDOUT_PBWIN.INC- THread-safe STDOUT for PB/Windows
        #IF %DEF(%PB_WIN32)
         FUNCTION STDOUT (Z AS STRING) AS LONG
         ' returns TRUE (non-zero) on success
        
           LOCAL hStdOut AS DWORD, nCharsWritten AS LONG
           LOCAL w AS STRING
           STATIC CSInitialized AS LONG, CS AS CRITICAL_SECTION
           LOCAL iRET AS LONG, LE AS LONG
        
           IF ISFALSE CSInitialized THEN
               InitializeCriticalSection CS
               CSInitialized  =  1
           END IF
        
           EntercriticalSection Cs
        
           hStdOut         = GetStdHandle (%STD_OUTPUT_HANDLE)
        
           SELECT CASE AS LONG hStdOut
               CASE %NULL, -1&
                   iRet = AllocConsole        ' OK, it creates the first time
                   LE   = GetLAstError
                   hStdOut       = GetStdHandle (%STD_OUTPUT_HANDLE)
           END SELECT
        
           LeaveCriticalSection    CS
           w                     = Z & $CRLF
           iRet                  = WriteFile(hStdOut, BYVAL STRPTR(W), LEN(W),  nCharsWritten, BYVAL %NULL)
           LE                    = GETLastError
           FUNCTION = iRet   ' true is good
        
        
         END FUNCTION
        #ENDIF
        ' System error message text
        #IF NOT %DEF (%SYSEMT_INC)
          %SYSEMT_INC  = 1
        FUNCTION SystemErrorMessageText (BYVAL ECode AS LONG) AS STRING
          LOCAL Buffer AS ASCIIZ * 255
          FormatMessage %FORMAT_MESSAGE_FROM_SYSTEM, BYVAL %NULL, ECode, %NULL, buffer, SIZEOF(buffer), BYVAL %NULL
          FUNCTION = FORMAT$(ECode, "##### ") & Buffer
        END FUNCTION
        
        #ENDIF
        
        ' --------------------------------------------------
        ' POSITIONAL DECLARES FOR PROCEDURES IN THIS PROGRAM
        ' --------------------------------------------------
        ' "GetFileSize' is a WinAPI function using a handle
        DECLARE FUNCTION GetFileSizebyName (szFile AS ASCIIZ) AS LONG
        
        ' -----------------------
        ' MACROS of CONVENIENCE
        ' -----------------------
        MACRO bva(anything)      = BYVAL VARPTR(anything)
        MACRO bvaz(asciizString) = BYVAL IIF(lstrlen(asciizString), VARPTR(AsCIIZString), %NULL)
        
        ' --------------------------------------------------
        ' EQUATES FOR THIS PROGRAM, MUST BE MODIFIED
        ' TO RUN SINCE I AM *NOT* GIVING YOU THE USER ID
        ' AND PASSWORD TO MY FTP SERVER
        ' --------------------------------------------------
        
        $FTP_SERVER   =  "www.talsystems.com"
        $USER_ID      =  "MY_USER_ID"
        $PASSWORD     =  "MY_PASSWORD"
        $AGENT        =  "WinInet FTP Upload Demo"  ' not used, but what the hell.
        
        ' assorted file names used in demo
        $LOG_FILE_NAME   = "D:\Software_Development\pbwin80\work\ftpget\Upload_demo_log.txt"
        
        
        ' FILES TO BE UPLOADED, and where to (and from) ..
        $FILE_TARGET  =  "mcmcloyes/append_destination.txt"    ' file on server
        $FILE_FIRST   =  "winInet_ftp.upload.bas"              ' will overwrite the target
        $FILE_SECOND  =  "wininet_ftp.upload.bak"
                                                               ' after $FILE_FIRST overwrites it
        
        ' Note that $FILE_FIRST and $FILE_SECOND are just local files so
        ' 'regular' filename qualification rules (drive:\path] apply.
        ' The same pretty much applies to $FILE_TARGET withe the two cautions
        ' when the server is UNIX:
        ' a. Path and file names ARE case sensitive.
        ' b. The forward slash "/" is used to delimit paths (but I think "\" will work, too)
        
        ' I suppose if you really want to know which character to use to delimit the
        ' target path/file names, you could inspect the current directory looking
        ' to see if it's "/" or "\" which is used.
        
        ' Output (as coded, to the log file to STDOUT)
        FUNCTION MultiOut (sText AS STRING) AS LONG
         LOCAL hFile AS LONG
         LOCAL szFile AS ASCIIZ * %MAX_PATH
        
         szFile = $LOG_FILE_NAME
         hFile  = FREEFILE
         OPEN     szFIle FOR APPEND AS hFile
         PRINT    #hFile, sText
         CLOSE    hFile
         ' send output to STDOUT, too.
         STDOUT   sText
        
        END FUNCTION
        
        FUNCTION GetFTPConnectInfo (szServer AS ASCIIZ, szUser AS ASCIIZ, szPassword AS ASCIIZ) AS LONG
        ' -------------------------------------------------------------------------------
        ' in real life this would be an INI file/Registry or Application data file read
        ' or user prompt.
        ' --------------------------------------------------------------------------------
            szServer    = $FTP_SERVER
            szUser      = $USER_ID
            szPassword  = $PASSWORD
        END FUNCTION
        
        ' -----------------------
        '   PROGRAM ENTRY POINT
        ' -----------------------
        
        FUNCTION WINMAIN (BYVAL hInstance     AS LONG, _
                          BYVAL hPrevInstance AS LONG, _
                          BYVAL lpCmdLine     AS ASCIIZ PTR, _
                          BYVAL iCmdShow      AS LONG) AS LONG
        
          CALL UploadDemo ()
          
          MSGBOX "Just holding the console",,"End of Demo, review log"
        
        END FUNCTION
        
        ' ----------------------------------------
        ' Demo function
        ' what this function will do is
        ' First upload $FILE_FIRST to the server in default mode
        ' of :'overwrite if found, create if not found',
        ' then it will upoload $FILE_SECOND appending to the file
        ' we just uploaded.
        ' --------------------------------------------
        
        
        FUNCTION UploadDemo () AS LONG
        
            LOCAL szAgent       AS ASCIIZ * 256
            LOCAL szFtpServer   AS ASCIIZ * 256
            LOCAL rsvp          AS LONG
            LOCAL szRemoteFile    AS ASCIIZ * 256
            LOCAL szLocalFile     AS ASCIIZ * 256
            
            LOCAL hIOpen AS LONG, hiConnect AS LONG
            LOCAL dwContext    AS LONG
        
            LOCAL szUserId      AS ASCIIZ * %MAX_PATH
            LOCAL szPassword    AS ASCIIZ * %MAX_PATH
            LOCAL E             AS LONG
            LOCAL LE            AS LONG   ' last API Error
            LOCAL szLastResponseInfo AS ASCIIZ * 16384
            LOCAL cchLastResponseInfo AS LONG
            LOCAL iErrLastResponse     AS LONG
            LOCAL dwFlags AS DWORD
            LOCAL nBytesAppended AS LONG, nTotalBytesAppended AS LONG
            LOCAL nBytesDownloaded AS LONG, nTotalBytesDownloaded AS LONG
            LOCAL sMsg  AS STRING
            LOCAL szErrMsg   AS ASCIIZ * %MAX_PATH
            LOCAL szLastErrMsg  AS ASCIIZ * %MAX_PATH
            LOCAL fSize1 AS LONG, fSize2 AS LONG
        
        
            LOCAL iRet AS LONG, szDir AS ASCIIZ * %MAX_PATH, cbBuffer AS LONG
            LOCAL iRetDelete AS LONG
        
        
            ' ----------------------------
            ' Executable code begins here
            ' ----------------------------
        
            szAgent = $AGENT
            ' Get the rest of our required connection info
            CALL GetFTPConnectInfo (szFtpServer, szUserId, szPassword)
        
            ' we want a fresh log file for the session:
            KILL $LOG_FILE_NAME
            sMsg     = USING$ ("Upload demo To & begins at & on & ", szFtpserver, DATE$, TIME$)
            Multiout   sMsg
            sMSg     = USING$ ("Current local directory is '&'", CURDIR$)
            Multiout   sMsg
            sMsg     = " "
            Multiout   sMsg
            '
            ' Open an Internet session as predefined in the registry
            hIOpen = InternetOpen(BYVAL VARPTR(szAgent), _
                                  BYVAL %INTERNET_OPEN_TYPE_PRECONFIG, _
                                  BYVAL %NULL, _
                                  BYVAL %NULL, _
                                  BYVAL 0)
            ' If it fails exit
            IF hIOpen = %NULL THEN
               sMsg   = "Could not open an Internet connection"
               multiout   smsg
               EXIT FUNCTION
            ELSE
                sMsg    = USING$ ("Got an internet OPEN handle #", hIOpen)
                MultiOut  sMsg
            END IF
        
            ' -------------------------------------
            '      CONNECT TO THE FTP SERVER
            ' -------------------------------------
        
            cchLastResponseInfo =   SIZEOF(szLastResponseInfo)
            ' -----------------------------------------------------------------------------
            ' I do not really understand the difference between passive and non-passive.
            ' As I understand the doc, passive is more secure because all server actions
            ' occur ONLY in response to direct requests from the client (this program), and any
            ' 'foreign' requests of the server (e.g to download an extra file) are ignored.
            ' This code works either way,so I guess we'll go "more secure" (passive).
            ' -----------------------------------------------------------------------------
            dwFlags             =   %INTERNET_FLAG_PASSIVE
            'dwFlags             =   %NULL
        
            hIConnect = InternetConnect(BYVAL hIOpen, _
                                        BYVAL VARPTR(szFtpServer), _
                                        BYVAL %INTERNET_DEFAULT_FTP_PORT, _
                                        bvaz (szUserId), _
                                        bvaz (szPassword), _
                                        BYVAL %INTERNET_SERVICE_FTP, _
                                        BYVAL dwFlags, _
                                        BYVAL 0)
        
            ' Query the last response info.....
            LE   = GetLastError
            CALL  InternetGetLastResponseInfo (iErrLastResponse, szLastResponseInfo, cchLastResponseInfo)
        
            sMSg = USING$ ("hiconnect #  Last Reponse ERR #   message & ", hIConnect, iErrLastResponse, szLastResponseInfo)
            MultiOut sMsg
        
            IF hIConnect = %NULL THEN
               InternetCloseHandle(hIOpen)
               sMsg  =   "FTP Connect Failed  " & STR$(hIConnect) & $CRLF _
                       & SystemErrorMessageText (E)
               multiout   sMsg
               EXIT FUNCTION
            ELSE
                sMsg     = "Connected to Server"
                Multiout    sMsg
            END IF
        
            ' -----------------------------------------------------------
            ' SHOW THE CURRENT FTP SERVER DIRECTORY.
            ' -----------------------------------------------------------
            cbBuffer  =   SIZEOF(szDir) - 1
            iRet  = FtpGetCurrentDirectory (hIConnect, szDir, cbBuffer)
            ' specify the name of the sdirectory non the server in which we are interested
            IF ISTRUE Iret THEN
                Multiout USING$  ( "Current FTP server directory is '&'", szDir)
            ELSE
                Multiout          "FtpGetCurrentDirectory failed"
                InternetCloseHandle   hIConnect
                InternetCloseHandle  hIOpen
                EXIT FUNCTION
                ' This should NEVER fail if we get this far. But....ya never knows does ya?
            END IF
        
            ' --------------------------------------------------------------------
            ' If still here, we are ready for the first part of
            ' the demo: uploading $FILE_FIRST as $FILE_TARGET
            ' in the default mode of "create if not found, overwrite if it is"
            ' for this we simply use the WinInet function FTPPutFile
            ' -------------------------------------------------------------------
            '
           szLocalFile =  $FILE_FIRST
           szRemoteFile = $FILE_TARGET
           fsize1       = GetFileSizeByName (szLocalFile)
        
           sMsg          = USING$("Uploading file '&' size #, as '&'", szLocalFile, fSize1, szRemoteFile)
           Multiout sMsg
        
           dwFlags = %FTP_TRANSFER_TYPE_BINARY
           ' binary is the default, but I don't like using defaults
           dwContext = %NULL    ' not using callbacks, so it's moot
        
           iRet  = FTPPutFile (hIConnect, szLocalFile, szRemoteFile, dwFlags, %NULL)
           ' says to call getlasterror, but I am going to call this instead
           LE    = GetLastError
           szLastErrMsg = SystemErrorMessageText (LE)
           CALL     InternetGetLastResponseInfo (iErrLastResponse, szLastResponseInfo, SIZEOF(szLastResponseInfo) -1)
           IF ISTRUE iRet THEN
               sMsg = "File successfully uploaded"
           ELSE
               sMsg = USING$("Upload failed with last Error #  InetError # &", LE, iErrLastResponse, szLastErrMsg)
           END IF
           Multiout    sMsg
        
            ' -------------------------------------------------------------
            ' If still here, we are ready for the second part of
            ' the demo: appending $FILE_SECOND to $FILE_TARGET
            ' WinInet does not offer any ;'canned' function to append
            ' so we have to use a combination of FtpCommand and
            ' INternetWriteFile. For various reasons I have put this
            ' into a separate function cleaverly named "FTpAppendFile"
            ' -------------------------------------------------------------
        
           szLocalFile  = $FILE_SECOND
           ' szRemote is the same
           nBytesAppended = 0&
           fSize2       = GetFileSizeByName (szLocalFile)
           
           sMSg  = USING$ ("Appending file '&' size #, to '&'", szLocalFile, fSize2, szRemoteFile)
           multiout   sMSg
           
           
           CALL _
            FtpAppendFile (hIconnect, szLOcalFile, szRemoteFile, nBYtesAppended, szErrMsg) _
             TO iRet
             
            sMsg = _
             USING$ ("Append: RC= # (&)  #, nBytesAppended  Error '&'", _
                 iret, IIF$ (Iret, "ERROR", "Success"),  nBytesAppended, szErrmsg)
                 
            multiout sMsg
                 
        
        
        ' close our open handles and exit
            smsg      = "Closing handles prior to ending"
            multiout     sMsg
            InternetCloseHandle (hIConnect)
            InternetCloseHandle (hIOpen)
        
            Multiout    "End of Program, review the log file"
        
        END FUNCTION  ' UploadDemo
        
        ' -------------------------------------------------------
        '   Wrapper Function to perform FTP append a file
        '   HConnect       [IN]  - From InternetConnect
        '   szSource       [IN]  - Name of file to be appended
        '   szTarget       [IN]  - Name of file (relative or absolute pathing) to which szSource should be appended
        '   nBYtesAppended [OUT] variable to be filled with the number of bytes added. Reset to zero at start of function
        '   szErrMsg, max 512 chars, filled on error only
        '   RETURNS: 0    ==> success, and nBytesappended is filled
        '            TRUE ==> Error and szErrMsg is filled
        ' -------------------------------------------------------
        FUNCTION FtpAppendFile (BYVAL hConnect AS LONG, szSource AS ASCIIZ, szTarget AS ASCIIZ, _
                               BYREF nBytesAppended AS LONG, szErrMsg AS ASCIIZ) AS LONG
        
           LOCAL fv  AS LONG           'function value (return)
           LOCAL hAppend AS LONG, szCmd AS ASCIIZ  *  512 ' cmd needs to be 5 + max_path minimum
           LOCAL bResponse AS LONG, dwCmdFlags AS DWORD, dwContext AS DWORD
        
           LOCAL hSource AS LONG, sSourceData AS STRING, iRet AS LONG, LE AS LONG, iRetClose AS LONG
        
           LOCAL iErrLastResponse AS LONG, szLastResponseINfo AS ASCIIZ * 512, cchLastResponseInfo AS LONG
           LOCAL dwData AS DWORD, nBytesToWrite AS LONG
        
           fv                 = 0&       ' default = success
           nBYtesAppended     = %NULL    ' reset
        
          ' first make sure of a few basics:
        
          ' does the source file exist?
        
          IF DIR$(szSource) = "" THEN
              szErrMsg  = "Source file not found"
              fv        = %TRUE
        
          ELSE
                ' get the source file's data into a buffer
                 hSource   =  FREEFILE
                 OPEN         szSource FOR BINARY AS hSource BASE =0
                 SEEK         hSource, 0
                 GET$         hSource, LOF(hSource), sSourceData
                 CLOSE        hSource
                 IF LEN (sSourceData) = 0 THEN
                     szErrMsg             = "Source file exists but has no data"
                     fv    =  %TRUE
                 ELSE
                     dwCmdFlags           =  %FTP_TRANSFER_TYPE_BINARY   ' this is default but I don't like using defaults.
                     dwContext            =  %NULL    ' we're not using callbacks so context is moot
                     bResponse            =  %TRUE    ' yes we want a response. Actually, we NEED a response to get the handle
                     SzCmd                = "appe " &   szTarget
                     cchLastResponseInfo  =  SIZEOF(szLastResponseINfo) - 1
                     dwCmdFlags           =  %FTP_TRANSFER_TYPE_BINARY
                     iRet                 = FtpCommand (hConnect, bResponse, dwCmdFlags, szCmd, dwContext, hAppend)
                     LE                   = GetLastError()
                     CALL                   INternetgetLastResponseInfo (iErrLastResponse, szLastResponseInfo, cchLastResponseInfo)
        
                     IF ISTRUE iRet THEN   ' Ftpcommand call succeeded, append the file data using the returned handle
                        dwData            =  STRPTR(sSourceData)   ' address of data
                        nBYtesToWrite     =  LEN(sSourceData)      ' write it all
                        iRet              = InternetWriteFile (hAppend, dwData, nBytesToWrite, nBYtesAppended)
                        LE                = GetLastError()
                        IF ISTRUE iRet THEN   ' writefile (append) succeeded
                            ' really nothing to do, but since an imperative statement is required....
                            fv = 0    ' succeess
                        ELSE
                            szErrMsg  =  szLastResponseInfo
                            fv        = %TRUE   ' set failure return value
                        END IF
                        iRetClose     =  InternetCloseHandle (hAppend)   ' we get this far we have a handle to close
                     ELSE                  'FtpCommand failed
                         IF lStrLen(szLastResponseInfo) THEN
                               szErrMsg              = szLastResponseInfo
                         ELSE
                               szErrMsg              =  "FtpCommand error #" & FORMAT$ (iErrLastResponse)
                         END IF
                         fv =  %TRUE
        
                     END IF   ' if FTPCommand succeeded or not
        
        
        
                 END IF       ' if source file was found but had no data
        
           END IF             ' if source file was found, period
        
        
           FUNCTION = fv
        
        END FUNCTION
        
        ' I suppose I 'could' return a QUAD here...
        FUNCTION GetFileSizebyName (szFile AS ASCIIZ) AS LONG
        
         LOCAL w32 AS WIN32_FIND_DATA, hSearch AS LONG
        
         hSearch = FindFirstFile (szFile, W32)
         IF       hSearch <> %INVALID_HANDLE_VALUE_LONG THEN
             FindClose    hSearch
             FUNCTION   = W32.nFileSIzeLow
        
         ELSE
             FUNCTION = -1&  ' artificial "NOTFOUND" value
         END IF
        
        END FUNCTION
        
        
        ' ** END OF FILE WININET_FTP.UPLOAD.BAS
        Michael Mattias
        Tal Systems (retired)
        Port Washington WI USA
        [email protected]
        http://www.talsystems.com

        Comment


        • #5
          Oops, posted on Wrong Tab of IE 7...

          MCM
          Last edited by Michael Mattias; 2 Mar 2009, 05:36 PM.
          Michael Mattias
          Tal Systems (retired)
          Port Washington WI USA
          [email protected]
          http://www.talsystems.com

          Comment


          • #6
            Michael

            I just happened to have a need for an FTP upload and I tried your code out. By chance did you miss the ftpcommand function in your sample code? I tried to compile the code and it dies on the ftpcommand..

            Thanks
            There is a principle which is a bar against all information, which is proof against all arguments and which cannot fail to keep a man in everlasting ignorance - that principle is contempt prior to investigation.

            Herbert Spencer

            Comment


            • #7
              some extra code to add to Michael's code above, if you want to create a directory structure on the ftp side, if the client has those privileges on the ftp server.
              and a heads up for you to consider the case sensitivity of file names if the ftp server is on a non windows ftp server, remember linux os and other os treat uppercase and lowercase as two different characters, hence you can end up with two files where you only intended only one file.

              Code:
              FUNCTION buildftpdirectory( hIConnect AS LONG,stemp AS STRING) AS LONG
              'stemp is the directory name you wish to build on the ftp server
                  LOCAL i AS LONG
                  LOCAL j AS LONG
                  LOCAL k AS LONG
                  LOCAL b() AS STRING
                  FUNCTION=0&
                  LOCAL  szDirtemp AS ASCIIZ * %MAX_PATH
                  stemp="/"+TRIM$(stemp)+"/"
                  REPLACE "//" WITH "/" IN stemp
                  stemp=" "+stemp+" "
                  cleandirectoryname:
                  REPLACE " /" WITH "/" IN stemp
                  REPLACE "/ " WITH "/" IN stemp
                  IF INSTR(stemp," /") GOTO cleandirectoryname
                  IF INSTR(stemp,"/ ") GOTO cleandirectoryname
                  stemp=" "+TRIM$(stemp)+" "
                  IF INSTR(stemp," /") THEN REPLACE " /" WITH "" IN stemp:GOTO cleandirectoryname
                  IF LEN(stemp)=0 THEN FUNCTION=1:EXIT FUNCTION
                  stemp=TRIM$(stemp)
                  IF INSTR(stemp,"/")=0 THEN J=1  ELSE J= PARSECOUNT(stemp,"/")
                  REDIM b(1 TO j)
                  IF J=1 THEN b(1)=stemp ELSE PARSE stemp, b(),"/"
                  szdirtemp="/"
                  k = FtpSetCurrentDirectory ( hiconnect,szdirtemp)
                  IF NOT ISTRUE k THEN FUNCTION=0:EXIT FUNCTION
                  SLEEP 30
                  FOR I=1 TO J
                  IF LEN(TRIM$(b(i)))=0 THEN EXIT FOR
                  Szdirtemp=b(i)
                  k = FtpCreateDirectory ( hiconnect,szdirtemp)
                  k = FtpSetCurrentDirectory ( hiconnect,szdirtemp)
                  IF NOT ISTRUE k THEN FUNCTION=0:EXIT FUNCTION
                  NEXT i
                  FUNCTION=1&
              END FUNCTION
              added: refinements made and code tested
              Last edited by Paul Purvis; 17 Sep 2009, 01:33 AM.
              p purvis

              Comment

              Working...
              X