<% '*********************** '描述:网页文件使用函数 '作者:STEVEN '日期:2008-3-20 '*********************** %> <% public UPDATE_TIME,counter UPDATE_TIME=date() & " " & time() function NulltoZero(var1) if isNull(var1) or var1="" then NulltoZero=0 else NulltoZero=Clng(var1) end if end function ' ============================================ ' 进行操作判断,是否进一步操作 ' strAlert 提示语言 Num 确认返回的地址 ' ============================================ Function OKToWhere(strAlert,Num) Response.Write("") Response.End End Function ' ============================================ ' 进行操作判断,是否进一步操作 '使用方法 :call OKToWhere2("设置成功","set_function.asp") ' strAlert 提示语言, Where 转向的地址 ' ============================================ Function OKToWhere2(strAlert,where) Response.Write("") Response.End End Function Function GetSafeStr(str) ' GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "") GetSafeStr = Replace(Replace(Replace(Replace(Replace(str,"'","‘"),"""","“"),"&",""),"<","<"),">",">") End Function Function GetSafeStr1(str) ' GetSafeStr = Replace(Replace(Replace(Trim(str), "'", ""), Chr(34), ""), ";", "") GetSafeStr1 = Replace(Replace(Replace(str,"'","’"),"""","“"),"&","") End Function Function GetSafeInt(iCheck,iDefault) If Trim(iCheck)="" Then GetSafeInt = iDefault Exit Function End If If IsNumeric(iCheck)=false Then GetSafeInt = iDefault Exit Function End If GetSafeInt = iCheck GetSafeInt=clng(GetSafeInt) End Function function SpacetoNull(var1) if isNull(var1) or var1="" then NulltoZero="Null" else NulltoZero=clng(var1) end if end function function NullToSpace(var1) if isNull(var1) or var1="" then NullToSpace=" " else NullToSpace=trim(var1) end if end function Function HTMLEncode(fString) If Not IsNull(fString) Then Dim bwords,ii '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), "

") fString = Replace(fString, CHR(10), "
") HTMLEncode = fString End If End Function Function unHTMLEncode(fString) If Not IsNull(fString) Then Dim bwords,ii '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)) fString = Replace(fString, "
", CHR(10)) unHTMLEncode = fString End If End Function '****************************************************************************************************************** function funPage(haveOrder,fstClass,secClass,strSqlPar,TitCount,TitNameArr,fileNameArr,PageSize,tabWidth,PreviousMark,NextMart,FirstMart,LastMart,borderWidth,hrefDelFilName,idName,hrefUpdFilName,haveDel,openFileName,haveOpen,LineLength,OpenLinkLogo,haveDateAndClass,haveTarget,ActionUrl) '适用于后台 分页显示 具有修改,删除的超连 'haveOrder 1是否有排序 'fstClass 2一类名称 'secClass 3二类名称 'strSqlPar 4要传进来的SQl语句 'TitCount 5共有表头的个数 'TitNameArr 6表头的名 各名之间用全角“,”分隔 'fileNameArr 7要显示的字段名 各字段名之前用全角“,”分隔 'PageSize 8每页显示数据的数目 'tabWidth 9表格的宽度 'PreviousMark 10前一页的标记 就是前一页用什么表示 'NextMart 11后一页的标记 就是后一页用什么表示 'FirstMart 12首一页的标记 就是前一页用什么表示 'LastMart 13尾一页的标记 就是前一页用什么表示 'borderWidth 14表格边框的宽度 'hrefDelFilName 15删除时所提交的页 eg:FL_login_action.asp?ID 'idName 16超连接时要传的ID所对应的数据库中的字段名 'hrefUpdFilName 17超连接的地址和要传的参数名 eg: shopping_News.asp?ID= 'openFileName 18点标标题打开一个新页--新页文件的名字 'haveOpen 19是否有Open 一个新页的功能 'LineLength 20每一行显示的字数 'OpenLinkLogo 21显示出来列表前面的小标识 'haveDateAndClass 22标题后是否显示日期 可以向这里传class的名子 如果此参数为空则不显示日期 'haveTarget 23在点击修改时是否由TARGET 'ActionUrl 24接受的参数与 %> <% dim strSql,rs,i,j dim Arr_TitHeadName,Arr_TitBodyName dim CurrPage dim inDateSpaceLeng,titLength,titleCon dim UrlP_Name,UrlPval 'Response.Write "

