上次弄了个文本图形上传的代码没人理会，这回写了成了函数，以供交流共享

[skywolfY]

此代码是ASP上传图片时，文本数据同图形数据同时上传，取得后进行分割。不完善，但可以使用。
请高手多指教。
有个函数是查看文本文件是不是二进制文件。方法一般化，不是100%正确。

部分函数来自网上，由于本人较懒惰，恕不另行说明。

'取大小
lBit=Request.TotalBytes

if lBit > ltmp001 then
' 其它处理
'.....
Response.End
end if
'读数据
sBinaryData=Request.BinaryRead(lBit)

dim sID
dim sInfoTmp
dim sBinTmp
'分割二进制字符
dim sArrayTmp()
dim sDiv
dim sCrlf
sCrlf=chrB(13) & chrB(10)
sDiv=leftB(sBinaryData,clng(instrb(sBinaryData,sCrlf))-1)
funSplit sArrayTmp,sBinaryData,sDiv

'**************************************************
sID=funGetDataByPos (sarraytmp(1),"txtID",0)

sInfoTmp=funGetDataByPos(sarraytmp(2),"Txt1",0)

'sID=funBinaryDataByName(sBinaryData,1,"txtID",0)
'sInfoTmp=funBinaryDataByName(sBinaryData,2,"Txt1",0)



if Len(sInfoTmp)>200 then
sInfoTmp=Mid(sInfoTmp,1,200)
end if

'sBinTmp=funBinaryDataByName(sBinaryData,3,"Txt2",1)
sBinTmp=funGetDataByPos(sarraytmp(3),"Txt2",1)


'查看是否是二进制数据
if funCheckPic(sBinTmp)=false then

FunWriteLog "上传非法文件"
'其它处理
',....................
Response.End
end if

以上为调用方式

Function funBinaryDataByName(byref sArrayOriTmp,byval sOriString,byval lRePos,byval sName ,byval nBinary)
'返回二进制数据的内容
'sOriString 二进制字符串
'sName 要读取内容的控件名称，同名只读取第一个
'nBinary 是否读取二进制图形数据
Dim sCrlf '回车换行
Dim sDiv '分割符 一般是
'-----------------------------7d51d4d901e8
'系统不同有不所同
dim sTmp '用于临时的字符存贮
dim lPos '临时的字符位置
dim sFindChar '存查找的字段名字符
dim lBegin '图形数据的起点
dim lEnd '图形数据的终止点
dim sStringTmp '原临时数组


dim sArrayBinary()

