vba上传ftp服务器

cike0415

Code
Declare   Function InternetOpenA()Function   InternetOpenA   Lib   "wininet.dll "   (ByVal   sAgent   As   String,   _
                ByVal   LAccessType   As   Long,   ByVal   sProxyName   As   String,   _
                ByVal   SProxyBypass   As   String,   ByVal   lFlags   As   Long)   As   Long

Declare   Function InternetConnectA()Function   InternetConnectA   Lib   "wininet.dll "   (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

Declare   Function FtpGetFileA()Function   FtpGetFileA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   _
                ByVal   lpszRemoteFile   As   String,   ByVal   lpsz   As   String,   ByVal   fFailIfExists   As   Boolean,   _
                ByVal   dwFlagsAndAttributes   As   Long,   ByVal   dwFlags   As   Long,   ByVal   dwContext   As   Long)   As   Boolean

Declare   Function FtpPutFileA()Function   FtpPutFileA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszLocalFile   As   String,   _
                ByVal   lpszRemoteFile   As   String,   ByVal   dwFlags   As   Long,   ByVal   dwContext   As   Long)   As   Boolean

Declare   Function FtpDeleteFileA()Function   FtpDeleteFileA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszFileName   As   String)   As   Boolean
   
Declare   Function FtpRenameFileA()Function   FtpRenameFileA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszExsiting   As   String,   _
                ByVal   lpszNew   As   String)   As   Boolean
Declare   Function InternetCloseHandle()Function   InternetCloseHandle   Lib   "wininet.dll "   (ByVal   hInet   As   Long)   As   Integer

Declare   Function FtpFindFirstFileA()Function   FtpFindFirstFileA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszSearchFile   As   String,   _
                lpFindFileData   As   WIN32_FIND_DATA,   ByVal   dwFlags   As   Long,   ByVal   dwContent   As   Long)   As   Long
        
Declare   Function InternetFindNextFileA()Function   InternetFindNextFileA   Lib   "wininet.dll "   (ByVal   hFind   As   Long,   lpvFndData   As   WIN32_FIND_DATA)   As   Long

Declare   Function FtpSetCurrentDirectoryA()Function   FtpSetCurrentDirectoryA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszDirectory   As   String)   As   Boolean
Declare   Function FtpGetCurrentDirectoryA()Function   FtpGetCurrentDirectoryA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszCurrentDirectory   As   String,   lpdwCurrentDirectory   As   Long)   As   Boolean

Declare   Function FtpCreateDirectoryA()Function   FtpCreateDirectoryA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszName   As   String)   As   Boolean
Declare   Function FtpRemoveDirectoryA()Function   FtpRemoveDirectoryA   Lib   "wininet.dll "   (ByVal   hFtpSession   As   Long,   ByVal   lpszName   As   String)   As   Boolean

      

Public   Type   FILETIME
    dwLowDateTime     As   Long
    dwHighDateTime   As   Long
End   Type

Public   Type   WIN32_FIND_DATA
    dwFilAttributes     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   *   260
    cAlternate   As   String   *   14
End   Type

Private   Sub Command1_Click()Sub   Command1_Click()
    lnginet   =   InternetOpenA(vbNullString,   INTERNET_OPEN_TYPE_PRECONFIG,   vbNullString,   vbNullString,   0&)
    If   lnginet   Then
          LngInetConn   =   InternetConnectA(lnginet,   "172.16.18.242 ",   0,   "rockylee ",   "6559872 ",   1,   0,   0)
          If   LngInetConn   Then
                'blnRC   =   FtpGetFileA(lnginetconn,   "Letter/tel.doc ",   "c:\tel.doc ",   0,   0,   1,   0)   '下載
                'blnRC   =   FtpPutFileA(lnginetconn,   "c:\tel.doc ",   "Letter/tel9.doc ",   0,   0)             '上傳
                'blnRC   =   FtpRenameFileA(lnginetconn,   "Letter/tel9.doc ",   "Letter/tel8.doc ")　　 '更名
                'blnRC   =   FtpDeleteFileA(lnginetconn,   "Letter/tel8.doc ")　　　　　　　　　　　‘刪除
                If   blnRC   =   True   Then   MsgBox   "download   ok!!! "
                InternetCloseHandle   LngInetConn
                InternetCloseHandle   lnginet
                MsgBox   "close   ok!!! "
          Else
                MsgBox   "can 't   connect "
          End   If
    Else
          MsgBox   "ftp   wrong "
    End   If
End   Sub Private()Sub

Private   Sub Command2_Click()Sub   Command2_Click()
    Dim   pData         As   WIN32_FIND_DATA
    Dim   lngHINet   As   Long
    Dim   intError   As   Integer
    Dim   strTemp     As   String
    Dim   blnRC         As   Boolean
    pData.cFileName   =   String(260,   0)
    lnginet   =   InternetOpenA(vbNullString,   INTERNET_OPEN_TYPE_PRECONFIG,   vbNullString,   vbNullString,   0&)
    If   lnginet   Then
          LngInetConn   =   InternetConnectA(lnginet,   "192.168.10.4 ",   0,   "rockylee ",   "6559872 ",   1,   0,   0)
          If   LngInetConn   Then
         
  
                FtpSetCurrentDirectoryA   LngInetConn,   "pp "
              'FtpRemoveDirectoryA   LngInetConn,   "X "
                FtpCreateDirectoryA   LngInetConn,   "px "
                Exit   Sub lngHINet()Sub
                lngHINet   =   FtpFindFirstFileA(LngInetConn,   " ",   pData,   0,   0)
                strTemp   =   Left(pData.cFileName,   InStr(1,   pData.cFileName,   String(1,   0),   vbBinaryCompare)   -   1)
                Do
                    If   (pData.dwFilAttributes   And   16)   =   16   Then   MsgBox   strTemp
                    pData.cFileName   =   String(260,   0)
                    blnRC   =   InternetFindNextFileA(lngHINet,   pData)
                    If   Not   blnRC   Then
                          Exit   Do
                    Else
                          strTemp   =   Left(pData.cFileName,   InStr(1,   pData.cFileName,   String(1,   0),   vbBinaryCompare)   -   1)
                          MsgBox   strTemp
                    End   If
                Loop
                'Text1.Text   =   strTemp
          End   If
    End   If
    InternetCloseHandle   lngHINet
    InternetCloseHandle   LngInetConn
    InternetCloseHandle   lnginet
End   Sub ()Sub