VB怎样上传图片到服务器

<%
'****************************************************
'这是类文件，用来保存有关文件上传的类
'****************************************************

'----------------------------------------------------------------------------------
Class jjUpload
'定义几个私有变量，在类内部都可以使用
Private formData,formSize,bncrlf,divider

'下面是初始化类的方法
Private Sub Class_Initialize()
formsize=Request.TotalBytes '获取传上来的二进制数据的大小
formdata=Request.BinaryRead(formsize) '获取传上来的二进制数据
bncrlf=ChrB(13) & ChrB(10) '回车换行标记
divider=LeftB(formData,CInt(InstrB(formdata,bncrlf))-1) '分隔符
End Sub

'下面的函数用来返回上传文件对象
Public Function GetFiles(FormName)
Dim objGetFiles
Set objGetFiles=New MyGetFiles
Call objGetFiles.GetProperty(formData,FormName)
Set GetFiles=objGetFiles
End Function

'下面的函数用来返回上传表单对象
Public Function GetForms(FormName)
Dim objGetForms
Set objGetForms=New MyGetForms
Call objGetForms.GetValue(formdata,FormName)
Set GetForms=objGetForms
End Function

End Class
'----------------------------------------------------------------------------------
Class MyGetFiles
'定义几个私有变量
Dim theFilePath,theFileName,theExt,theSize,theMIME,theformData
'定义几个只读属性，用来返回有关信息
Public Property Get FilePath
FilePath=theFilePath
End Property
Public Property Get FileName
FileName=theFileName
End Property
Public Property Get Ext
Ext=theExt
End Property
Public Property Get Size
Size=theSize
End Property
Public Property Get MIME
MIME=theMIME
End Property

'下面是初始化类的方法
Private Sub Class_Initialize()
End Sub

