2004527140051.inc

这是一个数字教育系统,也是师兄的毕业设计,具体的功能我也不清楚,不过是可以用来答辩的,完整的毕业设计,有源代码,可爱执行文件,文档资料.

<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
'限制上传图片大小
Dim UploadSizeLimit

'********************************** 得到上传数据 **********************************
Function GetUpload()
Dim Result
Set Result = Nothing
set errchk=nothing
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then '检查表单是否以POST形式提交
Dim CT, PosB, Boundary, Length, PosE,errtxt
CT = Request.ServerVariables("HTTP_Content_Type") '读取前页文件头
 If LCase(Left(CT, 19)) = "multipart/form-data" Then '检查表单的Content是以multipart/form-data形式提交
 PosB = InStr(LCase(CT), "boundary=") '找到内容的分界
If PosB > 0 Then Boundary = Mid(CT, PosB + 9) '划出内容部分
Length = CLng(Request.ServerVariables("HTTP_Content_Length")) '给出上传文件的大小
   if "" & UploadSizeLimit<>"" then  '如果有图片上传限制就对比上传文件，否则无限制
   UploadSizeLimit = clng(UploadSizeLimit)
     if Length > UploadSizeLimit then 
     Request.BinaryRead(Length)
     exit function
     end if
   end if

     If Length > 0 And Boundary <> "" Then '判断是否有数据提交
     Boundary = "--" & Boundary
     Dim Head, Binary
     Binary = Request.BinaryRead(Length) 'Reads binary data from client

'得到上传文件的解决数据
     Set Result = SeparateFields(Binary, Boundary) 
     Binary = Empty 'Clear variables
     End If
  End If
End If

Set GetUpload = Result
End Function


Function SeparateFields(Binary, Boundary)   '对上传的内容分别进行函数换算
Dim PosOpenBoundary, PosCloseBoundary, PosEndOfHeader, isLastBoundary
Dim Fields
Boundary = StringToBinary(Boundary)

PosOpenBoundary = InstrB(Binary, Boundary)
PosCloseBoundary = InstrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary, 0)

Set Fields = CreateObject("Scripting.Dictionary")

Do While (PosOpenBoundary > 0 And PosCloseBoundary > 0 And Not isLastBoundary)
'Header and file/source field data
Dim HeaderContent, FieldContent
'Header fields
Dim Content_Disposition, FormFieldName, SourceFileName, Content_Type
'Helping variables
Dim Field, TwoCharsAfterEndBoundary
'Get end of header
PosEndOfHeader = InstrB(PosOpenBoundary + Len(Boundary), Binary, StringToBinary(vbCrLf + vbCrLf))

'Separates field header
HeaderContent = MidB(Binary, PosOpenBoundary + LenB(Boundary) + 2, PosEndOfHeader - PosOpenBoundary - LenB(Boundary) - 2)

'Separates field content
FieldContent = MidB(Binary, (PosEndOfHeader + 4), PosCloseBoundary - (PosEndOfHeader + 4) - 2)

'Separates header fields from header
GetHeadFields BinaryToString(HeaderContent), Content_Disposition, FormFieldName, SourceFileName, Content_Type

'Create one field and assign parameters
Set Field = CreateUploadField()
Field.Name = FormFieldName
Field.ContentDisposition = Content_Disposition
Field.FilePath = SourceFileName
Field.FileName = GetFileName(SourceFileName)
Field.ContentType = Content_Type
Field.Value = FieldContent
Field.Length = LenB(FieldContent)


Fields.Add FormFieldName, Field

'看看是否结束对上传内容的分析？
TwoCharsAfterEndBoundary = BinaryToString(MidB(Binary, PosCloseBoundary + LenB(Boundary), 2))
isLastBoundary = TwoCharsAfterEndBoundary = "--"
   If Not isLastBoundary Then 'This is not ending boundary - go to next form field.
   PosOpenBoundary = PosCloseBoundary
   PosCloseBoundary = InStrB(PosOpenBoundary + LenB(Boundary), Binary, Boundary )
   End If
Loop
Set SeparateFields = Fields
End Function

'********************************** Utilities **********************************
Function BinaryToString(str)
strto = ""
for i=1 to lenb(str)
   if AscB(MidB(str, i, 1)) > 127 then
strto = strto & chr(Ascb(MidB(str, i, 1))*256+Ascb(MidB(str, i+1, 1)))
i = i + 1
   else
strto = strto & Chr(AscB(MidB(str, i, 1)))
   end if
next
BinaryToString=strto
End Function

Function StringToBinary(String)
Dim I, B
For I=1 to len(String)
B = B & ChrB(Asc(Mid(String,I,1)))
Next 
StringToBinary = B
End Function

'Separates header fields from upload header
Function GetHeadFields(ByVal Head, Content_Disposition, Name, FileName, Content_Type)
Content_Disposition = LTrim(SeparateField(Head, "content-disposition:", ";"))
Name = (SeparateField(Head, "name=", ";")) 'ltrim
If Left(Name, 1) = """" Then Name = Mid(Name, 2, Len(Name) - 2)
FileName = (SeparateField(Head, "filename=", ";")) 'ltrim
If Left(FileName, 1) = """" Then FileName = Mid(FileName, 2, Len(FileName) - 2)
Content_Type = LTrim(SeparateField(Head, "content-type:", ";"))
End Function

'找出上传文件的开始和结束的位置
Function SeparateField(From, ByVal sStart, ByVal sEnd)
Dim PosB, PosE, sFrom
sFrom = LCase(From)
PosB = InStr(sFrom, sStart)
If PosB > 0 Then
PosB = PosB + Len(sStart)
PosE = InStr(PosB, sFrom, sEnd)
If PosE = 0 Then PosE = InStr(PosB, sFrom, vbCrLf)
If PosE = 0 Then PosE = Len(sFrom) + 1
SeparateField = Mid(From, PosB, PosE - PosB)
Else
SeparateField = Empty
End If
End Function

'对文件名进行检测并得出结果
Function GetFileName(FullPath)
Dim Pos, PosF
PosF = 0
For Pos = Len(FullPath) To 1 Step -1
Select Case Mid(FullPath, Pos, 1)
Case "/", "\": PosF = Pos + 1: Pos = 0
End Select
Next
If PosF = 0 Then PosF = 1
GetFileName = Mid(FullPath, PosF)
End Function
</SCRIPT>

<SCRIPT RUNAT=SERVER LANGUAGE=JSCRIPT>
//The function creates Field object.
function CreateUploadField(){ return new uf_Init() }
function uf_Init(){
this.Name = null
this.ContentDisposition = null
this.FileName = null
this.FilePath = null
this.ContentType = null
this.Value = null
this.Length = null
}
</SCRIPT>