当前位置:编程学习 > VB >>

VB上传文件到服务器

我想将文件上传到服务器空间,不知用哪种方案较好。
要求:速度快,稳定
我查了相关资料,可以直接用winsock或inet,用FTP链接服务器上传,不知这两种方案哪种好?
有组件上传和无组件上传,这是什么意思呢?希望各位大侠能指点一下。 使用api函数,似乎效率更好。
下载的时候,我的最大能达到100Mbps

Option   Explicit 

Private   Declare   Function   FtpGetFile   Lib   "wininet.dll "   Alias   "FtpGetFileA "   (ByVal   hFtpSession   As   Long,   ByVal   lpszRemoteFile   As   String,   ByVal   lpszNewFile   As   String,   ByVal   fFailIfExists   As   Boolean,   ByVal   dwFlagsAndAttributes   As   Long,   ByVal   dwFlags   As   Long,   ByVal   dwContext   As   Long)   As   Boolean 
Private   Declare   Function   FtpSetCurrentDirectory   Lib   "wininet.dll "   Alias   "FtpSetCurrentDirectoryA "   (ByVal   hFtpSession   As   Long,   ByVal   lpszDirectory   As   String)   As   Boolean 
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   InternetCloseHandle   Lib   "wininet.dll "   (ByVal   hInet   As   Long)   As   Integer 
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   InternetGetLastResponseInfo   Lib   "wininet.dll "   Alias   "InternetGetLastResponseInfoA "   (lpdwError   As   Long,   ByVal   lpszBuffer   As   String,   lpdwBufferLength   As   Long)   As   Boolean 

Private   Const   scUserAgent   =   "vb   wininet " 

Private   Const   INTERNET_OPEN_TYPE_DIRECT   =   1 
Private   Const   INTERNET_OPEN_TYPE_PROXY   =   3 
Private   Const   INTERNET_INVALID_PORT_NUMBER   =   0 

Private   Const   FTP_TRANSFER_TYPE_ASCII   =   &H1 
Private   Const   FTP_TRANSFER_TYPE_BINARY   =   &H1 
Private   Const   INTERNET_FLAG_PASSIVE   =   &H8000000 
                                
Private   Const   ERROR_INTERNET_EXTENDED_ERROR   =   12003 

Private   Const   INTERNET_SERVICE_FTP   =   1 

Private   Const   INTERNET_FLAG_RELOAD   =   &H80000000 

Private   hOpen   As   Long,   hConnection   As   Long 

Private   Const   txtProxy   =   " " 
Private   Const   chkPassive   =   1 

'打开ftp连接 
Public   Sub   InternetOpening() 
        If   Len(txtProxy)   <>   0   Then 
                hOpen   =   InternetOpen(scUserAgent,   INTERNET_OPEN_TYPE_PROXY,   txtProxy,   vbNullString,   0) 
        Else 
                hOpen   =   InternetOpen(scUserAgent,   INTERNET_OPEN_TYPE_DIRECT,   vbNullString,   vbNullString,   0) 
        End   If 
        If   hOpen   =   0   Then   ErrorOut   Err.LastDllError,   "InternetOpen " 
End   Sub 

'关闭ftp连接 
Public   Sub   InternetClose() 
        If   hConnection   <>   0   Then   InternetCloseHandle   hConnection 
        If   hOpen   <>   0   Then   InternetCloseHandle   hOpen 
        hConnection   =   0 
        hOpen   =   0 
End   Sub 

'建立ftp连接 
Public   Function   FtpConnect(ftpServer   As   String,   ftpUser   As   String,   ftpPass   As   String)   As   Boolean 
        FtpConnect   =   False 
        
        Call   InternetOpening 
        
        If   hOpen   <>   0   Then 
                
                Dim   nFlag   As   Long 
                If   chkPassive   =   1   Then 
                        nFlag   =   INTERNET_FLAG_PASSIVE 
                Else 
                        nFlag   =   0 
                End   If 
                hConnection   =   InternetConnect(hOpen,   ftpServer,   INTERNET_INVALID_PORT_NUMBER,   ftpUser,   ftpPass,   INTERNET_SERVICE_FTP,   nFlag,   0) 
                If   hConnection   =   0   Then 
