当前位置: 首页 > 图文教程 > 网络编程 > ASP > [ASP]精华代码

ASP
IIS访问ASP页面时报错The requested resource is in use.的解决办法
错误类型:Provider (0x80004005)未指定的错误 的一个处理方法
关于asp+access的安全问题分析
把RS.GetRows看得更清楚
asp下UTF-8页面乱码的解决方法
解决使用良精企业建站7.0未注册问题
在ASP中连接MySQL数据库的方法,最好的通过ODBC方法
flash与js通讯方法
ASP操作Excel相关技术总结
解决用Access数据库建站维护不便的问题的方法
ASP实现GB2312字符与区位码的相互转换的代码
对于ASP编码问题的深入研究与最终解决方案
ASP生成UTF-8编码的代码
删除A表中在B表中不存在的数据
动网防恶意广告比较有效的办法附asp代码
asp磁盘缓存技术使用的代码
网页语言编码及asp乱码问题解决方案
FSO遍历目录实现全站插马的代码
关于无限分级(ASP+数据库+JS)的实现代码
如何写ASP入库小偷程序

[ASP]精华代码


出处:互联网   整理: 软晨网(RuanChen.com)   发布: 2009-09-13   浏览: 70 ::
收藏到网摘: n/a

复制代码 代码如下:

