<%
dim conn,rs,db_1,db_2,db
'后台连接数据库\
sub db_conn()
Set conn = Server.CreateObject("ADODB.Connection")
'ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("../DB/Auto#Web.txt")&";Jet OLEDB:Database Password=21cp_web;"
ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("../DB/AutoWeb.mdb")&";Jet OLEDB:Database Password=21cp_web;"
conn.open ConnStr
If Err Then
err.Clear
Set Conn = Nothing
Response.Write "数据库连接出错，请检查连接字串。"'注释，需要把这几个字翻译成英文。
Response.End
End If
end sub
''前台数据库链接
sub adb_conn(add_ress)
Set conn = Server.CreateObject("ADODB.Connection")
'ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath("../DB/Auto#Web.txt")
ConnStr="Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & Server.MapPath(add_ress)&";Jet OLEDB:Database Password=21cp_web;"
conn.open ConnStr
If Err Then
err.Clear
Set Conn = Nothing
Response.Write "数据库连接出错，请检查连接字串。"'注释，需要把这几个字翻译成英文。
Response.End
End If
end sub
'创建记录集
function rs_create(selectstr)
set rs=conn.execute(selectstr)
end function
'清空记录集
sub rs_close()
rs.close
set rs=nothing
end sub
'断开数据库连接
sub db_close()
conn.close
set conn=nothing
end sub
'''''''''''''''''''''''''限制登陆后才能访问
sub session_Add(n)
if session("name")<>"true" then
response.Redirect(n)
end if
end sub
%>
<%
'--------定义部份------------------
Dim Fy_Post,Fy_Get,Fy_In,Fy_Inf,Fy_Xh
'自定义需要过滤的字串,用 "枫" 分隔
Fy_In = "'|exec|insert|select|delete|update|count|chr|mid|master|truncate|char|declare"
Fy_In2 = "'|*|%|(|)|=|exec|insert|select|delete|update|truncate"
'----------------------------------
%>
<%
Fy_Inf = split(Fy_In,"|")
Fy_Inf2 = split(Fy_In2,"|")
'--------POST部份------------------
If Request.Form<>"" Then
For Each Fy_Post In Request.Form
For Fy_Xh=0 To Ubound(Fy_Inf)
If Instr(LCase(Request.Form(Fy_Post)),Fy_Inf(Fy_Xh))<>0 Then
response.Write("")
Response.End
End If
Next
Next
End If
'----------------------------------
'--------GET部份-------------------
If Request.QueryString<>"" Then
For Each Fy_Get In Request.QueryString
For Fy_Xh=0 To Ubound(Fy_Inf2)
If Instr(LCase(Request.QueryString(Fy_Get)),Fy_Inf2(Fy_Xh))<>0 Then
response.Write("")
Response.End
End If
Next
Next
End If
%>
<%
dim mypage,rs_page
'------------------------------------------------------------
'引用页面类函数节
'page_con 连接句炳
'page_sql_str 查询字符串
'page_size 每页显示数量
'--------------------------------------------------------------
public function create_page(page_con,page_sql_str,page_size,Page_Top,Page_Help)
Set mypage=new yasurpage '创建对象
mypage.getconn=page_con '得到数据库连接
mypage.getsql=page_sql_str
mypage.pagesize=page_size '设置每一页的记录条数
mypage.Page_AllNum=Page_Top
mypage.Page_IsHelp=Page_Help
set rs_page=mypage.getrs()
end function
Const Btn_First="9" '定义第一页按钮显示样式
Const Btn_Prev="3" '定义前一页按钮显示样式
Const Btn_Next="4" '定义下一页按钮显示样式
Const Btn_Last=":" '定义最后一页按钮显示样式
Const XD_Align="Center" '定义分页信息对齐方式
Const XD_Width="100%" '定义分页信息框大小
Class yasurpage
Private XD_PageCount,XD_Conn,XD_Rs,XD_SQL,XD_PageSize,Str_errors,int_curpage,str_URL,int_totalPage,int_totalRecord,Page_AllNumTemp,Page_IsHelpTemp
'=================================================================
'PageSize 属性
'设置每一页的分页大小
'=================================================================
Public Property Let PageSize(int_PageSize)
If IsNumeric(Int_Pagesize) Then
XD_PageSize=CLng(int_PageSize)
Else
str_error=str_error & "PageSize的参数不正确"
ShowError()
End If
End Property
Public Property Get PageSize
If XD_PageSize="" or (not(IsNumeric(XD_PageSize))) Then
PageSize=10
Else
PageSize=XD_PageSize
End If
End Property
'=================================================================
'GetRS 属性
'返回分页后的记录集
'=================================================================
Public Property Get GetRs()
Set XD_Rs=Server.createobject("adodb.recordset")
XD_Rs.PageSize=PageSize
XD_Rs.Open XD_SQL,XD_Conn,1,1
If not(XD_Rs.eof and XD_RS.BOF) Then
If int_curpage>XD_RS.PageCount Then
int_curpage=XD_RS.PageCount
End If
XD_Rs.AbsolutePage=int_curpage
End If
Set GetRs=XD_RS
End Property
'================================================================
'GetConn 得到数据库连接
'================================================================
Public Property Let GetConn(obj_Conn)
Set XD_Conn=obj_Conn
End Property
Public Property Let Page_AllNum(Page_top)
Page_AllNumTemp=Page_top
End Property
Public Property Let Page_isHelp(Page_Help)
Page_IsHelpTemp=Page_Help
End Property
'================================================================
'GetSQL 得到查询语句
'================================================================
Public Property Let GetSQL(str_sql)
XD_SQL=str_sql
End Property
'==================================================================
'Class_Initialize 类的初始化
'初始化当前页的值
'
'==================================================================
Private Sub Class_Initialize
'========================
'设定一些参数的黙认值
'========================
XD_PageSize=10 '设定分页的默认值为10
'========================
'获取当前面的值
'========================
If request("page")="" Then
int_curpage=1
ElseIf not(IsNumeric(request("page"))) Then
int_curpage=1
ElseIf CInt(Trim(request("page")))<1 Then
int_curpage=1
Else
Int_curpage=CInt(Trim(request("page")))
End If
End Sub
'====================================================================
'ShowPage 创建分页导航条
'有首页、前一页、下一页、末页、还有数字导航
'====================================================================
Public Sub ShowPage()
Dim str_tmp
int_totalRecord=XD_RS.RecordCount
If int_totalRecord<=0 Then
str_error=str_error & "总记录数为零，请输入数据"
Call ShowError()
End If
If int_totalRecordint_Totalpage Then
int_curpage=int_TotalPage
End If
'===============================================================================
'显示分页信息，各个模块根据自己要求更改显求位置
'===============================================================================
response.write "
"
End Sub
'====================================================================
'ShowFirstPrv 显示首页、前一页
'====================================================================
Private Function ShowFirstPrv()
Dim Str_tmp,int_prvpage
If int_curpage=1 Then
str_tmp="<<<"
Else
int_prvpage=int_curpage-1
str_tmp="<<<"
End If
ShowFirstPrv=str_tmp
End Function
'====================================================================
'ShowNextLast 下一页、末页
'====================================================================
Private Function ShowNextLast()
Dim str_tmp,int_Nextpage
If Int_curpage>=int_totalpage Then
str_tmp=">>>"
Else
Int_NextPage=int_curpage+1
str_tmp=">>>"
End If
ShowNextLast=str_tmp
End Function
'====================================================================
'ShowNumBtn 数字导航
'====================================================================
Private Function showNumBtn()
Dim i,str_tmp,end_page,start_page
if int_totalpage<=5 then
start_page=1
end_page=int_totalpage
else
if int_totalpage-int_curpage<2 then
start_page=int_totalpage-4
end_page=int_totalpage
else
if int_curpage<3 then
start_page=1
end_page=5
else
start_page=int_curpage-2
end_page=int_curpage+2
end if
end if
end if
For i=start_page to end_page
If i=int_curpage Then
str_tmp=str_tmp & ""&i&""
else
str_tmp=str_tmp & ""&i&""
End If
Next
showNumBtn=str_tmp
End Function
'====================================================================
'ShowPageInfo 分页信息
'更据要求自行修改
'====================================================================
Private Function ShowPageInfo()
Dim str_tmp
str_tmp="页次:"&int_curpage&"/"&int_totalpage&" 总记录:"&int_totalrecord&" 每页:"&XD_PageSize&""
ShowPageInfo=str_tmp
End Function
'==================================================================
'ShowGoto 页面跳转
'==================================================================
'Private Function ShowGoto()
'showgoto=" "
'End Function
'==================================================================
'GetURL 得到当前的URL
'更据URL参数不同，获取不同的结果
'==================================================================
Private Function GetURL()
Dim strurl,str_url,i,j,search_str,result_url
search_str="page="
strurl=Request.ServerVariables("URL")
Strurl=split(strurl,"/")
i=UBound(strurl,1)
str_url=strurl(i)'得到当前页文件名
str_params=Request.ServerVariables("QUERY_STRING")
If str_params="" Then
result_url=str_url & "?page="
Else
If InstrRev(str_params,search_str)=0 Then
result_url=str_url & "?" & str_params &"&page="
Else
j=InstrRev(str_params,search_str)-2
If j=-1 Then
result_url=str_url & "?page="
Else
str_params=Left(str_params,j)
result_url=str_url & "?" & str_params &"&page="
End If
End If
End If
GetURL=result_url
End Function
'====================================================================
' 设置 Terminate 事件。
'====================================================================
Private Sub Class_Terminate
XD_RS.close
Set XD_RS=nothing
End Sub
'====================================================================
'ShowError 错误提示
'====================================================================
Private Sub ShowError()
If str_Error <> "" Then
Response.Write(" " & SW_Error & "")
Response.End
End If
End Sub
End class
%><%
'---------------------------------------
'功能 :计算字符串长度，考虑中文2字节长度
'参数说明
' str : 需要计算的字符串
'返回值 : 字符串的长度
'修改日期 : 2004-03-02
'修改人 :
'---------------------------------------
Function Strlength(Str)
Temp_Str=Len(Str)
For I=1 To Temp_Str
Test_Str=(Mid(Str,I,1))
If Asc(Test_Str)>0 Then
Strlength=Strlength+1
Else
Strlength=Strlength+2
End If
Next
End Function
'---------------------------------------
'功能 :从左侧俺长度截取字符串，考虑中文2字节长度
'参数说明
' str : 需要判断的字符串
' L : 显示的字符串的个数
'返回值 : 左边的L个字符
'修改日期 : 2004-03-02
'修改人 :
'---------------------------------------
Function Strleft(Str,L)
Temp_Str=Len(Str)
For I=1 To Temp_Str
Test_Str=(Mid(Str,I,1))
Strleft=Strleft&Test_Str
If Asc(Test_Str)>0 Then
lens=lens+1
Else
lens=lens+2
End If
If lens>=L Then Exit For
Next
End Function
'---------------------------------------
'功能 :从右侧俺长度截取字符串，考虑中文2字节长度
'参数说明
' str : 需要判断的字符串
' L : 显示的字符串的个数
'返回值 : 右边的L个字符
'修改日期 : 2004-03-02
'修改人 :
'---------------------------------------
Function Strright(Str,L)
Temp_Str=Len(Str)
For i = Temp_Str to 1 step -1
Test_Str=(Mid(Str,I,1))
Strright=Test_Str&Strright
If Asc(Test_Str)>0 Then
lens=lens+1
Else
lens=lens+2
End If
If lens>=L Then Exit For
Next
End Function
'------------------------------------------------------------------
'函数:lefttrue()-----如果字符串str的长度大于n，则显示左边的n个字符
'参数说明
' str : 需要判断的字符串
' n : 显示的字符串的个数
'返回值 : 左边的n个字符
'修改日期 : 2004-03-02
'修改人 :
'------------------------------------------------------------------
Function LeftTrue(str,n)
IF STR<>"" THEN
If len(str)<=n/2 Then
LeftTrue=str
Else
Dim TStr
Dim l,t,c
Dim i
l=len(str)
TStr=""
t=0
for i=1 to l
c=asc(mid(str,i,1))
If c<0 then c=c+65536
If c>255 then
t=t+2
Else
t=t+1
End If
If t>n Then exit for
TStr=TStr&(mid(str,i,1))
next
LeftTrue = TStr & "..."
End If
END IF
End Function
'--------------------------------------
'功能：Email合法性检查
'参数说明
'email : 需要检查的Email
'返回值 : 如果合法返回：true, 否则返回：false
'修改日期 : 2004-03-02
'修改人 :
'---------------------------------------------------
function IsValidEmail(email)
dim names, name, i, c
IsValidEmail = true
names = Split(email, "@")
if UBound(names) <> 1 then
IsValidEmail = false
exit function
end if
for each name in names
if Len(name) <= 0 then
IsValidEmail = false
exit function
end if
for i = 1 to Len(name)
c = Lcase(Mid(name, i, 1))
if InStr("abcdefghijklmnopqrstuvwxyz_-.", c) <= 0 and not IsNumeric(c) then
IsValidEmail = false
exit function
end if
next
if Left(name, 1) = "." or Right(name, 1) = "." then
IsValidEmail = false
exit function
end if
next
if InStr(names(1), ".") <= 0 then
IsValidEmail = false
exit function
end if
i = Len(names(1)) - InStrRev(names(1), ".")
if i <> 2 and i <> 3 then
IsValidEmail = false
exit function
end if
if InStr(email, "..") > 0 then
IsValidEmail = false
end if
end function
'***************************************************
'函数名：webupsite
'作 用：设置网站上传功能
'参 数：1是否允许上传图片，300上传文件大小限制K，存放上传文件的目录：upfiles/（相对于首页的相对路径）;允许的上传文件类型，用|分隔
'***************************************************
webupsite="1$300$upfiles/$jpg|gif|swf"
if InStr(webupsite,"$")>0 then
webupsite=split(webupsite,"$")
end if
if IsArray(webupsite) then
webupaccept=cbool(webupsite(0))
webupsize=webupsite(1)
webuppath=webupsite(2)
webuptype=webupsite(3)
end if
'==================================================
'函数名：createname
'作 用：生成由年月日时和随机数字组成的文件名
'参 数：无
'==================================================
Function createname
dim ranNum
randomize
ranNum=int(90000*rnd)+10000
createname=year(now)&month(now)&day(now)&hour(now)&minute(now)&second(now)&ranNum&"21cp"
End Function
'==================================================
'函数名：CreateDir
'作 用：建立目录
'参 数：FolderPath ------ 要建立的目录
'==================================================
Function CreateDir(FolderPath)''''''''''创建文件夹地址
dim fsoo,f
Set fsoo = CreateObject("Scripting.FileSystemObject")
If not fsoo.FolderExists(Server.MapPath(FolderPath)) then
Set f = fsoo.CreateFolder(Server.MapPath(FolderPath))
End if
Set fsoo = nothing
End Function
Function BuLing(DateStr)
Temp_Str=Len(DateStr)
if Temp_Str=1 then
BuLing="0"&DateStr
else
BuLing=DateStr
end if
end function
'==================================================
'函数名：fso
'作 用：Fso组件
'参 数：无
'==================================================
function fso(filename)'''''''''''''''''读取模板
set fs=server.CreateObject ("scripting.filesystemobject")
set fsts=fs.opentextfile(server.mappath(filename),1)
body=fsts.readall
fso=body
end function
'==================================================
'函数名：showpage
'作 用：分页函数
'参 数：showurl ------ 转到的页面
' showtotal ------ 总记录数
' showmaxpage ------ 每页最大记录数
' showcurpage ------ 目前所在页面数
'==================================================
Function showpage(showurl,showtotal,showmaxpage,showcurpage)
dim showx
if showtotal>1 then
if (showtotal mod showmaxpage)=0 then
showx=showtotal\showmaxpage
else
showx=showtotal\showmaxpage+1
end if
end if
if showcurpage<2 then
response.write "首 页 上一页 "
else
response.write "首 页上一页 "
end if
if showx-showcurpage<1 then
response.write "下一页 尾 页"
else
response.write "下一页尾 页"
end if
End Function
'****************************************************
'过程名：WriteErrMsg
'作 用：显示错误提示信息
'参 数：无
'****************************************************
sub WriteErrMsg(errmsg)
dim strErr
strErr=strErr & "错误信息" & vbcrlf
strErr=strErr & "
"&vbcrlf
strSuccess=strSuccess &""&vbcrlf
response.write strSuccess
end sub
'==================================================
'过程名：ReplaceRemoteUrl
'作 用：替换字符串中的远程文件为本地文件并保存远程文件
'参 数：strContent ------ 要替换的字符串
'==================================================
function ReplaceRemoteUrl(strContent,Picpath)
if IsObjInstalled("Microsoft.XMLHTTP")=False then
ReplaceRemoteUrl=strContent
exit function
end if
dim re,RemoteFile,RemoteFileurl,SaveFilePath,TempPath,SaveFileName,SaveFileType,arrSaveFileName,ranNum
SaveFilePath = "/"&webuppath '文件保存的本地路径
if right(SaveFilePath,1)<>"/" then SaveFilePath=SaveFilePath&"/"
TempPath=year(now)& "-" &month(now)&"/"
call CreateDir(SaveFilePath & TempPath)
Set re=new RegExp
re.IgnoreCase =true
re.Global=True
re.Pattern = "((http|https|ftp|rtsp|mms):(\/\/|\\\\){1}((\w)+[.]){1,}(net|com|cn|org|cc|tv|[0-9]{1,3})(\S*\/)((\S)+[.]{1}(gif|jpg|png|bmp)))"
Set RemoteFile = re.Execute(strContent)
For Each RemoteFileurl in RemoteFile
arrSaveFileName = split(RemoteFileurl,".")
SaveFileType=arrSaveFileName(ubound(arrSaveFileName))
SaveFileName = createname&"."&SaveFileType
call SaveRemoteFile(SaveFilePath & TempPath & SaveFileName,RemoteFileurl)
strContent=Replace(strContent,RemoteFileurl,SaveFilePath & TempPath & SaveFileName)
if Articlefiles="" then
Articlefiles=SaveFilePath & TempPath & SaveFileName
else
Articlefiles=Articlefiles & "|" & SaveFilePath & TempPath & SaveFileName
end if
Next
Picpath=Articlefiles
ReplaceRemoteUrl=strContent
end function
'==================================================
'过程名：SaveRemoteFile
'作 用：保存远程的文件到本地
'参 数：LocalFileName ------ 本地文件名
' RemoteFileUrl ------ 远程文件URL
'==================================================
sub SaveRemoteFile(LocalFileName,RemoteFileUrl)
dim Ads,Retrieval,GetRemoteData
Set Retrieval = Server.CreateObject("Microsoft.XMLHTTP")
With Retrieval
.Open "Get", RemoteFileUrl, False, "", ""
.Send
GetRemoteData = .ResponseBody
End With
Set Retrieval = Nothing
Set Ads = Server.CreateObject("Adodb.Stream")
With Ads
.Type = 1
.Open
.Write GetRemoteData
.SaveToFile server.MapPath(LocalFileName),2
.Cancel()
.Close()
End With
Set Ads=nothing
end sub
'***************************************************
'函数名：IsObjInstalled
'作 用：检查组件是否已经安装
'参 数：strClassString ----组件名
'返回值：True ----已经安装
' False ----没有安装
'***************************************************
Function IsObjInstalled(strClassString)
On Error Resume Next
IsObjInstalled = False
Err = 0
Dim xTestObj
Set xTestObj = Server.CreateObject(strClassString)
If 0 = Err Then IsObjInstalled = True
Set xTestObj = Nothing
Err = 0
End Function
'==================================================
'过程名：
'作 用：删除指定的文件
'参 数：strUploadFiles ------ 文件的字符串
'==================================================
sub DelFiles(strUploadFiles)
if strUploadFiles="" then exit sub
dim fso,arrUploadFiles,i
Set fso = CreateObject("Scripting.FileSystemObject")
if instr(strUploadFiles,"|")>1 then
arrUploadFiles=split(strUploadFiles,"|")
for i=0 to ubound(arrUploadFiles)
if fso.FileExists(server.MapPath(arrUploadfiles(i))) then
fso.DeleteFile(server.MapPath(arrUploadfiles(i)))
end if
next
else
if fso.FileExists(server.MapPath(strUploadfiles)) then
fso.DeleteFile(server.MapPath(strUploadfiles))
end if
end if
Set fso = nothing
end sub
'功能 :创建文件夹
'参数说明
' fldr : 需要创建文件夹的路径：文件路径"new/21cp"
'返回值 : 创建的文件夹
'修改日期 : 2008-09-07
'修改人 : 中塑在线研发部
'---------------------------------------
Function CreateFolder(fldr)
on error resume next
Dim fso, f
Set fso = CreateObject("Scripting.FileSystemObject")
Set f = fso.CreateFolder(Server.MapPath(fldr))
CreateFolder = f.Path
Set f=nothing
Set fso=nothing
End Function
'---------------------------------------
'功能 :创建文件
'参数说明
' path : 需要创建文件夹的路径：文件路径"new/21cp"
' str : 需要创建文件夹的路径：文件路径"new/21cp"
'返回值 : 新创建的文件
'修改日期 : 2008-09-07
'修改人 : 中塑在线研发部
'演示 ：createhtml "new/1.php",moban
'---------------------------------------
Function createhtml(path,str)
GetFold=split(path,"/")
For e=0 to Ubound(GetFold)-1
if fldr="" then
fldr=GetFold(e)
else
fldr=fldr&"/"&GetFold(e)
end if
If IsFolder(fldr)=false then
CreateFolder fldr
End if
Next
Set fso = Server.CreateObject("Scripting.FileSystemObject")
Set fout = fso.CreateTextFile(server.mappath(path))
fout.Write str
fout.close
set fso = nothing
End Function
'---------------------------------------
'功能 :读取文件
'参数说明
' Template_Name : 需要读取的文件：文件路径"1.php"
'返回值 : 读取的类容
'修改日期 : 2008-09-07
'修改人 : 中塑在线研发部
'---------------------------------------
Function FSOFileRead(Template_Name)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(Template_Name),1,True)
If objCountFile.AtEndOfStream = false Then FSOFileRead = objCountFile.ReadAll
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function
'---------------------------------------
'---------------------------------------
'功能 :删除文件夹
'参数说明
' path : 需要删除文件夹的路径：文件路径"new/21cp"
'返回值 : null
'修改日期 : 2008-09-07
'修改人 : 中塑在线研发部
'演示 ：delfolder("cp/21cp")
'---------------------------------------
Function delfolder(path)
If IsFolder(path)=True Then
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFolder(server.mappath(path))
set fso = Nothing
End If
End Function
'---------------------------------------
'功能 :检测文件是否存在
'参数说明
' filespec : 需要删除文件的路径：文件路径"new/21cp.php"
'返回值 : True,False
'修改日期 : 2008-09-07
'修改人 : 中塑在线研发部
'演示 ：IsExists("new/21cp.php")
'---------------------------------------
Function IsExists(filespec)
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
If (fso.FileExists(server.MapPath(filespec))) Then
IsExists = True
Else
IsExists = False
End If
Set fso=nothing
End Function
'---------------------------------------
'功能 :检测文件夹是否存在
'参数说明
' filespec : 需要删除文件的路径：文件路径"new/21cp"
'返回值 : True,False
'修改日期 : 2008-09-07
'修改人 : 中塑在线研发部
'演示 ：IsFolder("new/21cp.php")
'---------------------------------------
Function IsFolder(Folder)
Set fso = CreateObject("Scripting.FileSystemObject")
If FSO.FolderExists(server.MapPath(Folder)) Then
IsFolder = True
Else
IsFolder = False
End If
Set fso=nothing
End Function
'------------------------------------------------------------------
'函数:空格、回车等字符替换
'参数说明
' fString : 需要替换的字符串
'返回值 : 替换后的字符串
'修改日期 : 2004-11-21
'修改人 :
'------------------------------------------------------------------
function HTMLEncode(fString)
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
'fString = replace(fString, "&#", "&#")
'fString = Replace(fString, CHR(32), " ")
'fString = Replace(fString, CHR(9), " ")
'fString = Replace(fString, CHR(34), """)
'fString = Replace(fString, CHR(39), "'")
'fString = Replace(fString, CHR(13), "")
'fString = Replace(fString, CHR(10) & CHR(10), "
", CHR(10) & CHR(10))
fString = Replace(fString, " ", CHR(10))
Dis_HTMLEncode = fString
end Function
'过滤非法字符
Function filt_badstr(sSql)
If ISNull(sSql) Then Exit Function
sSql=Trim(sSql)
If sSql="" Then Exit Function
sSql=Replace(sSql,Chr(0),"")
sSql=Replace(sSql,"'","''")
'sSql=Replace(sSql,"%","％")
'sSql=Replace(sSql,"-","－")
filt_badstr=sSql
End Function
'替换搜索关键字中的大写空格，左边空格和右边空格
function Replacestr(str)
str=ltrim(str)
str=rtrim(str)
str=replace(str,"|"," ")
str=replace(str," "," ")
str=replace(str,","," ")
str=replace(str,";"," ")
MyString=split(str," ")
For i=0 To ubound(MyString)
If MyString(i)<>"" then
If i=ubound(MyString) then
Tempstr=Tempstr&""""&MyString(i)&""""
Else
Tempstr=Tempstr&""""&MyString(i)&""" and "
End If
End If
next
Replacestr=Tempstr
'response.write Tempstr
end function
'格式化日期函数
Function FormatDate(DateAndTime, para)
'On Error Resume Next
Dim y, m, d, h, mi, s, strDateTime
FormatDate = DateAndTime
If Not IsNumeric(para) Then Exit Function
If Not IsDate(DateAndTime) Then Exit Function
y = Mid(CStr(Year(DateAndTime)),3)
m = CStr(Month(DateAndTime))
If Len(m) = 1 Then m = "0" & m
d = CStr(Day(DateAndTime))
If Len(d) = 1 Then d = "0" & d
h = CStr(Hour(DateAndTime))
If Len(h) = 1 Then h = "0" & h
mi = CStr(Minute(DateAndTime))
If Len(mi) = 1 Then mi = "0" & mi
s = CStr(Second(DateAndTime))
If Len(s) = 1 Then s = "0" & s
Select Case para
Case "1"
strDateTime = y & "-" & m & "-" & d & " " & h & ":" & mi & ":" & s
Case "2"
strDateTime = y & "-" & m & "-" & d
Case "3"
strDateTime = y & "/" & m & "/" & d
Case "4"
strDateTime = y & "年" & m & "月" & d & "日"
Case "5"
strDateTime = m & "-" & d & " " & h & ":" & mi & ":" & s
Case "6"
strDateTime = m & "/" & d
Case "7"
strDateTime = m & "月" & d & "日"
Case "8"
strDateTime = y & "年" & m & "月"
Case "9"
strDateTime = y & "-" & m
Case "10"
strDateTime = y & "/" & m
Case Else
strDateTime = DateAndTime
End Select
FormatDate = strDateTime
End Function
'------------------------------------------------------------------
'函数:error跳转页面
'参数说明
' r_url : error跳转页面
'返回值 :
'修改日期 :2008-12-05
'修改人 : 胡斌
'------------------------------------------------------------------
Function Showok(AlertStr)'成功
response.write ""
response.Flush()
response.End()
End Function
Function ShowAlert(AlertStr,gerurl)'成功
response.write ""
response.Flush()
response.End()
End Function
'------------------------------------------------------------------
'函数:解决此页面不能直接访问IP
'参数说明
' r_url : error跳转页面
'返回值 :
'修改日期 :2008-12-05
'修改人 : 胡斌
'------------------------------------------------------------------
function Xz_url(r_url)'
url=request.servervariables("HTTP_REFERER")
if url="" then
response.Write("")
response.Flush()
response.End()
end if
end function
'------------------------------------------------------------------
'函数:获取IP
'参数说明
' fString : 获取ip
'返回值 : 客户端IP
'修改日期 :2008-12-05
'修改人 :
'------------------------------------------------------------------
Function getIP()
Dim strIPAddr
If Request.ServerVariables("HTTP_X_FORWARDED_FOR") = "" OR InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), "unknown") > 0 Then
strIPAddr = Request.ServerVariables("REMOTE_ADDR")
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ",")-1)
ElseIf InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";") > 0 Then
strIPAddr = Mid(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), 1, InStr(Request.ServerVariables("HTTP_X_FORWARDED_FOR"), ";")-1)
Else
strIPAddr = Request.ServerVariables("HTTP_X_FORWARDED_FOR")
End If
getIP = Trim(Mid(strIPAddr, 1, 30))
End Function
'------------------------------------------------------------------
'函数:加载页面刷新
'参数说明
'返回值 : 加载页面刷新
'修改日期 :2008-12-05
'修改人 :
'------------------------------------------------------------------
function reload()
Response.Buffer = True
Response.ExpiresAbsolute = Now() - 1
Response.Expires = 0
Response.CacheControl = "no-cache"
end function
'------------------------------------------------------------------
'函数:判断是否为数字
'参数说明
'返回值 : 判断是否为数字
'修改日期 :2008-12-05
'修改人 : 胡斌
'调用方法 :isnum 231212,"http：//www.21cp.net"
'------------------------------------------------------------------
function isnum(id,geturl)
if id="" then
response.Write("")
response.End()
else
if IsNumeric(id) <> true then
response.Write("")
response.End()
end if
end if
end function
Function ShowEnd(AlertStr,AlertUrl)'''''''''''''''''''提示后，转向其他页面。如，成功提示
response.write ""
response.Flush()
response.End()
End Function
%>
<%
call adb_conn("DB/AutoWeb.mdb")
' 判断验证码的函数
Function ValidCode(pSN,k,c)
Dim s,i
s = Session(pSN)
k = ";"&k&":"
ValidCode = False
i = InStr(s,k)
If i > 0 Then
If InStr(s,k&c&";") > 0 Then ValidCode = True
Session(pSN) = Left(s,i) & Right(s,Len(s)-InStr(i+1,s,";"))
End If
End Function
flag = request.Form("flag")
If flag = "savely" then
NickName = Trim(HTMLEncode(request.Form("addName")))
Tel = HTMLEncode(request.Form("addContact"))
Content = Trim(HTMLEncode(request.Form("addContent")))
codeKey = request.Form("codeKey")
addCode = request.Form("addCode")
if NickName ="" or Content = "" or addCode = "" then
response.Write("")
else
If ValidCode("CSName",codeKey,addCode) Then
conn.execute("insert into Guestbooks(NickName,IssueTime,Tel,Content)values('"& NickName &"','"& Now() &"','"& Tel &"','"& Content &"')")
response.Write("")
Else
response.Write("")
End If
End if
End If
%>
Add :No.14,Building E China Plastic City.Yuyao.Zhejiang.China
Tel :86- 574-62537458 56314202
Fax : 86-574-62537458
Mobile : 86-13605845846
E-mail : manager@yydonghui.com Web : http://www.yydonghui.com
<%
sql="select * from Guestbooks order by IssueTime desc"
call create_page(conn,sql,2,1,1)
if not(rs_page.eof and rs_page.bof) then
for ii=1 to mypage.pagesize
if not rs_page.eof then
%>
<%=rs_page("NickName")%> Published in ［<%=rs_page("IssueTime")%>］
<%=rs_page("Content")%>
<% If rs_page("AdminContent") <> "" Then %>
Customer service reply Reply to ［<%=rs_page("hfTime")%>］
<%=rs_page("AdminContent")%>
<% END IF %>
<%
rs_page.movenext
else
exit for
end if
next
end if
%>
<% if not (rs_page.eof and rs_page.bof) then %><%=mypage.showpage()%><%end if%>
