<%
'************************************************** 
'函数名：gotTopic 
'作  用：截字符串，汉字一个算两个字符，英文算一个字符 
'参  数：str   ----原字符串 
'       strlen ----截取长度 
'返回值：截取后的字符串 
'Copyright：asp教程
'************************************************** 
Function gotTopic(ByVal str, ByVal strlen) 
If str = "" Then 
gotTopic = "" 
Exit Function 
End If 
Dim l, t, c, i, strTemp 
str = Replace(Replace(Replace(Replace(str, " ", " "), """", Chr(34)), ">", ">"), "&lt;", "<")
l = Len(str) 
t = 0 
strTemp = str 
strlen = CLng(strlen) 
For i = 1 To l 
c = Abs(Asc(Mid(str, i, 1))) 
If c > 255 Then 
t = t + 2 
Else 
t = t + 1 
End If 
If t >= strlen Then 
strTemp = Left(str, i) 
Exit For 
End If 
Next 
If strTemp <> str Then 
strTemp = strTemp & "..." 
End If 
gotTopic = Replace(Replace(Replace(Replace(strTemp, " ", " "), Chr(34), """"), ">", ">"), "<", "&lt;")
End Function
'******************************************************
'//*************************************************************
'//HTML
function   HTMLEncode(fString)  
  fString   =   replace(fString,   ">",   "&gt;")  
  fString   =   replace(fString,   "<",   "&lt;")  
  fString   =   Replace(fString,   CHR(32),   "&nbsp;")  
  fString   =   Replace(fString,   CHR(34),   "&quot;")  
  fString   =   Replace(fString,   CHR(39),   "&#39;")  
  fString   =   Replace(fString,   CHR(13),   "")  
  fString   =   Replace(fString,   CHR(10)   &   CHR(10),   "</P><P>")  
  fString   =   Replace(fString,   CHR(10),   "<BR>")  
  HTMLEncode   =   fString  
  end   function
function   HTMLDecode(fString)  
  fString   =   replace(fString,   "&gt;",   ">")  
  fString   =   replace(fString,   "&lt;",   "<")  
  fString   =   Replace(fString,"&nbsp;",chr(32))  
  fString   =   Replace(fString,"&quot;",chr(34))  
  fString   =   Replace(fString,"&#39;",chr(39))  
  fString   =   Replace(fString,   "",   CHR(13))  
  fString   =   Replace(fString,   "<P>",   CHR(10))
  fString   =   Replace(fString,   "</P>",   CHR(10))
  fString   =   Replace(fString,   "<BR>",   CHR(10))  
  HTMLDecode   =   fString  
  end   function

'//*************************************************************
'================================================
  '作  用：错误输出信息
  '================================================
  Public Function ReturnError(ErrMsg)
	Response.Write "<p>&nbsp;</p>" & vbCrLf
	Response.Write "<meta http-equiv=refresh content=3;url=javascript:history.go(-1)>"
	Response.Write "<table cellpadding=5 cellspacing=0 border=0 align=center class=tableBorder1>" & vbCrLf
	Response.Write "  <tr><th colspan=2 align=""left""><img src=""images/welcome.gif"" width=""17"" height=""17"" align=""absMiddle""> 错误提示信息!</th></tr>" & vbCrLf
	Response.Write "  <tr><td align=center width=""20%"" class=TableRow1><img src=""images/err.gif"" width=95 height=97 border=0></td><td width=""80%"" class=TableRow1><b style=color:blue><span id=jump>3</span> 秒钟后系统将自动返回</b><br><b>产生错误的可能原因：</b><BR>" & ErrMsg & "</td></tr>" & vbCrLf
	Response.Write "  <tr><td colspan=2 align=center height=25 class=TableRow2><a href=javascript:history.go(-1)>返回上一页...</a></td></tr>" & vbCrLf
	Response.Write "</table><p>&nbsp;</p>" & vbCrLf
	Response.Write "<script>function countDown(secs){jump.innerText=secs;if(--secs>0)setTimeout(""countDown(""+secs+"")"",1000);}countDown(3);</script>"
  End Function
'================================================
  '作  用：成功输出信息
  '================================================
  Public Function Succeed(SucMsg)
	Response.Write "<p>&nbsp;</p>" & vbCrLf
	Response.Write "<meta http-equiv=refresh content=1;url=" & Request.ServerVariables("HTTP_REFERER") & ">"
	Response.Write "<table align=""center"" border=""0"" cellpadding=""5"" cellspacing=""0"" class=""tableBorder1"">" & vbCrLf
	Response.Write "    <tr> " & vbCrLf
	Response.Write "      <th colspan=2 align=""left""><img src=""images/welcome.gif"" width=""17"" height=""17"" align=""absMiddle""> 成功提示信息!</th>" & vbCrLf
	Response.Write "    </tr>" & vbCrLf
	Response.Write "  <tr><td align=center width=""20%"" class=TableRow1><img src=""images/succ.gif"" width=95 height=97 border=0></td><td width=""80%"" class=TableRow1>"
	Response.Write " <b style=color:blue><span id=jump>3</span> 秒钟后系统将自动返回</b><br>"
	Response.Write SucMsg & "</td></tr>" & vbCrLf
	Response.Write "  <tr><td colspan=2 align=center height=25 class=TableRow2><a href='" & Request.ServerVariables("HTTP_REFERER") & "'>返回上一页...</a></td></tr>" & vbCrLf
	Response.Write " </table><p>&nbsp;</p>" & vbCrLf
	Response.Write "<script>function countDown(secs){jump.innerText=secs;if(--secs>0)setTimeout(""countDown(""+secs+"")"",1000);}countDown(3);</script>"
  End Function
  '===========================================
  Public Function htmlencodeqq(ByVal reString)
	Dim str
	str = reString
	str = Replace(str, "&", "&amp;")
	str = Replace(str, ">", "&gt;")
	str = Replace(str, "<", "&lt;")
	htmlencodeqq = str
  End Function
'===========================================
  '函数作用：过滤HTML代码
  '===========================================
  Public Function HTMLEncode(ByVal fString)
	If Not IsNull(fString) Then
	fString = Replace(fString, ">", "&gt;")
	fString = Replace(fString, "<", "&lt;")
	fString = Replace(fString, Chr(32), " ")
	fString = Replace(fString, Chr(9), " ")
	fString = Replace(fString, Chr(34), "&quot;")
	fString = Replace(fString, Chr(39), "&#39;")
	fString = Replace(fString, Chr(13), "")
	fString = Replace(fString, " ", "&nbsp;")
	fString = Replace(fString, Chr(10), "<br /> ")
	fString = ChkBadWords(fString)
	HTMLEncode = fString
	End If
  End Function
  Public Function HTMLEncodes(ByVal fString)
	If Not IsNull(fString) Then
	fString = Replace(fString, "'", "&#39;")
	fString = Replace(fString, ">", "&gt;")
	fString = Replace(fString, "<", "&lt;")
	fString = Replace(fString, Chr(32), " ")
	fString = Replace(fString, Chr(9), " ")
	fString = Replace(fString, Chr(34), "&quot;")
	fString = Replace(fString, Chr(39), "&#39;")
	fString = Replace(fString, Chr(13), "")
	fString = Replace(fString, Chr(10), "<br /> ")
	fString = Replace(fString, " ", "&nbsp;")
	HTMLEncodes = fString
	End If
  End Function
  '================================================
  '作  用：输出错误警告脚本
  '================================================
  Public Function OutputScript(str,url)
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('" & str & "');"
	Response.Write "location.replace('" & url & "')" & vbCrLf
	Response.Write "</script>" & vbCrLf
	Response.End
  End Function
  Public Function OutHintScript(str)
	Response.Write "<script language=JavaScript>" & vbCrLf
	Response.Write "alert('" & str & "');"
	Response.Write "location.replace('" & Request.ServerVariables("HTTP_REFERER") & "')" & vbCrLf
	Response.Write "</script>" & vbCrLf
	Response.End
  End Function
  Public Function OutAlertScript(str)
	Response.Write "<script language=javascript>" & vbcrlf
	Response.Write "alert('" & str & "');"
	Response.Write "history.back()" & vbcrlf
	Response.Write "</script>" & vbcrlf
	Response.End
  End Function
  '===========================================
  Public Function ChkNumeric(ByVal CHECK_ID)
	If CHECK_ID <> "" And IsNumeric(CHECK_ID) Then
	CHECK_ID = CLng(CHECK_ID)
	If CHECK_ID < 0 Then CHECK_ID = 0
	Else
	CHECK_ID = 0
	End If
	ChkNumeric = CHECK_ID
  End Function
    '================================================
  '???:ReadFileUrl
  '?  ?:????URL
  '================================================
  Public Function ReadFileUrl(url)
	On Error Resume Next
	ReadFileUrl = ""
	If url = "" Then Exit Function
	Dim strTemp
	If CheckUrl(url) = 1 Then
	strTemp = Trim(url)
	ElseIf CheckUrl(url) = 2 Then
	strTemp = Trim(url)
	Else
	strTemp = Replace(url, "../", "")
	strTemp = Trim(ServerDir & strTemp)
	End If
	ReadFileUrl = strTemp
  End Function
  '================================================
  '?  ?:??????
  '================================================
  Public Function ShowListPage(CurrentPage,Pcount,totalrec,PageNum,strLink,ListName)
	With Response
	.Write "<script>"
	.Write "ShowListPage("
	.Write CurrentPage
	.Write ","
	.Write Pcount
	.Write ","
	.Write totalrec
	.Write ","
	.Write PageNum
	.Write ",'"
	.Write strLink
	.Write "','"
	.Write ListName
	.Write "');"
	.Write "</script>" & vbNewLine
	End With
  End Function
  '================================================
  '=============================================================
  '????:??????
  '=============================================================
  Public Function ChkFormStr(ByVal str)
	Dim fString
	fString = str
	If IsNull(fString) Then
	ChkFormStr = ""
	Exit Function
	End If
	fString = Replace(fString, "'", "&#39;")
	fString = Replace(fString, Chr(34), "&quot;")
	fString = Replace(fString, Chr(13), "")
	fString = Replace(fString, Chr(10), "")
	fString = Replace(fString, Chr(9), "")
	fString = Replace(fString, ">", "&gt;")
	fString = Replace(fString, "<", "&lt;")
	fString = Replace(fString, "%", "%")
	ChkFormStr = Trim(JAPEncode(fString))
  End Function
  '================================================
  '?  ?:???????
  '================================================
  Public Function JAPEncode(ByVal str)
	Dim FobWords, i
	On Error Resume Next
	If IsNull(str) Or Trim(str) = "" Then
	JAPEncode = ""
	Exit Function
	End If
	FobWords = Array(92, 304, 305, 430, 431, 437, 438, 12460, 12461, 12462, 12463, 12464, 12465, 12466, 12467, 12468, 12469, 12470, 12471, 12472, 12473, 12474, 12475, 12476, 12477, 12478, 12479, 12480, 12481, 12482, 12483, 12485, 12486, 12487, 12488, 12489, 12490, 12496, 12497, 12498, 12499, 12500, 12501, 12502, 12503, 12504, 12505, 12506, 12507, 12508, 12509, 12510, 12521, 12532, 12533, 65340)
	For i = 1 To UBound(FobWords, 1)
	If InStr(str, ChrW(FobWords(i))) > 0 Then
	str = Replace(str, ChrW(FobWords(i)), "&#" & FobWords(i) & ";")
	End If
	Next
	JAPEncode = str
  End Function
  '该函数作用：按指定参数格式化显示时间。
'numformat=1:将时间转化为yyyy-mm-dd hh:nn格式。
'numformat=2:将时间转化为yyyy-mm-dd格式。
'numformat=3:将时间转化为hh:nn格式。
'numformat=4:将时间转化为yyyy年mm月dd日 hh时nn分格式。
'numformat=5:将时间转化为yyyy年mm月dd日格式。
'numformat=6:将时间转化为hh时nn分格式。
'numformat=7:将时间转化为yyyy年mm月dd日 星期×格式。
'numformat=8:将时间转化为yymmdd格式。
'numformat=9:将时间转化为mm-dd格式。

function formatdate(shijian,numformat)
dim ystr,mstr,dstr,hstr,nstr '变量含义分别为年字符串，月字符串，日字符串，时字符串，分字符串

if isnull(shijian) then
numformat=0
else
ystr=DatePart("yyyy",shijian)   

if DatePart("m",shijian)>9 then 
mstr=DatePart("m",shijian)
else
mstr="0"&DatePart("m",shijian)  
end if

if DatePart("d",shijian)>9 then 
dstr=DatePart("d",shijian)
else
dstr="0"&DatePart("d",shijian)  
end if

if DatePart("h",shijian)>9 then 
hstr=DatePart("h",shijian)
else
hstr="0"&DatePart("h",shijian)  
end if

if DatePart("n",shijian)>9 then 
nstr=DatePart("n",shijian)
else
nstr="0"&DatePart("n",shijian)  
end if
end if  

select case numformat
case 0
formatdate=""
case 1
formatdate=ystr&"-"&mstr&"-"&dstr&" "&hstr&":"&nstr 
case 2
formatdate=ystr&"-"&mstr&"-"&dstr 
case 3
formatdate=hstr&":"&nstr
case 4
formatdate=ystr&"年"&mstr&"月"&dstr&"日 "&hstr&"时"&nstr&"分"
case 5
formatdate=ystr&"年"&mstr&"月"&dstr&"日" 
case 6
formatdate=hstr&"时"&nstr&"分"
case 7
formatdate=ystr&"年"&mstr&"月"&dstr&"日 "&WeekdayName(Weekday(shijian))
case 8
formatdate=right(ystr,2)&mstr&dstr
case 9
formatdate=mstr&"-"&dstr
end select
end function
  '===========================================
  Sub Admin_header()
        Response.Write "<html>" & vbCrLf
        Response.Write "<head>" & vbCrLf
        Response.Write "<meta http-equiv=""Content-Type"" content=""text/html; charset=gb2312"">" & vbCrLf
        Response.Write "<title>" & titlename & " - 管理页面</title>" & vbCrLf
        Response.Write "<LINK href=""Images/Style.css"" type=text/css rel=stylesheet>" & vbCrLf
        Response.Write "<script src=""inc/admin.js"" type=""text/javascript""></script>" & vbCrLf
        Response.Write "</head>" & vbCrLf
        Response.Write "<body leftmargin=0 bottommargin=0 rightmargin=0 topmargin=0>" & vbCrLf
        Response.Write "<BR style=""OVERFLOW: hidden; LINE-HEIGHT: 3px"">" & vbCrLf
End Sub
Sub Admin_footer()
        Response.Write "<br />" & vbCrLf
        Response.Write "</body>" & vbCrLf
        Response.Write "</html>"
End Sub
Dim Action,i,Rs,Sql,FoundErr,Errmsg
Dim ServerObject(12)
ServerObject(1) = "Scripting.FileSystemObject"     '//Fso
ServerObject(2) = "Microsoft.XMLDOM"               '//XML
ServerObject(3) = "JMail.SMTPMail"                 '//JMail
'-------------------------------------------------------------------
ServerObject(4) = "ADODB.Stream"                   '//Adodb.Stream
ServerObject(5) = "Persits.Upload"                 '//Aspupload3.0
ServerObject(6) = "SoftArtisans.FileUp"            '//SA-FileUp 4.0
'-------------------------------------------------------------------
ServerObject(7) = "JMail.Message"                  '//JMail 4.3
ServerObject(8) = "CDONTS.NewMail"                 '//CDONTS
ServerObject(9) = "Persits.MailSender"             '//ASPEMAIL
'-------------------------------------------------------------------
ServerObject(10) = "CreatePreviewImage.cGvbox"     '//CreatePreviewImage
ServerObject(11) = "Persits.Jpeg"                  '//AspJpeg
ServerObject(12) = "SoftArtisans.ImageGen"         '//SoftArtisans ImgWriter V1.21
'===========================================================================================分页函数
Sub PageControl(iCount,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("<div " & Table_style & ">" & vbCrLf ) 
Response.Write("<form method=get onsubmit=""document.location = '" & action & "?" & temp & "Page='+ this.page.value;return false;"">" & vbCrLf ) 
Response.Write("" & 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(" 页次：" & page & "/" & pageCount & "页" & vbCrLf) 
Response.Write(" 共有" & iCount & "条记录" & vbCrLf) 
Response.Write(" 转到" & "<input type='text' name=page size=1 Maxlength=5 value=" & page & " class='InputText' />" & "页" & vbCrLf & "<input type='submit' value='GO' class='InputButton' />") 
Response.Write("" & vbCrLf ) 
Response.Write("</form>" & vbCrLf ) 
Response.Write("</div>" & vbCrLf ) 
End Sub 
%>
