28,406
社区成员
发帖
与我相关
我的任务
分享上传图片总是500 内部服务器错误
源代码如下：
upload.asp
<html>
<head>
<title>图片上传</title>
<meta http-equiv="Content-Type" content="text/html; charset=gb2312">
<script>
function emp()
{
if (form1.file.value=="")
{alert("上传图片不能为空！");
return false;
}return true;
}
function imgt()
{form1.Img.src=form1.file.value}
</script>
<style type="text/css">
<!--
table {
font-size: 12px;
}
-->
</style>
<link href="css.css" rel="stylesheet" type="text/css">
<link href="/admin/Css.css" rel="stylesheet" type="text/css">
</head>
<body bgcolor="#FFFFFF" text="#000000" leftmargin="0" topmargin="0">
<table width="500" height="300" border="0" align="center" cellpadding="0" cellspacing="0">
<form name="form1" method="post" action="up_menu_filefendian.asp" enctype="multipart/form-data" onSubmit="return emp();">
<tr align="center" bgcolor="#666666">
<td colspan="2" height="26"><font color="#FF9900"><b class="font"><font color="#FFFFFF">图
片 上 传</font></b></font></td>
</tr>
<tr>
<td width="28%" height="43" class="font" align="right">文 件 名：<br></td><td width="72%" height="43"><input type="file" name="file" onChange="imgt();">
<input name="filepath" type="hidden" id="filepath" value="../upload"></td>
</tr>
<tr align="center">
<td height="190" colspan="2"><img src="images/yulan.gif" name="Img" width="230" height="180" id="Img">
</td>
</tr>
<tr>
<td height="29" colspan="2" align="center"><input type="submit" name="Submit" value="开 始 上 传" onClick="return emp();"></td>
</tr>
</form>
</table>
</body>
</html>
up_menu_filefendian.asp
<!--#include file="pub_config.asp"-->
<!--#include file="upload.inc"-->
<!--#include file="../inc/conn.asp"-->
<%
dim upload,file,formName,wch_hjh,formPath,iCount,fileimage,carname,topid,tittColor
dim imagename(3)
set upload=new upload_5xsoft ''建立上传对象
if upload.form("filepath")="" then ''得到上传目录
response.write "请输入要上传至的目录!"
set upload=nothing
response.end
else
formPath=upload.form("filepath")
if pageurl="" then
pageurl="#"
end if
''在目录后加(/)
if right(formPath,1)<>"/" then formPath=formPath&"/"
end if
iCount=0
for each formName in upload.objFile ''列出所有上传了的文件
set file=upload.file(formName) ''生成一个文件对象
if file.FileSize>0 then ''如果 FileSize > 0 说明有文件数据
dim rnd1,rnd2
Randomize
rnd1 = Int((1000 - 1 + 1) * Rnd + 1)
Randomize
rnd2 = Int((100- 1 + 1) * Rnd + 1)
fileext=right(file.FileName,4)
fileimage=change_date(now)&rnd1&"_"&rnd2&right(file.FileName,4)
file.SaveAs Server.mappath(formPath&fileimage) ''保存文件
iCount=iCount+1
imagename(icount)=fileimage
end if
set file=nothing
next
set upload=nothing ''删除此对象
if err.number <>0 then
Response.Write("图片上传失败，请重新上传！ <a href='upload.asp'>返回</a>")
else
Response.Write("<script>alert('图片上传成功！');opener.document.form1.ImgName.value='"&fileimage&"';window.close();</script>")
end if
%>
upload.inc
<SCRIPT RUNAT=SERVER LANGUAGE=VBSCRIPT>
dim Data_5xsoft
Class upload_5xsoft
dim objForm,objFile,Version
Public function Form(strForm)
strForm=lcase(strForm)
if not objForm.exists(strForm) then
Form=""
else
Form=objForm(strForm)
end if
end function
Public function File(strFile)
strFile=lcase(strFile)
if not objFile.exists(strFile) then
set File=new FileInfo
else
set File=objFile(strFile)
end if
end function
Private Sub Class_Initialize
dim RequestData,sStart,vbCrlf,sInfo,iInfoStart,iInfoEnd,tStream,iStart,theFile
dim iFileSize,sFilePath,sFileType,sFormValue,sFileName
dim iFindStart,iFindEnd
dim iFormStart,iFormEnd,sFormName
Version="化境HTTP上传程序 Version 2.0"
set objForm=Server.CreateObject("Scripting.Dictionary")
set objFile=Server.CreateObject("Scripting.Dictionary")
if Request.TotalBytes<1 then Exit Sub
set tStream = Server.CreateObject("adodb.stream")
set Data_5xsoft = Server.CreateObject("adodb.stream")
Data_5xsoft.Type = 1
Data_5xsoft.Mode =3
Data_5xsoft.Open
Data_5xsoft.Write Request.BinaryRead(Request.TotalBytes)
Data_5xsoft.Position=0
RequestData =Data_5xsoft.Read
iFormStart = 1
iFormEnd = LenB(RequestData)
vbCrlf = chrB(13) & chrB(10)
sStart = MidB(RequestData,1, InStrB(iFormStart,RequestData,vbCrlf)-1)
iStart = LenB (sStart)
iFormStart=iFormStart+iStart+1
while (iFormStart + 10) < iFormEnd
iInfoEnd = InStrB(iFormStart,RequestData,vbCrlf & vbCrlf)+3
tStream.Type = 1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iFormStart
Data_5xsoft.CopyTo tStream,iInfoEnd-iFormStart
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sInfo = tStream.ReadText
tStream.Close
'取得表单项目名称
iFormStart = InStrB(iInfoEnd,RequestData,sStart)
iFindStart = InStr(22,sInfo,"name=""",1)+6
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFormName = lcase(Mid (sinfo,iFindStart,iFindEnd-iFindStart))
'如果是文件
if InStr (45,sInfo,"filename=""",1) > 0 then
set theFile=new FileInfo
'取得文件名
iFindStart = InStr(iFindEnd,sInfo,"filename=""",1)+10
iFindEnd = InStr(iFindStart,sInfo,"""",1)
sFileName = Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileName=getFileName(sFileName)
theFile.FilePath=getFilePath(sFileName)
'取得文件类型
iFindStart = InStr(iFindEnd,sInfo,"Content-Type: ",1)+14
iFindEnd = InStr(iFindStart,sInfo,vbCr)
theFile.FileType =Mid (sinfo,iFindStart,iFindEnd-iFindStart)
theFile.FileStart =iInfoEnd
theFile.FileSize = iFormStart -iInfoEnd -3
theFile.FormName=sFormName
if not objFile.Exists(sFormName) then
objFile.add sFormName,theFile
end if
else
'如果是表单项目
tStream.Type =1
tStream.Mode =3
tStream.Open
Data_5xsoft.Position = iInfoEnd
Data_5xsoft.CopyTo tStream,iFormStart-iInfoEnd-3
tStream.Position = 0
tStream.Type = 2
tStream.Charset ="gb2312"
sFormValue = tStream.ReadText
tStream.Close
if objForm.Exists(sFormName) then
objForm(sFormName)=objForm(sFormName)&", "&sFormValue
else
objForm.Add sFormName,sFormValue
end if
end if
iFormStart=iFormStart+iStart+1
wend
RequestData=""
set tStream =nothing
End Sub
Private Sub Class_Terminate
if Request.TotalBytes>0 then
objForm.RemoveAll
objFile.RemoveAll
set objForm=nothing
set objFile=nothing
Data_5xsoft.Close
set Data_5xsoft =nothing
end if
End Sub
Private function GetFilePath(FullPath)
If FullPath <> "" Then
GetFilePath = left(FullPath,InStrRev(FullPath, "\"))
Else
GetFilePath = ""
End If
End function
Private function GetFileName(FullPath)
If FullPath <> "" Then
GetFileName = mid(FullPath,InStrRev(FullPath, "\")+1)
Else
GetFileName = ""
End If
End function
End Class
Class FileInfo
dim FormName,FileName,FilePath,FileSize,FileType,FileStart
Private Sub Class_Initialize
FileName = ""
FilePath = ""
FileSize = 0
FileStart= 0
FormName = ""
FileType = ""
End Sub
Public function SaveAs(FullPath)
dim dr,ErrorChar,i
SaveAs=true
if trim(fullpath)="" or FileStart=0 or FileName="" or right(fullpath,1)="/" then exit function
set dr=CreateObject("Adodb.Stream")
dr.Mode=3
dr.Type=1
dr.Open
Data_5xsoft.position=FileStart
Data_5xsoft.copyto dr,FileSize
dr.SaveToFile FullPath,2
dr.Close
set dr=nothing
SaveAs=false
end function
End Class
</SCRIPT>
...全文
请发表友善的回复…
发表回复
fir22008 2009-09-18
- 打赏
- 举报
问题找到了，
原因是我在conn.asp中加入了防注入代码，那段代码里调用了request.form
谢谢大家的帮助。
原因是我在conn.asp中加入了防注入代码，那段代码里调用了request.form
谢谢大家的帮助。
Snoworld 2009-09-18
- 打赏
- 举报
是否解决200K的问题
fir22008 2009-09-18
- 打赏
- 举报
可是我上传的图片只有12K。应该不会是这里的问题吧。另外，我的电脑里没有metabase.xml文件
三楼の郎 2009-09-18
- 打赏
- 举报
IIS默认的Form最大数据量为200K,超过200K就会出错。
解决办法：
1、先在服务里关闭 iis admin service 服务。
2、找到 windows\system32\inetsrv\ 下的 metabase.xml 文件。
3、用纯文本方式打开，找到 ASPMaxRequestEntityAllowed 把它修改为需要的值（可修改为20M即：20480000），默认为：204800，即：200K。
4、存盘，然后重启 iis admin service 服务。
解决办法：
1、先在服务里关闭 iis admin service 服务。
2、找到 windows\system32\inetsrv\ 下的 metabase.xml 文件。
3、用纯文本方式打开，找到 ASPMaxRequestEntityAllowed 把它修改为需要的值（可修改为20M即：20480000），默认为：204800，即：200K。
4、存盘，然后重启 iis admin service 服务。
fir22008 2009-09-18
- 打赏
- 举报
[Quote=引用 9 楼 hank212 的回复:]
是否解决200K的问题
[/Quote]
200K是什么意思？能再说具体些吗？谢谢！
是否解决200K的问题
[/Quote]
200K是什么意思？能再说具体些吗？谢谢！
fir22008 2009-09-17
- 打赏
- 举报
[Quote=引用 7 楼 sy_binbin 的回复:]
检查保存图片的文件夹是否存在
是否有写，修改权限
是否解决200K的问题
[/Quote]
我上传到远程服务器上，也是同样出现这样的问题。
检查保存图片的文件夹是否存在
是否有写，修改权限
是否解决200K的问题
[/Quote]
我上传到远程服务器上，也是同样出现这样的问题。
sy_binbin 2009-09-17
- 打赏
- 举报
检查保存图片的文件夹是否存在
是否有写，修改权限
是否解决200K的问题
是否有写，修改权限
是否解决200K的问题
fir22008 2009-09-17
- 打赏
- 举报
upload.inc 第41行内容
fir22008 2009-09-17
- 打赏
- 举报
[Quote=引用 4 楼 sy_binbin 的回复:]
IE->工具->internet选项->高级->显示有好http错误信息前的那个钩给调没了
看看页面啥错误信息
[/Quote]
IE->工具->internet选项->高级->显示有好http错误信息前的那个钩给调没了
看看页面啥错误信息
[/Quote]
sy_binbin 2009-09-17
- 打赏
- 举报
IE->工具->internet选项->高级->显示有好http错误信息前的那个钩给调没了
看看页面啥错误信息
看看页面啥错误信息
fir22008 2009-09-17
- 打赏
- 举报
接上贴
'# ----------------------------------------------------------------------------
'# 函数：success
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function success(msg,url,button)
response.write "<br><br><br>"
Response.Write( "<table width='350' border='1' align='center' cellpadding='0' cellspacing='0'>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='20' bgcolor='#004891'><span style='font-size:12px'><font color='#FFFFFF'>成功操作提示窗</font></span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='100' align='center' bgcolor='#F7F7F7'><span style=""font-size:12px"">"&msg&"</span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='25' align='center' valign=""middle"" bgcolor='#004891'> "+chr(13) )
Response.Write( " <input type='button' name='Submit2' value='"&button&"' onclick="""&url&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'>"+chr(13) )
Response.Write( " </td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( "</table>" )
end function
'# ----------------------------------------------------------------------------
'# 函数：error_msg
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function error_msg(msg,url,button)
response.write "<br><br><br>"
Response.Write( "<table width='350' border='1' align='center' cellpadding='0' cellspacing='0'>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='20' bgcolor='#004891'><span style='font-size:12px'><font color='#FFFFFF'>失败操作提示窗</font></span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='100' align='center' bgcolor='#F7F7F7'><span style=""font-size:12px"">"&msg&"</span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='25' align='center' valign=""middle"" bgcolor='#004891'> "+chr(13) )
Response.Write( " <input type='button' name='Submit2' value="""&button&""" onclick="""&url&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'>"+chr(13) )
Response.Write( " </td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( "</table>" )
end function
'# ----------------------------------------------------------------------------
'# 函数：news_ok
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function news_ok(msg,okurl,okbutton,nourl,nobutton)
response.write "<br><br><br>"
Response.Write( "<table width='350' border='1' align='center' cellpadding='0' cellspacing='0'>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='20' bgcolor='#004891'><span style='font-size:12px'><font color='#FFFFFF'>增加信息操作提示窗</font></span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='100' align='center' bgcolor='#F7F7F7'><span style=""font-size:12px"">"&msg&"</span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='25' align='center' valign=""middle"" bgcolor='#004891'> "+chr(13) )
Response.Write( " <input type='button' name='Submit2' value="""&okbutton&""" onclick="""&okurl&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'> <input type='button' name='Submit2' value='"&nobutton&"' onclick="""&nourl&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'>"+chr(13) )
Response.Write( " </td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( "</table>" )
end function
'......................................................................
'系统日记
function sys_log(t_user,t_name,msg)
dim ip,sql
ip=Request.ServerVariables("REMOTE_ADDR")
sql="insert into sys_log (sys_username,sys_title,sys_type,sys_ip) values ('"&t_user&"','"&t_name&"','"&msg&"','"&ip&"')"
conn.execute sql
end function
'......................................................................
'系统日记
function sys_log2(t_user,t_name,msg)
dim ip,sql
ip=Request.ServerVariables("REMOTE_ADDR")
sql="insert into user_log (sys_username,sys_title,sys_type,sys_ip) values ('"&t_user&"','"&t_name&"','"&msg&"','"&ip&"')"
conn.execute sql
end function
'计算图片数
function count_image(filename)
dim str_sql,ms
str_sql="select distinct * from c_images where filename='"&filename&"'"
set ms=server.createobject("adodb.recordset")
ms.open str_sql,conn,1,1
if ms.recordcount>1 then
count_image=0
else
count_image=1
end if
end function
'将日期专换为言语件名
Function change_date(Data)
Dim nowYear,nowMonth,nowDay,nowHour,nowSec,nowMin
nowYear = Year(Data)
nowMonth = Month(Data)
If CInt(nowMonth)<10 Then nowMonth = "0"&nowMonth
nowDay = Day(Data)
If CInt(nowDay)<10 Then nowDay = "0"&nowDay
nowHour = Hour(Data)
If CInt(nowHour)<10 Then nowHour = "0"&nowHour
nowSec = Second(Data)
If CInt(nowSec)<10 Then nowSec = "0"&nowSec
nowMin = Minute(Data)
If CInt(nowMin)<10 Then nowMin = "0"&nowMin
change_date = nowYear&nowMonth&nowday&nowhour&nowmin&nowSec
End Function
'转换字体格式
function run_string(str)
dim result
dim l
if isNULL(str) then
run_string=""
exit function
end if
l=len(str)
result=""
dim i
for i = 1 to l
select case mid(str,i,1)
case "<"
result=result+"<"
case ">"
result=result+">"
case chr(13)
result=result+"<br>"
case chr(34)
result=result+"""
case "&"
result=result+"&"
case chr(32)
if i+1<=l and i-1>0 then
if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
result=result+" "
else
result=result+" "
end if
else
result=result+" "
end if
case chr(9)
result=result+" "
case else
result=result+mid(str,i,1)
end select
next
run_string=result
end function
function erun_string(str)
dim result
dim l
if isNULL(str) then
run_string=""
exit function
end if
result=replace(str,"<","<")
result=replace(result,">",">")
result=replace(result,"<br>",chr(13))
result=replace(result,""",chr(34))
result=replace(result,"&","&")
result=replace(result," ",chr(32))
result=replace(result," ",chr(32))
result=replace(result," ",chr(9))
erun_string=result
end function
%>
conn.asp
<%'+++数据库链接函数+++
Function MdbConn(Conn)
Set Conn=Server.CreateObject("Adodb.Connection")
'Conn.Open"Driver={Microsoft Access Driver (*.Mdb)};dbq="&Server.Mappath("af_admin/database/eeeeeeeee.mdb")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &Server.Mappath("\database/conn.mdb") &";Jet Oledb:Database Password=webshineonline;"
End Function
%>
在本机试验和传到远程服务器上，都是这样，总是找不到问题出在哪里，郁闷！忘高手帮忙解决。谢谢！！！
'# ----------------------------------------------------------------------------
'# 函数：success
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function success(msg,url,button)
response.write "<br><br><br>"
Response.Write( "<table width='350' border='1' align='center' cellpadding='0' cellspacing='0'>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='20' bgcolor='#004891'><span style='font-size:12px'><font color='#FFFFFF'>成功操作提示窗</font></span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='100' align='center' bgcolor='#F7F7F7'><span style=""font-size:12px"">"&msg&"</span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='25' align='center' valign=""middle"" bgcolor='#004891'> "+chr(13) )
Response.Write( " <input type='button' name='Submit2' value='"&button&"' onclick="""&url&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'>"+chr(13) )
Response.Write( " </td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( "</table>" )
end function
'# ----------------------------------------------------------------------------
'# 函数：error_msg
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function error_msg(msg,url,button)
response.write "<br><br><br>"
Response.Write( "<table width='350' border='1' align='center' cellpadding='0' cellspacing='0'>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='20' bgcolor='#004891'><span style='font-size:12px'><font color='#FFFFFF'>失败操作提示窗</font></span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='100' align='center' bgcolor='#F7F7F7'><span style=""font-size:12px"">"&msg&"</span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='25' align='center' valign=""middle"" bgcolor='#004891'> "+chr(13) )
Response.Write( " <input type='button' name='Submit2' value="""&button&""" onclick="""&url&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'>"+chr(13) )
Response.Write( " </td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( "</table>" )
end function
'# ----------------------------------------------------------------------------
'# 函数：news_ok
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function news_ok(msg,okurl,okbutton,nourl,nobutton)
response.write "<br><br><br>"
Response.Write( "<table width='350' border='1' align='center' cellpadding='0' cellspacing='0'>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='20' bgcolor='#004891'><span style='font-size:12px'><font color='#FFFFFF'>增加信息操作提示窗</font></span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='100' align='center' bgcolor='#F7F7F7'><span style=""font-size:12px"">"&msg&"</span></td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( " <tr> "+chr(13) )
Response.Write( " <td height='25' align='center' valign=""middle"" bgcolor='#004891'> "+chr(13) )
Response.Write( " <input type='button' name='Submit2' value="""&okbutton&""" onclick="""&okurl&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'> <input type='button' name='Submit2' value='"&nobutton&"' onclick="""&nourl&""" style='BORDER-RIGHT: buttonhighlight 1px outset;BORDER-TOP: buttonhighlight 1px outset;FONT-SIZE: 9pt;BORDER-LEFT: buttonhighlight 1px outset;BORDER-BOTTOM: buttonhighlight 1px outset;FONT-FAMILY: 宋体;HEIGHT: 19px'>"+chr(13) )
Response.Write( " </td>"+chr(13) )
Response.Write( " </tr>"+chr(13) )
Response.Write( "</table>" )
end function
'......................................................................
'系统日记
function sys_log(t_user,t_name,msg)
dim ip,sql
ip=Request.ServerVariables("REMOTE_ADDR")
sql="insert into sys_log (sys_username,sys_title,sys_type,sys_ip) values ('"&t_user&"','"&t_name&"','"&msg&"','"&ip&"')"
conn.execute sql
end function
'......................................................................
'系统日记
function sys_log2(t_user,t_name,msg)
dim ip,sql
ip=Request.ServerVariables("REMOTE_ADDR")
sql="insert into user_log (sys_username,sys_title,sys_type,sys_ip) values ('"&t_user&"','"&t_name&"','"&msg&"','"&ip&"')"
conn.execute sql
end function
'计算图片数
function count_image(filename)
dim str_sql,ms
str_sql="select distinct * from c_images where filename='"&filename&"'"
set ms=server.createobject("adodb.recordset")
ms.open str_sql,conn,1,1
if ms.recordcount>1 then
count_image=0
else
count_image=1
end if
end function
'将日期专换为言语件名
Function change_date(Data)
Dim nowYear,nowMonth,nowDay,nowHour,nowSec,nowMin
nowYear = Year(Data)
nowMonth = Month(Data)
If CInt(nowMonth)<10 Then nowMonth = "0"&nowMonth
nowDay = Day(Data)
If CInt(nowDay)<10 Then nowDay = "0"&nowDay
nowHour = Hour(Data)
If CInt(nowHour)<10 Then nowHour = "0"&nowHour
nowSec = Second(Data)
If CInt(nowSec)<10 Then nowSec = "0"&nowSec
nowMin = Minute(Data)
If CInt(nowMin)<10 Then nowMin = "0"&nowMin
change_date = nowYear&nowMonth&nowday&nowhour&nowmin&nowSec
End Function
'转换字体格式
function run_string(str)
dim result
dim l
if isNULL(str) then
run_string=""
exit function
end if
l=len(str)
result=""
dim i
for i = 1 to l
select case mid(str,i,1)
case "<"
result=result+"<"
case ">"
result=result+">"
case chr(13)
result=result+"<br>"
case chr(34)
result=result+"""
case "&"
result=result+"&"
case chr(32)
if i+1<=l and i-1>0 then
if mid(str,i+1,1)=chr(32) or mid(str,i+1,1)=chr(9) or mid(str,i-1,1)=chr(32) or mid(str,i-1,1)=chr(9) then
result=result+" "
else
result=result+" "
end if
else
result=result+" "
end if
case chr(9)
result=result+" "
case else
result=result+mid(str,i,1)
end select
next
run_string=result
end function
function erun_string(str)
dim result
dim l
if isNULL(str) then
run_string=""
exit function
end if
result=replace(str,"<","<")
result=replace(result,">",">")
result=replace(result,"<br>",chr(13))
result=replace(result,""",chr(34))
result=replace(result,"&","&")
result=replace(result," ",chr(32))
result=replace(result," ",chr(32))
result=replace(result," ",chr(9))
erun_string=result
end function
%>
conn.asp
<%'+++数据库链接函数+++
Function MdbConn(Conn)
Set Conn=Server.CreateObject("Adodb.Connection")
'Conn.Open"Driver={Microsoft Access Driver (*.Mdb)};dbq="&Server.Mappath("af_admin/database/eeeeeeeee.mdb")
Conn.Open "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" &Server.Mappath("\database/conn.mdb") &";Jet Oledb:Database Password=webshineonline;"
End Function
%>
在本机试验和传到远程服务器上，都是这样，总是找不到问题出在哪里，郁闷！忘高手帮忙解决。谢谢！！！
fir22008 2009-09-17
- 打赏
- 举报
接上贴
function IsChecked(group,value)
dim i
for i=0 to UBound(group)
if trim(value)=trim(group(i)) then
IsChecked=true
exit function
end if
next
IsChecked=false
end function
Public Function FormatDT(dt, style)
Dim nowdate, y, m, d, h, i, s, t, APM, hAPM
nowdate = dt
y = Year(nowdate)
m = Month(nowdate)
d = Day(nowdate)
h = Hour(nowdate)
i = Minute(nowdate)
s = Second(nowdate)
If h > 12 Then
APM = "下午 "
hAPM = CStr(CInt(h) Mod 12)
Else
APM = "上午 "
hAPM = h
End If
Select Case style
Case 0
t = y & "-" & m & "-" & d & " " & APM & hAPM & ":" & i & ":" & s
Case 1
t = y & "-" & m & "-" & d & " " & h & ":" & i & ":" & s
Case 2
t = y & "-" & m & "-" & d & " " & h & ":" & i
Case 3
t = Right(y, 2) & "-" & m & "-" & d & " " & h & ":" & i
Case 4
t = m & "-" & d & " " & h & ":" & i
Case 5
t = y & "-" & m & "-" & d
Case 6
t = Right(y, 2) & "-" & m & "-" & d
Case 7
t = m & "-" & d
End Select
FormatDT = t
End Function
Public Function FindSignString(Head, Cauda, str)
Dim HeadLenght, Caudalenght, HeadPosition, CaudaPosition
Dim Temp
HeadLenght = Len(Head)
Caudalenght = Len(Cauda)
HeadPosition = InStr(str, Head)
If HeadPosition = 0 Then
FindSignString = "Null"
Exit Function
End If
CaudaPosition = InStr(HeadPosition + HeadLenght, str, Cauda)
If CaudaPosition = 0 Then
FindSignString = "Null"
Exit Function
End If
Temp = Mid(str, HeadPosition + HeadLenght, CaudaPosition - HeadPosition - HeadLenght)
FindSignString = Temp
End Function
Public Function Sep(Str, Sepa, Arrage)
Dim i
Dim Temp
Dim Ended
Dim Start
Dim End1
Start = 1
Do Until i = Arrage
If Ended Then
Temp = ""
Exit Do
End If
End1 = InStr(Start, Str, Sepa)
If End1 = 0 Then
If Ended = False Then
Temp = Right(Str, Len(Str) - Start + 1)
Ended = True
End If
Else
Temp = Mid(Str, Start, End1 - Start)
End If
Start = End1 + 1
i = i + 1
Loop
Sep = Temp
End Function
Public Function CutStr(str, number)
Dim length, llen, i, value
length = Len(str)
For i = 1 To length
value = Asc(Mid(str, i, 1))
If value >= -127 And value <= 127 Then
llen = llen + 1
Else
llen = llen + 2
End If
If llen >= number Then
CutStr = Left(str, i-3) & "..."
Exit Function
End If
Next
CutStr = str
End Function
'# ----------------------------------------------------------------------------
'# 函数：encode
'# 描述：使用ASC码减一的加密方法
'# 参数：string_going（待加密字符）
'# 返回：返回加密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
Function encode(string_going)
Dim i , view_string , destring , mygoto
For i= 1 To len(string_going)
view_string = view_string + CStr(asc(mid(string_going,i,1))-1) & ";"
Next
destring = ""
mygoto = split(view_string,";")
For i= 0 To ubound(mygoto)-1
destring = destring + chr(mygoto(i))
Next
encode = server.urlencode(destring)
End Function
'# ----------------------------------------------------------------------------
'# 函数：dncode
'# 描述：使用ASC码加一的解密方法
'# 参数：string_going（待解密字符）
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
Function decode(destring)
Dim view_string , i
view_string = ""
For i= 1 To len(destring)
view_string = view_string + chr(asc(mid(destring,i,1))+1)
Next
decode = view_string
End Function
'# ----------------------------------------------------------------------------
'# 函数：geturl
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function geturl()
dim url,scriptDir,slashPos
URL = Request.ServerVariables("http_host")
scriptDir = strreverse(Request.ServerVariables("path_info"))
slashPos = instr(1, scriptDir, "/")
scriptDir = strreverse(mid(scriptDir, slashPos, len(scriptDir)))
geturl=url&scriptDir
end function
function IsChecked(group,value)
dim i
for i=0 to UBound(group)
if trim(value)=trim(group(i)) then
IsChecked=true
exit function
end if
next
IsChecked=false
end function
Public Function FormatDT(dt, style)
Dim nowdate, y, m, d, h, i, s, t, APM, hAPM
nowdate = dt
y = Year(nowdate)
m = Month(nowdate)
d = Day(nowdate)
h = Hour(nowdate)
i = Minute(nowdate)
s = Second(nowdate)
If h > 12 Then
APM = "下午 "
hAPM = CStr(CInt(h) Mod 12)
Else
APM = "上午 "
hAPM = h
End If
Select Case style
Case 0
t = y & "-" & m & "-" & d & " " & APM & hAPM & ":" & i & ":" & s
Case 1
t = y & "-" & m & "-" & d & " " & h & ":" & i & ":" & s
Case 2
t = y & "-" & m & "-" & d & " " & h & ":" & i
Case 3
t = Right(y, 2) & "-" & m & "-" & d & " " & h & ":" & i
Case 4
t = m & "-" & d & " " & h & ":" & i
Case 5
t = y & "-" & m & "-" & d
Case 6
t = Right(y, 2) & "-" & m & "-" & d
Case 7
t = m & "-" & d
End Select
FormatDT = t
End Function
Public Function FindSignString(Head, Cauda, str)
Dim HeadLenght, Caudalenght, HeadPosition, CaudaPosition
Dim Temp
HeadLenght = Len(Head)
Caudalenght = Len(Cauda)
HeadPosition = InStr(str, Head)
If HeadPosition = 0 Then
FindSignString = "Null"
Exit Function
End If
CaudaPosition = InStr(HeadPosition + HeadLenght, str, Cauda)
If CaudaPosition = 0 Then
FindSignString = "Null"
Exit Function
End If
Temp = Mid(str, HeadPosition + HeadLenght, CaudaPosition - HeadPosition - HeadLenght)
FindSignString = Temp
End Function
Public Function Sep(Str, Sepa, Arrage)
Dim i
Dim Temp
Dim Ended
Dim Start
Dim End1
Start = 1
Do Until i = Arrage
If Ended Then
Temp = ""
Exit Do
End If
End1 = InStr(Start, Str, Sepa)
If End1 = 0 Then
If Ended = False Then
Temp = Right(Str, Len(Str) - Start + 1)
Ended = True
End If
Else
Temp = Mid(Str, Start, End1 - Start)
End If
Start = End1 + 1
i = i + 1
Loop
Sep = Temp
End Function
Public Function CutStr(str, number)
Dim length, llen, i, value
length = Len(str)
For i = 1 To length
value = Asc(Mid(str, i, 1))
If value >= -127 And value <= 127 Then
llen = llen + 1
Else
llen = llen + 2
End If
If llen >= number Then
CutStr = Left(str, i-3) & "..."
Exit Function
End If
Next
CutStr = str
End Function
'# ----------------------------------------------------------------------------
'# 函数：encode
'# 描述：使用ASC码减一的加密方法
'# 参数：string_going（待加密字符）
'# 返回：返回加密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
Function encode(string_going)
Dim i , view_string , destring , mygoto
For i= 1 To len(string_going)
view_string = view_string + CStr(asc(mid(string_going,i,1))-1) & ";"
Next
destring = ""
mygoto = split(view_string,";")
For i= 0 To ubound(mygoto)-1
destring = destring + chr(mygoto(i))
Next
encode = server.urlencode(destring)
End Function
'# ----------------------------------------------------------------------------
'# 函数：dncode
'# 描述：使用ASC码加一的解密方法
'# 参数：string_going（待解密字符）
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
Function decode(destring)
Dim view_string , i
view_string = ""
For i= 1 To len(destring)
view_string = view_string + chr(asc(mid(destring,i,1))+1)
Next
decode = view_string
End Function
'# ----------------------------------------------------------------------------
'# 函数：geturl
'# 描述：返加当前文件夹内的IP地址
'# 参数：
'# 返回：返回解密后的字符
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
function geturl()
dim url,scriptDir,slashPos
URL = Request.ServerVariables("http_host")
scriptDir = strreverse(Request.ServerVariables("path_info"))
slashPos = instr(1, scriptDir, "/")
scriptDir = strreverse(mid(scriptDir, slashPos, len(scriptDir)))
geturl=url&scriptDir
end function
fir22008 2009-09-17
- 打赏
- 举报
pub_config.asp
<%
'# 表格外观的样式
Const tablestyle = " bgcolor=""#cccccc"" width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"""
Const tablestylerow = "align=center bgcolor=#D6D3CE class=titletr"
'# 每页显示记录数量
Const viewrowstring = 15
Const trcolor="#FFD7D7"
Const trstyle="bgcolor='#ffffff' onmouseover=""this.bgColor='#f7f7f7'"" onmouseout=""this.bgColor='#ffffff'"""
'# ----------------------------------------------------------------------------
'# 函数：dele_pic
'# 描述：删除图片
'# 参数：pic（文件名字符串）
'# 返回：
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
sub dele_pic(pic)
Dim FnValue,i,TempFs
'删除文件
set TempFs = Server.CreateObject("Scripting.FileSystemObject")
if TempFs.FileExists(pic) then
TempFs.DeleteFile pic,True
end if
Set TempFs = nothing
End sub
'# ----------------------------------------------------------------------------
'# 函数：server_delfolder
'# 描述：删除目录下所有文件
'# 参数：UpPath（文件目录）
'# 返回：
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
sub server_delfolder(UpPath)
Dim AccFs
'删除目录下所有文件
set AccFs = Server.CreateObject("Scripting.FileSystemObject")
if AccFs.FolderExists(Server.Mappath(UpPath)) then '如果目录不存在,则新增目录
AccFs.deleteFolder(Server.Mappath(UpPath)) '删除目录
End If
Set AccFs = nothing
End sub
'建立文件夹
function create_folder(uppath)
set AccFs = Server.CreateObject("Scripting.FileSystemObject")
if not AccFs.FolderExists(Server.Mappath(UpPath)) then
AccFs.CreateFolder(Server.Mappath(UpPath))
end if
set accfs=nothing
end function
'# ----------------------------------------------------------------------------
'# 函数：return_left
'# 描述：计算表单的左边显示位置
'# 参数：sw（屏幕的宽度）,tw（表单的宽度）
'# 返回：表单的左边显示位置
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
public function return_left(sw,tw)
'# 该处没有使用屏幕的高度的原因是因为有些表单超过一个屏幕，这样使用屏幕的高度也就没有意义。
If sw<>"" Then
return_left = Int((cint(sw)-CInt(tw))/2)
else
return_left = Int((800-CInt(tw))/2)
End If
end function
'# ----------------------------------------------------------------------------
'# 函数：run_sqlstring
'# 描述：将字符过滤掉一些sql中危险的字符
'# 参数：sqlstring（处理的字符）
'# 返回：处理后的值
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
public function run_sqlstring(sqlstring)
sqlstring=trim(sqlstring)
sqlstring=replace(sqlstring,"'","‘")
sqlstring=replace(sqlstring,";","；")
sqlstring=Replace(sqlstring,"(","（")
sqlstring=Replace(sqlstring,")","）")
sqlstring=Replace(sqlstring,"""","＂")
sqlstring=Replace(sqlstring,":","：")
'sqlstring=Replace(sqlstring,",","，")'在某些程序中有使用到如果替换后会出现错误！
sqlstring=Replace(sqlstring,"<","＜")
'sqlstring=Replace(sqlstring,".","．")'在某些程序中有使用到如果替换后会出现错误！
sqlstring=Replace(sqlstring,">","＞")
sqlstring=Replace(sqlstring,"`nbsp;"," ")
sqlstring=Replace(sqlstring,""","＂")
sqlstring=Replace(sqlstring,"<","＜")
sqlstring=Replace(sqlstring,">","＞")
sqlstring=server.htmlencode(sqlstring)
run_sqlstring=sqlstring
end function
Sub LastNextPage2(pagecount,page,table_style,font_style)
'生成上一页下一页链接
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
temp="topid="&topid&"&"
Response.Write("<table " & Table_style & ">" & vbCrLf )
Response.Write("<TD align=right>" & vbCrLf )
Response.Write(font_style & vbCrLf )
if page<=1 then
Response.Write ("[第一页] " & vbCrLf)
Response.Write ("[上一页] " & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=1>第一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上一页</A>] " & vbCrLf)
end if
if page>=pagecount then
Response.Write ("[下一页] " & vbCrLf)
Response.Write ("[最后一页]" & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">最后一页</A>]" & vbCrLf)
end if
Response.Write(" 共 " & pageCount & " 页" & vbCrLf)
Response.Write("</TD>" & vbCrLf )
Response.Write("</TR>" & vbCrLf )
Response.Write("</table>" & vbCrLf )
End Sub
public function HtmlOut(str)
'将文字转化为它的源代码格式
dim guest
If IsDate(str) Then
If str="1900-1-1" Then
guest=""
else
guest=str
End If
else
if isnull(str) or str="" then
htmlOut=str
exit function
end if
guest=str
guest=Replace(Guest,vbcrlf,"<BR>")
End If
HtmlOut=guest
end function
sub outcheck(check_value)
if check_value<> "" then
Response.Write outstr(check_value,2)
Response.End
end if
end sub
'＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃
'#作者： hjh
'从数据库中提取内容生成下拉菜单
'conn 为数据库联接 table为表名 style下接菜单样式
'时间 2004-8-5
'＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃
public function OutOption(conn,tabel,style,value)
dim re,sql,selected
set re=server.CreateObject("ADODB.RECORDSET")
sql = "SELECT * FROM " & tabel & " ORDER BY value"
re.Open sql,conn
Response.Write ("<select " & style & ">" & vbCrLf )
while re.EOF<>true
if trim(re("value"))=trim(value) then
selected=" selected "
else
selected=" "
end if
response.write( vbTab & "<option" & selected & "value=""" & re("value") & """>" & re("text") & "</option>" & vbCrLf )
re.MoveNext
wend
Response.Write ("</select>" & vbCrlf)
set re=nothing
end function
Sub LastNextPage(pagecount,page,table_style,font_style)
'生成上一页下一页链接
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
Response.Write("<table " & Table_style & ">" & vbCrLf )
Response.Write("<form method=get onsubmit=""document.location = '" & action & "?" & temp & "Page='+ this.page.value;return false;""><TR>" & vbCrLf )
Response.Write("<TD align=right>" & vbCrLf )
Response.Write(font_style & vbCrLf )
if page<=1 then
Response.Write ("[第一页] " & vbCrLf)
Response.Write ("[上一页] " & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=1>第一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上一页</A>] " & vbCrLf)
end if
if page>=pagecount then
Response.Write ("[下一页] " & vbCrLf)
Response.Write ("[最后一页]" & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">最后一页</A>]" & vbCrLf)
end if
Response.Write(" 第" & "<INPUT TYEP=TEXT NAME=page SIZE=2 Maxlength=5 VALUE=" & page & ">" & "页" & vbCrLf & "<INPUT type=submit style=""font-size: 7pt"" value=GO>")
Response.Write(" 共 " & pageCount & " 页" & vbCrLf)
Response.Write("</TD>" & vbCrLf )
Response.Write("</TR></form>" & vbCrLf )
Response.Write("</table>" & vbCrLf )
End Sub
<%
'# 表格外观的样式
Const tablestyle = " bgcolor=""#cccccc"" width=""100%"" border=""0"" cellspacing=""1"" cellpadding=""1"" align=""center"""
Const tablestylerow = "align=center bgcolor=#D6D3CE class=titletr"
'# 每页显示记录数量
Const viewrowstring = 15
Const trcolor="#FFD7D7"
Const trstyle="bgcolor='#ffffff' onmouseover=""this.bgColor='#f7f7f7'"" onmouseout=""this.bgColor='#ffffff'"""
'# ----------------------------------------------------------------------------
'# 函数：dele_pic
'# 描述：删除图片
'# 参数：pic（文件名字符串）
'# 返回：
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
sub dele_pic(pic)
Dim FnValue,i,TempFs
'删除文件
set TempFs = Server.CreateObject("Scripting.FileSystemObject")
if TempFs.FileExists(pic) then
TempFs.DeleteFile pic,True
end if
Set TempFs = nothing
End sub
'# ----------------------------------------------------------------------------
'# 函数：server_delfolder
'# 描述：删除目录下所有文件
'# 参数：UpPath（文件目录）
'# 返回：
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
sub server_delfolder(UpPath)
Dim AccFs
'删除目录下所有文件
set AccFs = Server.CreateObject("Scripting.FileSystemObject")
if AccFs.FolderExists(Server.Mappath(UpPath)) then '如果目录不存在,则新增目录
AccFs.deleteFolder(Server.Mappath(UpPath)) '删除目录
End If
Set AccFs = nothing
End sub
'建立文件夹
function create_folder(uppath)
set AccFs = Server.CreateObject("Scripting.FileSystemObject")
if not AccFs.FolderExists(Server.Mappath(UpPath)) then
AccFs.CreateFolder(Server.Mappath(UpPath))
end if
set accfs=nothing
end function
'# ----------------------------------------------------------------------------
'# 函数：return_left
'# 描述：计算表单的左边显示位置
'# 参数：sw（屏幕的宽度）,tw（表单的宽度）
'# 返回：表单的左边显示位置
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
public function return_left(sw,tw)
'# 该处没有使用屏幕的高度的原因是因为有些表单超过一个屏幕，这样使用屏幕的高度也就没有意义。
If sw<>"" Then
return_left = Int((cint(sw)-CInt(tw))/2)
else
return_left = Int((800-CInt(tw))/2)
End If
end function
'# ----------------------------------------------------------------------------
'# 函数：run_sqlstring
'# 描述：将字符过滤掉一些sql中危险的字符
'# 参数：sqlstring（处理的字符）
'# 返回：处理后的值
'# 作者：hjh
'# 日期：2004-8-5
'#-----------------------------------------------------------------------------
public function run_sqlstring(sqlstring)
sqlstring=trim(sqlstring)
sqlstring=replace(sqlstring,"'","‘")
sqlstring=replace(sqlstring,";","；")
sqlstring=Replace(sqlstring,"(","（")
sqlstring=Replace(sqlstring,")","）")
sqlstring=Replace(sqlstring,"""","＂")
sqlstring=Replace(sqlstring,":","：")
'sqlstring=Replace(sqlstring,",","，")'在某些程序中有使用到如果替换后会出现错误！
sqlstring=Replace(sqlstring,"<","＜")
'sqlstring=Replace(sqlstring,".","．")'在某些程序中有使用到如果替换后会出现错误！
sqlstring=Replace(sqlstring,">","＞")
sqlstring=Replace(sqlstring,"`nbsp;"," ")
sqlstring=Replace(sqlstring,""","＂")
sqlstring=Replace(sqlstring,"<","＜")
sqlstring=Replace(sqlstring,">","＞")
sqlstring=server.htmlencode(sqlstring)
run_sqlstring=sqlstring
end function
Sub LastNextPage2(pagecount,page,table_style,font_style)
'生成上一页下一页链接
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
temp="topid="&topid&"&"
Response.Write("<table " & Table_style & ">" & vbCrLf )
Response.Write("<TD align=right>" & vbCrLf )
Response.Write(font_style & vbCrLf )
if page<=1 then
Response.Write ("[第一页] " & vbCrLf)
Response.Write ("[上一页] " & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=1>第一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上一页</A>] " & vbCrLf)
end if
if page>=pagecount then
Response.Write ("[下一页] " & vbCrLf)
Response.Write ("[最后一页]" & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">最后一页</A>]" & vbCrLf)
end if
Response.Write(" 共 " & pageCount & " 页" & vbCrLf)
Response.Write("</TD>" & vbCrLf )
Response.Write("</TR>" & vbCrLf )
Response.Write("</table>" & vbCrLf )
End Sub
public function HtmlOut(str)
'将文字转化为它的源代码格式
dim guest
If IsDate(str) Then
If str="1900-1-1" Then
guest=""
else
guest=str
End If
else
if isnull(str) or str="" then
htmlOut=str
exit function
end if
guest=str
guest=Replace(Guest,vbcrlf,"<BR>")
End If
HtmlOut=guest
end function
sub outcheck(check_value)
if check_value<> "" then
Response.Write outstr(check_value,2)
Response.End
end if
end sub
'＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃
'#作者： hjh
'从数据库中提取内容生成下拉菜单
'conn 为数据库联接 table为表名 style下接菜单样式
'时间 2004-8-5
'＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃＃
public function OutOption(conn,tabel,style,value)
dim re,sql,selected
set re=server.CreateObject("ADODB.RECORDSET")
sql = "SELECT * FROM " & tabel & " ORDER BY value"
re.Open sql,conn
Response.Write ("<select " & style & ">" & vbCrLf )
while re.EOF<>true
if trim(re("value"))=trim(value) then
selected=" selected "
else
selected=" "
end if
response.write( vbTab & "<option" & selected & "value=""" & re("value") & """>" & re("text") & "</option>" & vbCrLf )
re.MoveNext
wend
Response.Write ("</select>" & vbCrlf)
set re=nothing
end function
Sub LastNextPage(pagecount,page,table_style,font_style)
'生成上一页下一页链接
Dim query, a, x, temp
action = "http://" & Request.ServerVariables("HTTP_HOST") & Request.ServerVariables("SCRIPT_NAME")
query = Split(Request.ServerVariables("QUERY_STRING"), "&")
For Each x In query
a = Split(x, "=")
If StrComp(a(0), "page", vbTextCompare) <> 0 Then
temp = temp & a(0) & "=" & a(1) & "&"
End If
Next
Response.Write("<table " & Table_style & ">" & vbCrLf )
Response.Write("<form method=get onsubmit=""document.location = '" & action & "?" & temp & "Page='+ this.page.value;return false;""><TR>" & vbCrLf )
Response.Write("<TD align=right>" & vbCrLf )
Response.Write(font_style & vbCrLf )
if page<=1 then
Response.Write ("[第一页] " & vbCrLf)
Response.Write ("[上一页] " & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=1>第一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page-1) & ">上一页</A>] " & vbCrLf)
end if
if page>=pagecount then
Response.Write ("[下一页] " & vbCrLf)
Response.Write ("[最后一页]" & vbCrLf)
else
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & (Page+1) & ">下一页</A>] " & vbCrLf)
Response.Write("[<A HREF=" & action & "?" & temp & "Page=" & pagecount & ">最后一页</A>]" & vbCrLf)
end if
Response.Write(" 第" & "<INPUT TYEP=TEXT NAME=page SIZE=2 Maxlength=5 VALUE=" & page & ">" & "页" & vbCrLf & "<INPUT type=submit style=""font-size: 7pt"" value=GO>")
Response.Write(" 共 " & pageCount & " 页" & vbCrLf)
Response.Write("</TD>" & vbCrLf )
Response.Write("</TR></form>" & vbCrLf )
Response.Write("</table>" & vbCrLf )
End Sub
