fun.asp

用ASP设计的一个网上问卷系统,用于网上调查问卷系统的实现

<%
'----------------------------------------------------------
'页面功能：系统所有的方法、函数，本站核心文件。
'最后修改时间：2007-11-20  15:43
'作者：legal http://www.ilegal.cn
'备注：
'----------------------------------------------------------

'---------------------
'判断字符串长度
'---------------------
Function CheckStringLength(txt)
txt=trim(txt)
x = len(txt)
y = 0
for ii = 1 to x
  if asc(mid(txt,ii,1))<0 or asc(mid(txt,ii,1))>255 then
    y = y + 2
  else
    y = y + 1
  end if
next
CheckStringLength = y
End Function
'====================================================================
'判断字符串长度，lentype=1，判断是否为空
'====================================================================
Function CheckString(checkstr,strlen,lentype,errstr1,errstr2)
  if CheckStringLength(checkstr)>strlen then
    I1 errstr2&"|||||"
	i=1
  end if
  if lentype=1 and checkstr="" then
    I1 errstr1&"|||||"
	i=1
  end if
End Function

'====================================================================
'程序调式函数,输出变量并截断
'====================================================================
Function Debug(toWrite)
I1 toWrite
response.End()
End Function

'====================================================================
'检验是否为数字的函数，用户对页面传递的id的验证
'====================================================================
function CheckNum(checkstr)
  if not isnumeric(checkstr) or checkstr="" then
    call ShowAlert("参数错误","")
  end if
end function
'====================================================================
'网站状态检查，只在首页调用过
'采用appliction
'====================================================================
Function Check_Site_State()
if isempty(Application(CookieName & "_SiteEnable"))  then
	sql="select Sys_close,Sys_state from [SysSet]"
	rs.open sql,conn,1,1
	if rs("Sys_state")=false then
		  Application.Lock
		  Application(CookieName & "_SiteEnable") = 0
		  Application(CookieName & "_SiteDisbleWhy") = rs("Sys_close")
		  Application.UnLock
	else
		  Application.Lock
		  Application(CookieName & "_SiteEnable") = 1
		  Application(CookieName & "_SiteDisbleWhy") = ""
		  Application.UnLock
	end if
	rs.close
else
	if Application(CookieName & "_SiteEnable") = 0 then
	      Call ShowAlert(Application(CookieName & "_SiteDisbleWhy"),"")
	end if
end if
End Function

'====================================================================
'检验是否为数字的函数2,用户表单提交的验证
'====================================================================
Function CheckNu(checkstr,errstr)
  if not isnumeric(checkstr) or cstr(checkstr)="" then
    response.Write(errstr&"|||||")
	i=1
  end if
End Function
'====================================================================
'输出函数
'====================================================================
Function I1(I2)
response.Write(I2)
End Function
'====================================================================
'字符转换函数
'====================================================================
Function HTMLEncode(fString)
  If Not IsNull(fString) Then
	fString = replace(fString, ">", "&gt;")
	fString = replace(fString, "<", "&lt;")
	fString = Replace(fString,CHR(32)," ")		
	fString = Replace(fString,CHR(34),"&quot;")
	fString = Replace(fString,CHR(39),"&#39;")
	fString = Replace(fString,CHR(9),"&nbsp;")
	fString = Replace(fString,CHR(13),"")
	fString = Replace(fString,CHR(10)&CHR(10),"</P><P>")
	fString = Replace(fString,CHR(10),"<BR>")
	HTMLEncode = fString
  End If
End Function

'====================================================================
'字符转回函数
'====================================================================
function HTMLDncode(fString)
  If Not IsNull(fString) Then
    fString = Replace(fString, "&gt;",">" )
    fString = Replace(fString, "&lt;", "<")
    fString = Replace(fString, " ", CHR(32))
    fString = Replace(fString, "&nbsp;", CHR(9))
    fString = Replace(fString, "&quot;", CHR(34))
    fString = Replace(fString, "&#39;", CHR(39))
    fString = Replace(fString, "", CHR(13))
    fString = Replace(fString, "</P><P> ",CHR(10) & CHR(10) )
    fString = Replace(fString, "<BR> ",CHR(10) )
    HTMLDncode = fString
  End If
End Function 
'====================================================================
'截取前几个字符，intcpt=intercept是截取的文字个数，
'====================================================================
function Intcpt(iString,iNumber)
  if len(iString) > iNumber then
    Intcpt=left(iString,iNumber)
  else
    Intcpt=iString
  end if