sFindChar="name=""" & sName & """"

sCrlf=chrB(13) & chrB(10)
'读取分割符形式
sDiv=leftB(sOriString,clng(instrb(sOriString,sCrlf))-1)
'Response.Write "<br><hr>sDiv<br>"

'funwritetmp sDiv,0
'Response.Write "<br>"
'Response.Write "<Hr>"
'以此分割符对字符串进行分组
dim i
lbegin=1
'去除首分割
sStringTmp=sOristring

'FunWriteTmp sStringTmp,0


'sArrayBinary=split(sOristring,sDiv,-1,0)
funSplit sArrayBinary,soristring,sdiv
dim l
if lRePos>UBound(sArrayBinary) then exit function
lPos=0
'Response.Write "数组上界:" & UBound(sArrayBinary)

'Response.Write "<br>"
'Response.Write "索引:" & lRePos
'Response.Write "<br>"
lbegin=0
if nBinary=0 then
'文本数据
sTmp=funBytes2bstr(sArrayBinary(lRePos))
'FunWriteTmp stmp,0
'Response.Write "aaaaaaaaa__"
lpos=instrRev(stmp,sFindChar)
if lPos<> 0 then
sTmp=Mid(stmp,lPos+len(sFindchar)+2,len(stmp)-lpos)
funBinaryDataByName=sTmp
'Response.Write "文本内容:" & stmp
exit function
else
'Response.Write "未找到"
end if
else
'图形数据
'处理图形数据
if lenb(sArrayBinary(lRePos))=0 then exit function
'FunWriteTmp sArrayBinary(lRePos),0
lBegin=instrb(sArrayBinary(lRePos),sCrlf & sCrlf)+4

'lEnd=instrb(lBegin+1,sArrayBinary(lRePos),sDiv)-lBegin

'if lend<lbegin then exit function
'Response.Write lbegin & ":"& lend
sTmp=midb(sArrayBinary(lRePos),lBegin,lenb(sArrayBinary(lRePos)))
funBinaryDataByName=sTmp

end if
End Function
function funBytes2bstr(vin)
'将二进制传为字符，对中文进行处理
dim strreturn
dim i
dim thischarcode,nextcharcode
strreturn = ""
for i = 1 to lenb(vin)
thischarcode = ascb(midb(vin,i,1))
if thischarcode < &h80 then
strreturn = strreturn & chr(thischarcode)
else
nextcharcode = ascb(midb(vin,i+1,1))
strreturn = strreturn & chr(clng(thischarcode) * &h100 + cint(nextcharcode))
i = i + 1
end if
next
funbytes2bstr = strreturn
end function
Private function toByte(Str)
dim i,iCode,c,iLow,iHigh
toByte=""
For i=1 To Len(Str)
c=mid(Str,i,1)
iCode =Asc(c)
If iCode<0 Then iCode = iCode + 65535
If iCode>255 Then
iLow = Left(Hex(Asc(c)),2)
iHigh =Right(Hex(Asc(c)),2)
toByte = toByte & chrB("&H"&iLow) & chrB("&H"&iHigh)
Else
toByte = toByte & chrB(AscB(c))
End If
Next
End function

Function funCheckPic(byval sBinData)
'查是否是二进制数据
On Error Resume Next
funCheckPic = False

'转成字符形式
Dim sDataTmp
Dim l
Dim lLen
Dim sTmp
Dim lBe
Dim lFind
If sBinData = "" Then
funCheckPic = True
Exit Function
End If
lLen = Len(sBinData)
Randomize


If lLen > 200 Then
lLen = 200
End If
'如果长度小于200，取全体字符
If lLen - 200 < 0 Then
lBe = 1
Else
lBe = Int((lLen - 200 * Rnd) + 1)
End If
sTmp=midb(sBinData,lBe,lBe+lLen)
sDataTmp=trim(funBytes2bstr(stmp))
sDataTmp = Replace(sDataTmp, " ", "")
lFind = 0
sTmp=""
For l = lBe To lBe + lLen
sTmp = Mid(sDataTmp, l, 1)
If sTmp <> "" Then
If (Asc(sTmp) > 65 And Asc(sTmp) < 122) Or (Asc(sTmp) > 48 And Asc(sTmp) < 57) Then
lFind = lFind + 1
End If
End If

Next
If lFind < 50 Then
funCheckPic = True
End If
End Function

[skywolfY]

Function funSplit(byref sTmpStr(),byval ExpStr,byval sDiv)
'分开二进制字符

dim i
dim sTmp
dim lBegin
dim lPos
dim sCutTmp
scutTmp=ExpStr
i=0
if lenb(expstr)=0 then exit function
lbegin=1
do
redim Preserve sTmpStr(i)
lPos=instrb(scutTmp,sDiv)
if lPos=0 then
sTmpStr(i)=scutTmp
exit do
end if
sTmp=midb(scutTmp,lBegin,lpos-1)
sTmpstr(i)=sTmp
scutTmp=midb(scutTmp,lpos+lenb(sdiv)+2,lenb(scutTmp))

i=i+1
loop

end Function

[skywolfY]

Asp有个分割函数，但对二进制的分割，我所用的总是出现不正确的现象，大概十分之一的机率。没办法只能自己写个分割函数。

[patchclass]

帮顶，宝玉的进度条上传的那个函数不是蛮不错的，也带这个功能的吧

[skywolfY]

上网少，没看到过，能指点下在哪里找吗？

[skywolfY]

Function funGetDataByPos(byval sOriString,byval sName ,byval nBinary)
'sOriString 二进制字符串
'sName 要读取内容的控件名称，同名只读取第一个

Dim sCrlf '回车换行
'系统不同有不所同
dim sTmp '用于临时的字符存贮
dim lPos '临时的字符位置
dim sFindChar '存查找的字段名字符
dim lBegin '图形数据的起点
dim lEnd '图形数据的终止点
dim sStringTmp '原临时数组

sFindChar="name=""" & sName & """"

sCrlf=chrB(13) & chrB(10)
dim i
lbegin=1
dim l
lPos=0
lbegin=0
if nBinary=0 then
'文本数据
sTmp=funBytes2bstr(sOriString)
'FunWriteTmp stmp,0
'Response.Write "aaaaaaaaa__"
lpos=instrRev(stmp,sFindChar)
if lPos<> 0 then
sTmp=Mid(stmp,lPos+len(sFindchar)+2,len(stmp)-lpos)
funGetDataByPos=sTmp
'Response.Write "文本内容:" & stmp
exit function
else
'Response.Write "未找到"
end if
else
'图形数据
'处理图形数据
if lenb(sOriString)=0 then exit function
'FunWriteTmp sArrayBinary(lRePos),0
lBegin=instrb(sOriString,sCrlf & sCrlf)+4

'lEnd=instrb(lBegin+1,sArrayBinary(lRePos),sDiv)-lBegin

'if lend<lbegin then exit function
'Response.Write lbegin & ":"& lend
sTmp=midb(sOriString,lBegin,lenb(sOriString))
funGetDataByPos=sTmp

end if
End Function