<%
' -- Loader.asp --
' -- version 1.5.2
' -- last updated 12/5/2002
'
' Faisal Khan
' [email protected]
' www.stardeveloper.com
' Class for handling binary uploads
Class Loader
Private dict
Private Sub Class_Initialize
Set dict = Server.CreateObject("Scripting.Dictionary")
End Sub
Private Sub Class_Terminate
If IsObject(intDict) Then
intDict.RemoveAll
Set intDict = Nothing
End If
If IsObject(dict) Then
dict.RemoveAll
Set dict = Nothing
End If
End Sub
Public Property Get Count
Count = dict.Count
End Property
Public Sub Initialize
If Request.TotalBytes > 0 Then
Dim binData
binData = Request.BinaryRead(Request.TotalBytes)
getData binData
End If
End Sub
Public Function getFileData(name)
If dict.Exists(name) Then
getFileData = dict(name).Item("Value")
Else
getFileData = ""
End If
End Function
Public Function getValue(name)
Dim gv
If dict.Exists(name) Then
gv = CStr(dict(name).Item("Value"))
gv = Left(gv,Len(gv)-2)
getValue = gv
Else
getValue = ""
End If
End Function
Public Function saveToFile(name, path)
If dict.Exists(name) Then
Dim temp
temp = dict(name).Item("Value")
Dim fso
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Dim file
Set file = fso.CreateTextFile(path)
For tPoint = 1 to LenB(temp)
file.Write Chr(AscB(MidB(temp,tPoint,1)))
Next
file.Close
saveToFile = True
Else
saveToFile = False
End If
End Function
Public Function getFileName(name)
If dict.Exists(name) Then
Dim temp, tempPos
temp = dict(name).Item("FileName")
tempPos = 1 + InStrRev(temp, "\")
getFileName = Mid(temp, tempPos)
Else
getFileName = ""
End If
End Function
Public Function getFilePath(name)
If dict.Exists(name) Then
Dim temp, tempPos
temp = dict(name).Item("FileName")
tempPos = InStrRev(temp, "\")
getFilePath = Mid(temp, 1, tempPos)
Else
getFilePath = ""
End If
End Function
Public Function getFilePathComplete(name)
If dict.Exists(name) Then
getFilePathComplete = dict(name).Item("FileName")
Else
getFilePathComplete = ""
End If
End Function
Public Function getFileSize(name)
If dict.Exists(name) Then
getFileSize = LenB(dict(name).Item("Value"))
Else
getFileSize = 0
End If
End Function
Public Function getFileSizeTranslated(name)
If dict.Exists(name) Then
temp = LenB(dict(name).Item("Value"))
If temp <= 1024 Then
getFileSizeTranslated = temp & " bytes"
Else
temp = FormatNumber((temp / 1024), 2)
getFileSizeTranslated = temp & " kilobytes"
End If
Else
getFileSizeTranslated = ""
End If
End Function
Public Function getContentType(name)
If dict.Exists(name) Then
getContentType = dict(name).Item("ContentType")
Else
getContentType = ""
End If
End Function
Private Sub getData(rawData)
Dim separator
separator = MidB(rawData, 1, InstrB(1, rawData, ChrB(13)) - 1)
Dim lenSeparator
lenSeparator = LenB(separator)
Dim currentPos
currentPos = 1
Dim inStrByte
inStrByte = 1
Dim value, mValue
Dim tempValue
tempValue = ""
While inStrByte > 0
inStrByte = InStrB(currentPos, rawData, separator)
mValue = inStrByte - currentPos
If mValue > 1 Then
value = MidB(rawData, currentPos, mValue)
Dim begPos, endPos, midValue, nValue
Dim intDict
Set intDict = Server.CreateObject("Scripting.Dictionary")
begPos = 1 + InStrB(1, value, ChrB(34))
endPos = InStrB(begPos + 1, value, ChrB(34))
nValue = endPos
Dim nameN
nameN = MidB(value, begPos, endPos - begPos)
Dim nameValue, isValid
isValid = True
If InStrB(1, value, stringToByte("Content-Type")) > 1 Then
begPos = 1 + InStrB(endPos + 1, value, ChrB(34))
endPos = InStrB(begPos + 1, value, ChrB(34))
If endPos = 0 Then
endPos = begPos + 1
isValid = False
End If
midValue = MidB(value, begPos, endPos - begPos)
intDict.Add "FileName", trim(byteToString(midValue))
begPos = 14 + InStrB(endPos + 1, value, stringToByte("Content-Type:"))
endPos = InStrB(begPos, value, ChrB(13))
midValue = MidB(value, begPos, endPos - begPos)
intDict.Add "ContentType", trim(byteToString(midValue))
begPos = endPos + 4
endPos = LenB(value)
nameValue = MidB(value, begPos, ((endPos - begPos) - 1))
Else
nameValue = trim(byteToString(MidB(value, nValue + 5)))
End If
If isValid = True Then
intDict.Add "Value", nameValue
intDict.Add "Name", nameN
dict.Add byteToString(nameN), intDict
End If
End If
currentPos = lenSeparator + inStrByte
Wend
End Sub
End Class
Private Function stringToByte(toConv)
Dim tempChar
For i = 1 to Len(toConv)
tempChar = Mid(toConv, i, 1)
stringToByte = stringToByte & chrB(AscB(tempChar))
Next
End Function
Private Function byteToString(toConv)
For i = 1 to LenB(toConv)
byteToString = byteToString & Chr(AscB(MidB(toConv,i,1)))
Next
End Function
%>

1、用户界面:
复制代码 代码如下:

<script language="JavaScript">
function CheckAll(form)
{for (var i=0;i<form.elements.length;i++)
{var e = form.elements[i];
if (e.name != 'chkall')
e.checked = form.chkall.checked;
}
}
</script>
</head>
<body>
<form method="post" action="del.asp" name="form1">
<table>
<tr>
<td ><input type="checkbox" value="111" name="TradeName">电子邮件1</td>
</tr>
<tr>
<td ><input type="checkbox" value="111" name="TradeName">电子邮件2</td>
</tr>
<tr>
<td ><input type="checkbox" value="111" name="TradeName">电子邮件3</td>
</tr>
<tr>
<td ><input type="checkbox" value="111" name="TradeName">电子邮件4</td>
</tr>
<tr>
<td ><input type="checkbox" value="111" name="TradeName">电子邮件5</td>
</tr>
<tr>
<td ><input type="checkbox" value="111" name="TradeName">电子邮件6</td>
</tr>
<tr>
<td bgcolor="#F1FBFC" height="25" colspan="2">
<p align="left"><input type="checkbox" name="chkall" value="on" onclick="CheckAll(this.form)"><font color="#FF9900">选中所有显示的消息</font></p>
</td>
<center>

</tr>
</table>
</form>

2、删除文件del.asp
<%
'这行写连接数据库的代码
dim ID,strID
strID=""
For Each strID In Request.Form("TradeName")
ID=Cint(strID)
if strID<>"" then
DelRs = Server.CreateObject("ADODB.Recordset")
Conn.Execute "Delete From Tbname where ID="&Cstr(ID)
strID=""
end if
Next
Conn.Close
Set Conn = Nothing
Response.Redirect "成功删除!"
%>