end function
'------------------------
'ShowAlert(提示信息，转向地址)
function ShowAlert(AlertMess,url)
if url="" then
response.Write"<script>alert ('"&AlertMess&"');location.href='javascript:history.go(-1)';</script> "
response.End()
else
response.Write"<script>alert ('"&AlertMess&"');location.href='"&url&"';</script> "
response.End()
end if
end function
'------------------------
'检验
function SwitchBoolean(I1)
if I1=True then 
response.Write("<img src='Images/on.gif'>")
else
response.Write("<img src='Images/off.gif'>")
end if
end function
'------------------------
'输出日期
function getDate(l1)
response.Write(year(l1)&"-"&month(l1)&"-"&day(l1))
end function
'------------------------
' 转换Radio的是否/开关状态
function switchRadio(l1,l2,l3)
if l3="1" then 
select case l1
  case "0"
  response.Write("是<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("否<input name="""&l2&""" type=""radio"" value=""2"">")
  case "1"
  response.Write("是<input name="""&l2&""" type=""radio"" value=""1"" checked=""checked"">")
  response.Write("否<input name="""&l2&""" type=""radio"" value=""2"">")
  case "2"
  response.Write("是<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("否<input name="""&l2&""" type=""radio"" value=""2"" checked=""checked"">")
end select 

else if l3="2" then 
select case l1
  case "0"
  response.Write("开<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("关<input name="""&l2&""" type=""radio"" value=""2"">")
  case "1"
  response.Write("开<input name="""&l2&""" type=""radio"" value=""1"" checked=""checked"">")
  response.Write("关<input name="""&l2&""" type=""radio"" value=""2"">")
  case "2"
  response.Write("开<input name="""&l2&""" type=""radio"" value=""1"">")
  response.Write("关<input name="""&l2&""" type=""radio"" value=""2"" checked=""checked"">")
end select 
end if 
end if
end function

'====================================================================
'转换checkbox，参数：是否，name
'====================================================================
Function SwitchCheckbox(I2,I3)
	if I2=true then
		I1 "<input name="""&I3&""" type=""checkbox"" value=""True"" checked=""checked"">"
	else
		I1 "<input name="""&I3&""" type=""checkbox"" value=""True"">"
	end if
End Function
'将IP转化成为十进制数
function cIp(sip)
    dim tip
    tip = split(sip,".")
	if cint(tip(0))<128 then
		cIp=cint(tip(0))*256*256*256+cint(tip(1))*256*256+cint(tip(2))*256+cint(tip(3))
	else
		cIp=cint(tip(0))*256*256*256+cint(tip(1))*256*256+cint(tip(2))*256+cint(tip(3))-4294967296
	end if
end function
'在左边加0
function addZero(I1,I2)
addZero=cstr(I1)
if len(I1)<I2 then'如果被加字段已经不符合要求
  for j=1 to I2-len(I1)
    addZero="0"&addZero
  next
end if
end function
'产生数组字符函数:长度，分隔内容，分隔符号；如：2，null，&；则：null&null
function creatString(I1,I2,I3)
for i=0 to I1
if creatString="" then
creatString=I2
else
creatString=creatString&I3&I2
end if
next
end function


'====================================================================
'数据库备份恢复，文件管理
'
'====================================================================
function bc(t,s)
 dim tl,sl,i
 bc=false
 sl=len(s)
 tl=len(t)
 if tl< sl then bc=true:exit function
 for i=1 to sl
  if mid(t,i,1)<>mid(s,i,1) then bc=true:exit function
 next
end function
'====================================================================
'数据库备份恢复，文件管理
'复制文件
'====================================================================
Function CopyFiles(TempSource,TempEnd) 
    Dim CopyFSO
    Set CopyFSO = Server.CreateObject("Scripting.FileSystemObject")
	IF CopyFSO.FileExists(TempEnd) then
       CopyFiles="目标备份文件 <b>" & TempEnd & "</b> 已存在，请先删除!"
       Set CopyFSO=Nothing
       Exit Function
    End If
    IF CopyFSO.FileExists(TempSource) Then
    Else
       CopyFiles="要复制的源数据库文件 <b>"&TempSource&"</b> 不存在!"
       Set CopyFSO=Nothing
       Exit Function
    End If
    CopyFSO.CopyFile TempSource,TempEnd
    CopyFiles="已经成功复制文件 <b>"&TempSource&"</b> 到 <b>"&TempEnd&"</b>"
    Set CopyFSO = Nothing
End Function
Function DeleteFiles(FilePath) '删除文件
	On Error Resume Next
    Dim FSO
    Set FSO=Server.CreateObject("Scripting.FileSystemObject")
    IF FSO.FileExists(FilePath) Then
		FSO.DeleteFile FilePath,True
		if err then
			Set FSO = Nothing
			DeleteFiles = false
			err.clear
			exit function
		end if
		DeleteFiles = True
    Else
		DeleteFiles = false
    End IF
    Set FSO = Nothing
End Function
'====================================================================
'数据库备份恢复，文件管理
'计算随机数
'====================================================================
function randomStr(intLength)