-
利用JS实现gb2312编码
2007-10-08 14:21:55
-
ASP的COM接口
2007-10-08 14:17:21
-
ASP上传类
2007-06-07 17:13:12
发现一直没有更新自己的小窝
上来充实一下吧,呵呵,发个以前写的小东东
在以前的版本上基本没什么改动,增加上了文件大小的检测,功能主要实现了以下几点:
1. 支持多个文件同时上传
2. 可对普通表单与上传文件分离
3. 自定义上传文件存放
4. 流处理，上传速度比较理想
5. 调用简单方便<%
Class Upload
Public Form, IsFinished
Private bVBCrlf, bSeparate, formData, fileType, fileSize, folderPath, itemCount, sErrors, sAuthor, sVersion
Private itemStart(), itemLength(), dataStart(), dataLength(), itemName(), itemData(), extenArr()Private Sub Class_Initialize
formData = Request.BinaryRead(Request.TotalBytes)
Set Form = Server.CreateObject("scrīpting.Dictionary")
sAuthor = "51JS.COM-ZMM"
sVersion = "Upload Class 2.0"
Server.scrīptTimeOut = 900
End Sub
Public Property Get ErrMessage
ErrMessage = sErrors
End Property
Public Property Get ClsAuthor
ClsAuthor = sAuthor
End PropertyPublic Property Get ClsVersion
ClsVersion = sVersion
End PropertyPublic Property Let AllowType(byVal sType)
fileType = sType
End PropertyPublic Property Let MaxSize(byVal sSize)
If Not IsNumeric(sSize) Then
fileSize = ""
Else
fileSize = CDbl(FormatNumber(CCur(sSize), 2))
End If
End PropertyPublic Property Let SaveFolder(byVal sFolder)
folderPath = sFolder
End PropertyPublic Function Start
IsFinished = False
bVBCrlf = StrToByte(vbCrlf & vbCrlf)
bSeparate = StrToByte("-----------------------------")
itemCount = 0
sErrors = ""
Call ItemPosition
End FunctionPrivate Function ItemPosition
Dim iStart, iLength : iStart = 1
Do Until InStrB(iStart, formData, bSeparate) = 0
iStart = InStrB(iStart, formData, bSeparate) + LenB(bSeparate) + 14
iLength = InStrB(iStart, formData, bSeparate) - iStart - 2
If Abs(iStart + 2 - LenB(formData)) > 2 Then
ReDim Preserve itemStart(itemCount)
ReDim Preserve itemLength(itemCount)
itemStart(itemCount) = iStart
itemLength(itemCount) = iLength
itemCount = itemCount + 1
End If
Loop
Call FillItemValue
End FunctionPrivate Function FillItemValue
Dim dataPart, bInfor
Dim iStart : iStart = 1
Dim iCount : iCount = 0
Dim iCheck : iCheck = StrToByte("filename")
For i = 0 To itemCount - 1
ReDim Preserve itemName(iCount)
ReDim Preserve itemData(iCount)
ReDim Preserve extenArr(iCount)
ReDim Preserve dataStart(iCount)
ReDim Preserve dataLength(iCount)
dataPart = MidB(formData, itemStart(i), itemLength(i))
iStart = InStrB(1, dataPart, ChrB(34)) + 1
iLength = InStrB(iStart, dataPart, ChrB(34)) - iStart
itemName(iCount) = FormItemName(MidB(dataPart, iStart, iLength))
iStart = InStrB(1, dataPart, bVBCrlf) + 4
iLength = LenB(dataPart) - iStart + 1
If InStrB(1, dataPart, iCheck) > 0 Then
bInfor = MidB(dataPart, 1, iStart - 5)
extenArr(iCount) = FileExtenName(bInfor)
If Mid(folderPath, Len(folderPath) - 1) = "/" Then
itemData(iCount) = folderPath & GetRndName(6) & extenArr(iCount)
Else
itemData(iCount) = folderPath & "/" & GetRndName(6) & extenArr(iCount)
End If
dataStart(iCount) = itemStart(i) + iStart - 2
dataLength(iCount) = iLength
Else
extenArr(iCount) = ""
itemData(iCount) = ByteToStr(MidB(dataPart, iStart, iLength))
dataStart(iCount) = ""
dataLength(iCount) = ""
End If
iCount = iCount + 1
Next
Call SaveUpload
End FunctionPrivate Function FormItemName(byVal bName)
FormItemName = ByteToStr(bName)
End FunctionPrivate Function FileExtenName(byVal bInfor)
Dim pStart, pLength, pContent, regEx
pStart = InStr(1, ByteToStr(bInfor), "filename=" & Chr(34)) + 10
pLength = InStr(pStart, ByteToStr(bInfor), Chr(34)) - pStart
pContent = Mid(ByteToStr(bInfor), pStart, pLength)
If pContent = "" Then
FileExtenName = ""
Else
Set regEx = New RegExp
regEx.Pattern = "^.*(\.[^\.]*)$"
regEx.Global = False
regEx.IgnoreCase = True
FileExtenName = regEx.Replace(pContent, "$1")
Set regEx = Nothing
End If
End FunctionPrivate Function GetRndName(byVal sLen)
Dim regEx, sTemp, arrFields, n : n = 0
Set regEx = New RegExp
regEx.Pattern = "[^\d]*"
regEx.Global = True
regEx.IgnoreCase = True
sTemp = regEx.Replace(Now, "") & "-"
Set regEx = Nothing
arrFields = Array("0", "1", "2", "3", "4", "5", "6", "7", "8", "9", _
"a", "b", "c", "d", "e", "f", "g", "h", "i", "j", _
"k", "l", "m", "n", "o", "p", "q", "r", "s", "t", _
"u", "v", "w", "x", "y", "z", "A", "B", "C", "D", _
"E", "F", "G", "H", "I", "J", "K", "L", "M", "N", _
"O", "P", "Q", "R", "S", "T", "U", "V", "W", "X", _
"Y", "Z")
Randomize
Do While n < sLen
sTemp = sTemp & CStr(arrFields(61 * Rnd))
n = n + 1
Loop
GetRndName = sTemp
End FunctionPrivate Function SaveUpload
Dim isValidate
Dim filePath, oStreamGet, oStreamPut
isValidate = CheckFile
If isValidate Then
For i = 0 To itemCount - 1
If (dataStart(i) <> "") And (dataLength(i) <> "") Then
If dataLength(i) = 0 Then
itemData(i) = ""
Else
filePath = Server.MapPath(itemData(i))
If CreateFolder("|", ParentFolder(filePath)) Then
Set ōStreamGet = Server.CreateObject("ADODB.Stream")
oStreamGet.Type = 1
oStreamGet.Mode = 3
oStreamGet.Open
oStreamGet.Write formData
oStreamGet.Position = dataStart(i)
Set ōStreamPut = Server.CreateObject("ADODB.Stream")
oStreamPut.Type = 1
oStreamPut.Mode = 3
oStreamPut.Open
oStreamPut.Write oStreamGet.Read(dataLength(i))
oStreamPut.SaveToFile(filePath)
oStreamGet.Close
Set ōStreamGet = Nothing
oStreamPut.Close
Set ōStreamPut = Nothing
End If
End If
End If
Next
IsFinished = True
Call ItemToColl
Else
IsFinished = False
End If
End FunctionPrivate Function CheckFile
Dim oBoolean : ōBoolean = True
CheckFile = oBoolean And CheckType And CheckSize
End FunctionPrivate Function CheckType
Dim oBoolean : ōBoolean = True
If fileType = "" Then
ōBoolean = oBoolean And True
Else
For i = 0 To itemCount - 1
If extenArr(i) <> "" Then
If InStr(1, Ucase(fileType), "|" & Ucase(Mid(extenArr(i), 2)) & "|") > 0 Then
ōBoolean = oBoolean And True
Else
sErrors = sErrors & "表单 [ " & itemName(i) & " ] 的文件格式错误！\n" & _
"支持的格式为：" & Replace(Mid(fileType, 2, Len(fileType) - 1), "|", " ") & "\n\n"
ōBoolean = oBoolean And False
End If
End If
Next
End If
CheckType = oBoolean
End FunctionPrivate Function CheckSize
Dim oBoolean : ōBoolean = True
If fileSize = "" Then
ōBoolean = oBoolean And True
Else
For i = 0 To itemCount - 1
If dataLength(i) <> "" Then
Dim tmpSize
tmpSize = CDbl(FormatNumber(CCur(dataLength(i)) / 1024, 2))
If tmpSize <= fileSize Then
ōBoolean = oBoolean And True
Else
sErrors = sErrors & "表单 [ " & itemName(i) & " ] 的文件大小 (" & tmpSize & " KB) 超出范围！\n" & _
"支持大小范围：<= " & fileSize & " KB\n\n"
ōBoolean = oBoolean And False
End If
End If
Next
End If
CheckSize = oBoolean
End FunctionPrivate Function CreateFolder(byVal sLine, byVal sPath)
Dim oFso
Set ōFso = Server.CreateObject("scrīpting.FileSystemObject")
If Not oFso.FolderExists(sPath) Then
Dim regEx
Set regEx = New RegExp
regEx.Pattern = "^(.*)\\([^\\]*)$"
regEx.Global = False
regEx.IgnoreCase = True
sLine = sLine & regEx.Replace(sPath, "$2") & "|"
sPath = regEx.Replace(sPath, "$1")
If CreateFolder(sLine, sPath) Then CreateFolder = True
Set regEx = Nothing
Else
If sLine = "|" Then
CreateFolder = True
Else
Dim sTemp : sTemp = Mid(sLine, 2, Len(sLine) - 2)
If InStrRev(sTemp, "|") = 0 Then
sLine = "|"
sPath = sPath & "\" & sTemp
Else
Dim Folder : Folder = Mid(sTemp, InStrRev(sTemp, "|") + 1)
sLine = "|" & Mid(sTemp, 1, InStrRev(sTemp, "|") - 1) & "|"
sPath = sPath & "\" & Folder
End If
oFso.CreateFolder sPath
If CreateFolder(sLine, sPath) Then CreateFolder = True
End if
End If
Set ōFso = Nothing
End FunctionPrivate Function ParentFolder(byVal sPath)
Dim regEx
Set regEx = New RegExp
regEx.Pattern = "^(.*)\\[^\\]*$"
regEx.Global = True
regEx.IgnoreCase = True
ParentFolder = regEx.Replace(sPath, "$1")
Set regEx = Nothing
End FunctionPrivate Function StrToByte(byVal sText)
For i = 1 To Len(sText)
StrToByte = StrToByte & ChrB(Asc(Mid(sText, i, 1)))
Next
End FunctionPrivate Function ByteToStr(byVal sByte)
Dim oStream
Set ōStream = Server.CreateObject("ADODB.Stream")
oStream.Type = 2
oStream.Mode = 3
oStream.Open
oStream.WriteText sByte
oStream.Position = 0
oStream.CharSet = "gb2312"
oStream.Position = 2
ByteToStr = oStream.ReadText
oStream.Close
Set ōStream = Nothing
End FunctionPrivate Function ItemToColl
For i = 0 To itemCount - 1
If Not Form.Exists(itemName(i)) Then
Form.Add itemName(i), itemData(i)
End If
Next
End FunctionPrivate Sub Class_Terminate
Form.RemoveAll
Set Form = Nothing
End Sub
End Class
If Request.ServerVariables("REQUEST_METHOD") = "POST" Then
Rem 建立上传类实例
Set ōUpload = New Upload
Rem 指定允许上传文件的类型
oUpload.AllowType = "|GIF|BMP|JPG|RAR|"
Rem 指定允许上传文件的大小(单位：KB)
oUpload.MaxSize = 200
Rem 指定上传文件所存储的相对路径
oUpload.SaveFolder = "51JS.COM-ZMM/UploadFile"
Rem 开始上传处理
oUpload.Start
If oUpload.IsFinished Then
Rem 上传成功，显示上传信息
Dim sHtml : sHtml = ""
sHtml = sHtml & "<center>"
sHtml = sHtml & "<div style=""width: 600px;height: 500px;font-size: 10pt;border: 1px solid highlight;overflow: auto;"" align=""left"">"
sHtml = sHtml & "<center style=""font-size: 15pt;color: red;"">上传表单数据</center><br>"
sHtml = sHtml & "标题：<br>" & oUpload.Form("P_title") & "<br><br><br>"
sHtml = sHtml & "类型：<br>" & oUpload.Form("P_assort") & "<br><br><br>"
sHtml = sHtml & "小图：<br>服务器端路径：<a href=""" & oUpload.Form("P_image_s") & """ target=""_blank"">" & oUpload.Form("P_image_s") & "</a><br><img src=""" & oUpload.Form("P_image_s") & """><br><br><br>"
sHtml = sHtml & "中图：<br>服务器端路径：<a href=""" & oUpload.Form("P_image_m") & """ target=""_blank"">" & oUpload.Form("P_image_m") & "</a><br><img src=""" & oUpload.Form("P_image_m") & """><br><br><br>"
sHtml = sHtml & "大图：<br>服务器端路径：<a href=""" & oUpload.Form("P_image_b") & """ target=""_blank"">" & oUpload.Form("P_image_b") & "</a><br><img src=""" & oUpload.Form("P_image_b") & """><br><br><br>"
sHtml = sHtml & "介绍：<br>" & oUpload.Form("P_content") & "<br>"
sHtml = sHtml & "</div>"
sHtml = sHtml & "</center>"
Response.Write sHtml
Response.End
Else
Rem 上传失败，显示错误信息
Call ShowMsg(oUpload.ErrMessage, Request.ServerVariables("scrīpt_NAME"))
End If
Rem 对话框提示函数
Function ShowMsg(byVal sText, byVal sTarget)
Dim sscrīpt : sscrīpt = ""
sscrīpt = sscrīpt & "<scrīpt language=""javascrīpt"">" & vbCrlf & _
"window.alert('" & sText & "');" & vbCrlf & _
"window.location.replace('" & sTarget & "');" & vbCrlf & _
"</scrīpt>"
Response.Write sscrīpt
Response.End
End Function
End If
%><html>
<head>
<title>多文件、表单混合上传类</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<style type="text/css">
body {
margin: 0px;
border: 0px;
font-size: 10pt;
}
table {
border-collapse: collapse;
font-size: 10pt;
}
td {
font-size: 10pt;
}
</style>
<scrīpt language="javascrīpt">
function formCheck(_form) {
for (var i = 0; i < _form.elements.length; i ++) {
if (_form.elements[i].value == '') {
window.alert('请将表单填写完整，提交失败！');
return false;
}
}
return true;
}
</scrīpt>
</head>
<body>
<br><br>
<form action="<%=Request.ServerVariables("scrīpt_NAME")%>" method="post" enctype="multipart/form-data" ōnsubmit="return formCheck(this);">
<table width="400" align="center" cellpadding="2" cellspacing="0" border="1" rules="box">
<tr height="26">
<td colspan="2" align="center" style="font: 12pt;color: red;">上传功能测试<br><br></td>
</tr>
<tr valign="top">
<td height="30" style="padding-top:3px;">标题：</td>
<td><input type="text" name="P_title" size="20" autocomplete="off"></td>
</tr>
<tr valign="top">
<td height="30" style="padding-top:3px;">类型：</td>
<td>
<select name="P_assort">
<option value="电子">电子</option>
<option value="医疗">医疗</option>
</select>
</td>
</tr>
<tr valign="top">
<td height="30" style="padding-top:3px;">小图：</td>
<td><input type="file" name="P_image_s" ōnkeydown="return false;" ōncontextmenu="return false;" ōnpaste="return false;" ōndragenter="return false;"></td>
</tr>
<tr valign="top">
<td height="30" style="padding-top:3px;">中图：</td>
<td><input type="file" name="P_image_m" ōnkeydown="return false;" ōncontextmenu="return false;" ōnpaste="return false;" ōndragenter="return false;"></td>
</tr>
<tr valign="top">
<td height="30" style="padding-top:3px;">大图：</td>
<td><input type="file" name="P_image_b" ōnkeydown="return false;" ōncontextmenu="return false;" ōnpaste="return false;" ōndragenter="return false;"></td>
</tr>
<tr>
<td height="30" colspan="2" style="padding-top:3px;">介绍：</td>
</tr>
<tr>
<td height="30" colspan="2" valign="top">
<textarea name="P_content" cols="50" rows="5"></textarea>
</td>
</tr>
<tr>
<td colspan="2" valign="top" align="center">
<br><input type="submit" value="提交"> <input type="reset" value="重置">
<br><br>
</td>
</tr>
</table>
<body>
</html> -
什么是3G
2006-11-20 11:35:38
