VB上传文件到服务器
我想将文件上传到服务器空间,不知用哪种方案较好。要求:速度快,稳定
我查了相关资料,可以直接用winsock或inet,用FTP链接服务器上传,不知这两种方案哪种好?
有组件上传和无组件上传,这是什么意思呢?希望各位大侠能指点一下。 使用api函数,似乎效率更好。
下载的时候,我的最大能达到100Mbps
其实我现在比较偏向于用邮件的方式发送,速度比FTP快多了。
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
补充:VB , 网络编程