'                         ErrorOut   Err.LastDllError,   "InternetConnect " 
                Else 
                        FtpConnect   =   True 
              End   If 
        End   If 
End   Function 

'获取ftp上的文件 
Public   Function   FTPGET(ByVal   ftpServer   As   String,   ByVal   ftpUser   As   String,   ByVal   ftpPass   As   String,   ByVal   szDirRemote   As   String,   ByVal   szFileRemote   As   String,   ByVal   szDirLocal   As   String,   Optional   ByVal   szFileLocal   As   String)   As   Boolean 
        Dim   bRet   As   Boolean 
        
        FTPGET   =   False 
        
        Call   FtpConnect(ftpServer,   ftpUser,   ftpPass) 
        
        rcd   szDirRemote,   ftpServer 
        If   szFileLocal   =   " "   Then 
                '如果未传递本地文件名,则默认为远程文件名 
                szFileLocal   =   szFileRemote 
        Else 
                '可以检测后缀名是否一致 
        End   If 
        bRet   =   FtpGetFile(hConnection,   szFileRemote,   szDirLocal   &   szFileLocal,   False,   INTERNET_FLAG_RELOAD,   FTP_TRANSFER_TYPE_BINARY,   0) 
                
        DoEvents 
        Call   InternetClose 

        If   bRet   =   False   Then 
                ErrorOut   Err.LastDllError,   "FtpGetFile " 
        Else 
                FTPGET   =   True 
        End   If 
End   Function 

'获取ftp错误信息 
Public   Sub   rcd(pszDir   As   String,   ftpServer   As   String) 
        Dim   sPathFromRoot   As   String 
        Dim   bRet   As   Boolean 
        
        If   InStr(1,   pszDir,   ftpServer)   Then 
                sPathFromRoot   =   Mid(pszDir,   Len(ftpServer)   +   1,   Len(pszDir)   -   Len(ftpServer)) 
        Else 
                sPathFromRoot   =   pszDir 
        End   If 
        If   sPathFromRoot   =   " "   Then   sPathFromRoot   =   "/ " 
        
        bRet   =   FtpSetCurrentDirectory(hConnection,   sPathFromRoot) 
        
'         If   bRet   =   False   Then   ErrorOut   Err.LastDllError,   "rcd " 
End   Sub 

'显示ftp错误 
Public   Function   ErrorOut(dError   As   Long,   szCallFunction   As   String) 
        Dim   dwIntError   As   Long,   dwLength   As   Long 
        Dim   strBuffer   As   String 
        
        If   dError   =   ERROR_INTERNET_EXTENDED_ERROR   Then 
                InternetGetLastResponseInfo   dwIntError,   vbNullString,   dwLength 
                strBuffer   =   String(dwLength   +   1,   0) 
                InternetGetLastResponseInfo   dwIntError,   strBuffer,   dwLength 
                
                MsgBox   szCallFunction   &   "   Extd   Err:   "   &   dwIntError   &   "   "   &   strBuffer 
                
        End   If 
        If   MsgBox(szCallFunction   &   "   Err:   "   &   dError   &   _ 
                vbCrLf   &   "要关闭ftp连接吗? ",   vbQuestion   +   vbYesNo)   =   vbYes   Then 
                If   hConnection   Then   InternetCloseHandle   hConnection 
                
                If   hOpen   Then   InternetCloseHandle   hOpen 
                
                hConnection   =   0 
                hOpen   =   0 
        End   If 
End   Function
其实我现在比较偏向于用邮件的方式发送,速度比FTP快多了。
补充:VB ,  网络编程
CopyRight © 2022 站长资源库 编程知识问答 zzzyk.com All Rights Reserved
部分文章来自网络,