'下面是返回各个类的属性
Public Sub GetProperty(formData,FormName)
Dim bncrlf,divider
bncrlf=ChrB(13) & ChrB(10) '回车换行标记
divider=LeftB(formData,CInt(InstrB(formdata,bncrlf))-1) '分隔符
'下面开始查找该FormName对应的内容，strTemp变量用来保存一个二进制字符串
'dataStart为开始位置，dataEnd为结束位置，dataLen为要取信息的长度,temp为临时使用。
Dim strTemp,dataStart,dataEnd,dataLen,temp,intFlag
'因为发生引号嵌套，这里的内层引号用""代替。
strTemp=StringToBinary("Content-Disposition: form-data; name=""" & FormName & """; filename=""")
'在formData中查找二进制字符串strTemp,如果找到了就继续处理，如果找不到返回错误信息。
intFlag=InstrB(formData,Divider & bncrlf & strTemp)
Dim arrayTemp()
If intFlag>0 Then
'重定义数组长度
Redim arrayTemp(4)
'首先返回文件在客户端的路径
dataStart=intFlag+LenB(Divider & bncrlf & strTemp) '定位到第1个字符
dataend=InstrB(datastart,formdata,bncrlf)-2 '定位到最后1个字符
dataLen=dataend-datastart+1 '返回要取信息的长度
theFilePath=BinaryToString(MidB(formdata,datastart,datalen)) '返回文件路径
'返回文件的名称，其实只要从客户端路径中分析出文件名称即可
theFileName=Mid(theFilePath,InstrRev(theFilePath,"\")+1)
'返回文件的扩展名，其实只要从文件名称中分析出文件扩展名即可
theExt=Mid(theFileName,InstrRev(theFileName,".")+1)
'下面获取文件的MIME类型
temp=dataend '记住当前位置
datastart=temp+18 '定位到第1个字符
dataend=InstrB(datastart,formdata,bncrlf & bncrlf)-1 '定位到最后1个字符
dataLen=dataend-datastart+1 '返回要取信息的长度
theMIME=BinaryToString(MidB(formdata,datastart,datalen)) '返回MIME类型
'下面获取文件大小
temp=dataend
datastart=dataend+5 '定位到第1个字符
dataend=InstrB(datastart,formdata,divider)-3 '定位到最后1个字符
theSize=dataend-datastart+1 '返回文件大小
End If
'将formData保存在本类的私有变量中，以备使用
theformData=formData
End Sub
'----------------------------------------------------------------------------------
'下面定义一个保存文件的方法
Public Function SaveToFile(FormName,SaveFilePath,OverWriteFlag)
Dim bncrlf,divider
bncrlf=ChrB(13) & ChrB(10) '回车换行标记
divider=LeftB(theformData,CInt(InstrB(theformdata,bncrlf))-1) '分隔符
'下面开始查找该FormName对应的内容，strTemp变量用来保存一个二进制字符串
'dataStart为开始位置，dataEnd为结束位置，dataLen为要取信息的长度,temp为临时使用。
Dim strTemp,dataStart,dataEnd,dataLen,temp,intFlag,filepath,filename
'因为发生引号嵌套，这里的内层引号用""代替。
strTemp=StringToBinary("Content-Disposition: form-data; name=""" & FormName & """; filename=""")
'在formData中查找二进制字符串strTemp,如果找到了就继续处理，如果找不到返回错误信息。
intFlag=InstrB(theformData,Divider & bncrlf & strTemp)
Dim arrayTemp()
If intFlag>0 Then
'因为后面要用到文件的名字，所以首先返回文件的名字
dataStart=intFlag+LenB(Divider & bncrlf & strTemp) '定位到第1个字符
dataend=InstrB(datastart,theformData,bncrlf)-2 '定位到最后1个字符
dataLen=dataend-datastart+1 '返回要取信息的长度
filepath=BinaryToString(MidB(theformData,datastart,datalen)) '返回文件路径
filename=Mid(filepath,InstrRev(filepath,"\")+1)
'从当前位置找到两个回车换行符，也就是文件内容开头的地方
dataStart=InstrB(intFlag,theformData,bncrlf & bncrlf)+4 '定位到文件内容所在的第1个字符
dataEnd=InstrB(datastart,theformData,divider)-3 '定位到文件内容的最后一个字符
dataLen=dataend-datastart+1 '返回文件内容的长度
If dataLen<=0 Then
SaveToFile=3
Exit Function
End If

'下面建立了两个Stream对象，objStream1将整个theformData读取到对象中，然后将其中的文件内容部分复制到
'objStream2对象中，然后再利用SaveToFile方法保存到指定文件夹下。
Dim objStream1
Set objStream1=Server.CreateObject("Adodb.Stream")
objStream1.Type = 1 '设置二进制方式
objStream1.Open '打开对象
objStream1.Write theformData '写出文件内容到对象中
Dim objStream2
Set objStream2=Server.CreateObject("Adodb.Stream")
objStream2.Type = 1 '设置二进制方式
objStream2.Open '打开对象
objStream1.Position=datastart-1 '设定起始位置，这里索引从0开始，所以减1
objStream1.CopyTo objStream2,dataLen '写出文件内容到对象中
'如果允许覆盖，才覆盖，否则给出提示信息，提示客户更改名字
If OverWriteFlag=True Then
objStream2.SaveToFile SaveFilePath & "\" & filename,2 '保存文件,2表示可以覆盖
Else
Set fso=Server.CreateObject("Scripting.FileSystemObject")
IF fso.FileExists(SaveFilePath & "\" & filename)=True Then
SaveToFile=2 '返回函数值，1表示已经存在同名文件
Exit Function
Else
objStream2.SaveToFile SaveFilePath & "\" & filename,1 '1表示不可以覆盖
End If
End IF

'关闭对象
objStream1.Close
Set objStream1=Nothing
objStream2.Close
Set objStream2=Nothing
SaveToFile=1 '下面返回函数值，0表示正常
Else
SaveToFile=0 '下面返回函数值，2表示找不到，发生错误
End If
End Function

'下面定义保存文件到数据库的方法
Public Function SaveToDataBase(FormName,strConn,strSql)
Dim bncrlf,divider
bncrlf=ChrB(13) & ChrB(10) '回车换行标记
divider=LeftB(theformData,CInt(InstrB(theformdata,bncrlf))-1) '分隔符
'下面开始查找该FormName对应的内容，strTemp变量用来保存一个二进制字符串
'dataStart为开始位置，dataEnd为结束位置，dataLen为要取信息的长度,temp为临时使用。
Dim strTemp,dataStart,dataEnd,dataLen,temp,intFlag,fileimage
'因为发生引号嵌套，这里的内层引号用""代替。
strTemp=StringToBinary("Content-Disposition: form-data; name=""" & FormName & """; filename=""")
'在formData中查找二进制字符串strTemp,如果找到了就继续处理，如果找不到返回错误信息。
intFlag=InstrB(theformData,Divider & bncrlf & strTemp)
Dim arrayTemp()
If intFlag>0 Then
'从当前位置找到两个回车换行符，也就是文件内容开头的地方
dataStart=InstrB(intFlag,theformData,bncrlf & bncrlf)+4 '定位到文件内容所在的第1个字符
dataEnd=InstrB(datastart,theformData,divider)-3 '定位到文件内容的最后一个字符
dataLen=dataend-datastart+1 '返回文件内容的长度
fileimage=MidB(theformData,datastart,datalen) '返回二进制文件内容

If dataLen<=0 Then
SaveToFile=3 '3表示根本没有选择文件
Exit Function
End If

'！！！因为当文件大小为奇数字符时，在往数据库中保存时有一些小问题，会少一个字节，所以这里先给它加一个二进制空格
If dataLen Mod 2 = 1 Then
fileimage=fileimage & Chrb(32)
datalen=datalen+1
End If

'下面将文件保存到数据库中
Dim db,cmd,rs
Set db=Server.CreateObject("ADODB.Connection")
db.Open strConn
Set cmd= Server.CreateObject("ADODB.Command")
cmd.ActiveConnection=db
cmd.CommandText=strSql
'下面建立一个参数对象prm，并将该对象加入到参数集合中,204表示是二进制值
Dim prm
Set prm=cmd.CreateParameter("fileimage",204,1,datalen,fileimage)
cmd.Parameters.Append prm
set rs=cmd.Execute
SaveToDatabase=1 '返回函数值，0表示正常
Else
SaveToDatabase=0 '返回函数值，2表示错误
End If
End Function

'下面是注销该类的方法
Private Sub Class_Terminate()
'theformData=Nothing
End Sub

End Class
'----------------------------------------------------------------------------------
Class MyGetForms
'定义1个私有变量
Dim theValue
'定义几个只读属性，用来返回有关信息
Public Property Get Value
Value=theValue
End Property

'下面是初始化类的方法
Private Sub Class_Initialize()
End Sub

'该方法给属性赋值
Public Sub GetValue(formData,FormName)
Dim bncrlf,divider
bncrlf=ChrB(13) & ChrB(10) '回车换行标记
divider=LeftB(formData,CInt(InstrB(formdata,bncrlf))-1) '分隔符
'下面开始查找该FormName对应的内容，下面会首先定义几个变量,strTemp为一个字符串变量，临时保存二进制字符串
'dataStart为开始位置，dataEnd为结束位置，dataLen为要取信息的长度,temp为临时使用，为了记住当前位置。
Dim strTemp,dataStart,dataEnd,dataLen,temp,intFlag
strTemp=StringToBinary("Content-Disposition: form-data; name=""" & FormName & """")
'在整个二进制字符串中查找下面这一个二进制字符串
intFlag=InstrB(formData,Divider & bncrlf & strTemp & bncrlf & bncrlf)
'如果找到了，就依次返回有关信息,如果找不到，就返回一个错误信息
If intFlag>0 Then
datastart=intFlag+LenB(Divider & bncrlf & strTemp & bncrlf & bncrlf) '定位到第1个字符
dataend=InstrB(datastart,formdata,divider)-3 '定位到最后1个字符
dataLen=dataend-datastart+1 '返回要取信息的长度
theValue=BinaryToString(MidB(formdata,datastart,datalen)) '返回出表单内容信息
Else
theValue=""
End If
End Sub
End Class

'------------------------------------------------------------------------------------------------
'该函数可以将二进制字符串转换成文本字符串
Function BinaryToString(thedata)
'变量strNow表示正在处理的字符，strTemp用来保存已经处理完毕的字符串
'变量flag是一个标志，False表示前一个字符不是中文，True表示前一个字符是中文
Dim strNow,strTemp,flag,I
flag=False
'利用循环依次转换每一个字符
For I=1 To LenB(thedata)
'因为一个中文字符包括两个字节，如果flag=True，表示前一个字符是中文，所以
'要跳过该字符，需要令标志flag=False。否则表示不是中文，就需要将其转换
If flag=True Then
flag=False
Else
'取出当前二进制字符
strNow=MidB(thedata,I,1)
'如果AscB(strNow)>127，表示这是一个中文字符，AscB(tsrNow)<127，表示不是中文字符
If AscB(strNow) > 127 Then
'如果是中文，首先需要把当前字符和下一个字符调换位置，然后用AscW
'返回对应的ASCII码。随之，用Chr函数返回该ASCII码对应的文本
'最后，还要把中文标志设为True
strTemp=strTemp & Chr(AscW(MidB(thedata,I+1,1) & strNow))
flag=True
Else
'这表示是英文，AscB返回对应的ASCII码，Chr返回对应的文本字符
strTemp=strTemp & Chr(AscB(strNow))
End If
End If
Next
BinaryToString=strTemp '返回函数值
End Function

'该函数可以将文本字符串转换成二进制字符串
Function StringToBinary(thedata)
'变量strNow表示正在处理的字符，strTemp用来保存已经处理完毕的字符串
'变量intNow用来表示当前字符的ASCII码
'变量ascLow和ascHigh用来保存中文字符的第1个和第2个字节
Dim strNow,intNow,strTemp,I,binLow,binHigh
'利用循环依次转换每一个字符
For I=1 To Len(thedata)
'取出当前文本字符，并返回ASCII码
strNow=Mid(thedata,I,1)
intNow=Asc(strNow)
'如果Asc(strNow)<0，则表示是中文字符，则需要加上65535返回它的无符号数值
If intNow<0 Then
intNow=intNow+65535
End If
'如果加上65535后ASCII码大于255，则表示是中文，中文是用两个字节表示的，必须分开处理。当然，如果是英文字符就简单了
If intNow>255 Then
'这里binLow返回低字节，binHigh返回高字节其中Hex函数返回一个字符串，表示一个数字的十六进制数
binLow="&H" & Left(Hex(Asc(strNow)),2)
binHigh="&H" & Right(Hex(Asc(strNow)),2)
strTemp=strTemp & ChrB(binLow) & ChrB(binHigh)
Else
'这表示是英文，Asc函数返回ASCII码，ChrB返回对应的二进制字符。
strTemp=strTemp & ChrB(Asc(strNow))
End If
Next
StringToBinary=strTemp '返回函数值
End Function
%>

基本步骤：
1、用一个InternetOpen调用设置环境。
2、调用InternetConnect 函数与主机连接。
3、调用FtpGetFile 达到文件。
4、关闭第1、2步创建的句柄，用InternetCloseHandle 函数。
现在来仔细看看每一步：
1、通过调用InternetOpen 函数设置环境。下面是VB特定调用这一函数的声明：
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
参数sAgent 用来指定调用WinINet 函数的应用程序或实体。为了达到目的，可以设置FTP控制。
参数lAccessType 指定我们是直接与某一主机相连还是使用代理服务器相连。如果传递值1，就直接与主机连接。如果传递3，就通过代理服务器。如果传递0，连接时就要基于
HKEY_CURRENT_USERSoftwareMicrosoftWindowsCurrentVersionInternet Settings下的注册表数值
ProxyEnable、ProxyServer和 ProxyOverride 。
我们可以使用参数sProxyName和 sProxyBypass，而不是注册设置来提供代理服务器和不使用代理服务器的IP地址和名字。列出代理的基本格式是rotocol＝protocol：//proxy_name：access_port？。例如，要指定Proxy1 上的端口21为代理服务器，用Ftp＝ftp：//Proxy1：21？作为sProxyName。要饶过以ov？开始的任何主机，sProxyBypass 字符串应为ov？。
最后，lFlags 用来显示影响函数结果的不同选择。在我们的例子中，我们传递0。
所以，不使用代理而打开一个Internet session 时，我们的调用是这样的：
lngINet ＝ InternetOpen（“FTP Control”， 1， vbNullString， vbNullString， 0）
如果函数调用失败，lngINet 为0。不然，lngINet 就保存在下一步中将要传递给InternetConnect函数的句柄的值。
2、通过调用InternetConnect 函数与主机连接。VB特定调用这一函数的声明是：
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
第一个参数hInternetSession 是InternetOpen 调用返回的句柄值。
sServerName 是我们即将连接的FTP服务器的IP地址或主机名。
nServerPort 指示与哪一个端口连接。在我们的例子中使用的值为0，它指示的是默认的端口21。
sUsername 和 sPassword 分别传递用户名和口令。
lService 用来指示使用的服务类型，如HTTP， FTP等。通常传递值为1，表示FTP服务。
如果将x8000000传递到 lFlags 参数，连接将使用被动FTP语义。或者，在我们的例子中，传递0来使用非被动语义。
最后，当使用回叫信号时，lContext 用来识别应用程序的前后关系。因为在我们的例子中不使用回叫信号，所以这个值为0。
现在使用匿名的电子邮件用户名与主机FTP。MICROSOFT。COM 相连接：
lngINetConn ＝ InternetConnect（lngINet， “ftp。microsoft。com”， 0， _
“anonymous”，”ally@wallyworld。com”， 1， 0， 0）
如果函数调用失败，则lngINetConn 为0。反之，lngINetConn 就保存在下一步中将传递给FtpGetFile 的句柄的值。
3、现在我们已经实现了连接，然后就需要调用FtpGetFile 。这个函数完成从一个FTP服务器上读取文件并在本地存储时有关的所有管理功能。VB特定调用这一函数的声明是：
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
第一个参数hFtpSession 是InternetConnect 调用返回的句柄值。
lpszRemoteFile和lpszNewFile 分别是FTP服务器上的文件名和将在本地机上创建的文件名。
fFailIfExists 标志是0（替换本地文件）或1 （如果本地文件已经存在则取消）。
dwFlagsAndAttributes 用来指定本地文件的文件属性。在我们的例子中忽略，只传递0。
dwFlags 参数指定为1是用ASCII 传输文件（A类传输方法），指定为2是用二进制传输文件（1类传输方法）。由于DIRMAP。TXT 是ASCII 文本文件，我们传递值1。
最后，当使用回叫信号时，lContext 用来识别应用程序前后关系。因为在我们的例子中不使用回叫信号，所以这个值为0。
所以，以下是得到DIRMAP。TXT文件并将其存在 C：DIRMAP。TXT的调用。如果本地文件已经存在，就覆盖它。
blnRC ＝ FtpGetFile（lngINetConn， “dirmap。txt”，”c：dirmap。txt”， 0， 0， 1， 0）
如果函数调用成功，blnRC为 True，反之为False。
4、现在文件已经被接收，使用InternetCloseHandle 调用来关闭连接和session 句柄。VB特定调用这一函数的声明是：
Private Declare Function InternetCloseHandle Lib "wininet。dll" （ByVal hInet As Long） As Integer。
如同指明的一样，此函数只有一个参数hInet，是要关闭或抛弃的句柄的值。因为InternetConnection 和InternetOpen 中有句柄，就需要调用这个关闭函数两次。另外因为InternetConnection 句柄是由InternetOpen 句柄决定的，关闭他们时的顺序与创建时相反。
以下是调用函数：
InternetCloseHandle lngINetConn
InternetCloseHandle lngINet
用这短短的四步就完成了FTP GET。

您可能感兴趣问答

Collapsible

热门标签

热点问答