" Response.Write "" if instr(ActionUrl,"=")>0 and instr(ActionUrl,"&")>0 then ActionUrlArr=split(ActionUrl,"&") for i=0 to ubound(ActionUrlArr) if instr(ActionUrlArr(i),"=")>0then UrlP_Name=left(ActionUrlArr(i),instr(ActionUrlArr(i),"=")-1) UrlPval=mid(ActionUrlArr(i),instr(ActionUrlArr(i),"=")+1) Response.Write "" end if next 'add at 2004-11-27 because 在的Ver01中虽然可以保持原来丢失的参数,但只限于一个,这次可以保持N个参数 else if instr(ActionUrl,"=")>0then UrlP_Name=left(ActionUrl,instr(ActionUrl,"=")-1) UrlPval=mid(ActionUrl,instr(ActionUrl,"=")+1) Response.Write "" 'Response.Write "" 'Response.Write "" end if end if 'add at 2004-04-14 because 因第一次好用,当点击翻页时,丢失原来参数而不能正常显示 Ver01 CurrPage=trim(request("hid_CurPage")) if isnumeric(CurrPage)=false and CurrPage<>"" then Response.Write "" exit function end if if CurrPage="" then CurrPage=1 Arr_TitHeadName=Split(TitNameArr,",") Arr_TitBodyName=Split(fileNameArr,",") set rs=server.CreateObject ("adodb.recordset") strSql=strSqlPar rs.Open strSql,conn1,3,1'access 用3 Sql2000,用1 if rs.eof or rs.bof then response.write "" exit function end if rs.PageSize=PageSize rs.AbsolutePage=CurrPage Response.Write" " Response.Write" " for i=0 to TitCount-1 Response.Write" " next Response.Write" " while not rs.EOF and j< rs.PageSize j=j+1 Response.Write" " if OpenLinkLogo<>"" then Response.Write"" end if for i=0 to ubound(Arr_TitBodyName) Response.Write"" '****************************** 'for list News last Date if haveDateAndClass<>"" then inDateSpaceLeng=instr(trim(rs("UPDATE_TIME"))," ") 'titleCon=titleCon & left(trim(rs("UPDATE_TIME")),inDateSpaceLeng-1) Response.Write "" end if '****************************** next if haveOrder="yes" then Response.Write"" end if if hrefUpdFilName<>"" then Response.Write" " end if if haveDel="yes" then Response.Write "" 'Response.Write" " end if Response.Write" " rs.MoveNext wend Response.Write "
" Response.Write Arr_TitHeadName(i) Response.Write"
" Response.Write OpenLinkLogo Response.Write"  " if isdate(NullToSpace(rs(Arr_TitBodyName(i)))) then inDateSpaceLeng=instr(rs(Arr_TitBodyName(i))," ") 'for list date ,not date() & " " time () inDateSpaceLeng=inDateSpaceLeng-1 if inDateSpaceLeng=-1 then 'edit at 2004-04-14 because date is 2004-01-01 not 2004-01-01 11:11:11 inDateSpaceLeng=len(trim(rs(Arr_TitBodyName(i)))) end if Response.Write left(rs(Arr_TitBodyName(i)),inDateSpaceLeng) else titleCon=NullToSpace(rs(Arr_TitBodyName(i))) 'if title too long then left(string,15) & "..." titLength=len(titleCon) if titLength > LineLength then titleCon=left (titleCon,LineLength) & "..." end if if haveOpen="yes" then 'Response.Write "" & titleCon & "" Response.Write "" & titleCon & "" else Response.Write "" & titleCon & "" end if end if Response.Write"" Response.Write "" & left(trim(rs("UPDATE_TIME")),inDateSpaceLeng-1) & "" 'Response.Write "" & rs("UPDATE_TIME") & "" Response.Write "" Response.Write"" Response.Write"" Response.Write"" Response.Write"" Response.Write"" Response.Write "修 改" Response.Write" " Response.Write "删除该信息,点击后删除……" 'Response.Write"
" Response.Write "" Response.Write "" Response.Write "
" Response.Write "共 "& rs.RecordCount & " 条 " Response.Write CurrPage & "/" & rs.PageCount & " 页  " Response.Write PageSize & " 条/页   " Response.Write " " & FirstMart & " " Response.Write " " & PreviousMark & " " 'Response.Write " " & NextMart & " " Response.Write " " & NextMart & " " Response.Write " " & LastMart & " " Response.Write "     全部选中    " Response.Write "" Response.Write "

 

" end function '****************************************************************************************************************** Public Function PBFCounter() if session("first")="" then strS="insert into counterNo (C_IP) values ('"&Request.ServerVariables("REMOTE_ADDR")&"')" conn1.execute strS session("first")="yes" end if set rs=server.createobject("adodb.recordset") strSql="select count(MID) from counterNo" rs.open strSql,conn1,1,1,1 counter=rs(0)+6180 PBFCounter=counter End Function Public Function pbFunParentMenu(Byval PAdmOrFront) ' List Master Menu Dim Id,Menu Set rs=server.CreateObject("ADODB.RecordSet") Select Case ucase(PAdmOrFront) Case "ADMIN" strSql="SELECT WMM_ID, WMM_MENU FROM WMM_MENU WHERE WMM_MENUID IS NULL " Id="WMM_ID" Menu="WMM_MENU" Case "FRONT" strSql="SELECT HPM_ID, HPM_MENU FROM HomePageMenu WHERE HPM_MENUID IS NULL " Id="HPM_ID" Menu="HPM_MENU" Case Else Response.Write "within confun pbFunParentMenu case else! " Response.End End Select rs.open strSql,conn1,3,3 Response.Write "" & chr(10) Response.Write ""& trim(rs(MenuId)) &"" & chr(10) Response.Write " 删 除 " & chr(10) Response.Write "" rs.movenext Wend End Function Function chkIsnumeric(ByVal Pval) chkIsnumeric=True If trim(Pval)="" Then chkIsnumeric=False End If If not isnumeric(Pval) Then chkIsnumeric=False End If If chkIsnumeric=False Then Response.Write "
Sorry the parametter ware wrong. You can't modification it
" Response.End End IF End Function %>