<%
Function DateToFilename(dtDateTime)
    DateToFilename = year(dtDateTime) & doublenum(Month(dtDateTime)) & doublenum(Day(dtDateTime)) & doublenum(Hour(dtDateTime)) & doublenum(Minute(dtDateTime)) & doublenum(Second(dtDateTime))  &".htm"
End function
' ============================================
' 过滤跨站脚本和HTML标签
' 如果输入字符串包含脚本，返回前一页重新输入
' ============================================

Function NoCSSHackInput(Str) 
	Dim regEx
	Set regEx = New RegExp
	regEx.IgnoreCase = True
	regEx.Pattern = "<|>|(script)|on(mouseover|mouseon|mouseout|click|dblclick|blur|focus|change)|url|eval|\t"
	If regEx.Test(LCase(Str)) Then
		Response.Write "<script>alert('你的输入含有非法字符(<,>,tab,script等)，请检查后再提交！');history.back();</script>"
		Response.End
	End If
	Set regEx = Nothing
	NoCSSHackInput = Str
End Function
' ============================================ 
' 传入：字符串，取字符串长度
' 返回：取得的字符串
' 作用：取指定长度的字符串，一个汉字为两个字符
' ============================================

Function GotTopic(Str,StrLen)
	Dim l,t,c, i,LableStr,regEx,Match,Matches
	If StrLen=0 Or IsNull(Str) Or Str="" then
		GotTopic=""
		exit function
	End If
	Str=Replace(Replace(Replace(Replace(Str,"&nbsp;"," "),"&quot;",Chr(34)),"&gt;",">"),"&lt;","<")
	l=len(str)
	t=0
	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
			GotTopic=left(str,i)
			exit for
		else
			GotTopic=str
		end if
	next
	GotTopic = Replace(Replace(Replace(Replace(GotTopic," ","&nbsp;"),Chr(34),"&quot;"),">","&gt;"),"<","&lt;")' & LableStr
End Function

Function strLen(str)
ON ERROR RESUME NEXT
dim WINNT_CHINESE
WINNT_CHINESE    = (len("中国")=2)
if WINNT_CHINESE then
        dim l,t,c
        dim i
        l=len(str)
        t=l
        for i=1 to l
         c=asc(mid(str,i,1))
            if c<0 then c=c+65536
            if c>255 then
                t=t+1
            end if
        next
        strLen=t
    else 
        strLen=len(str)
    end if
    if err.number<>0 then err.clear
End Function



Function doublenum(fNum)
    if fNum > 9 then 
        doublenum = fNum 
    else 
        doublenum = "0"&  fNum
    end if
End function

Function LoseHtml(str)
 Dim regEx
        '创建正则对象
        Set regEx = New RegExp
        regEx.IgnoreCase = True
        regEx.Global = True
        regEx.MultiLine = True

        regEx.Pattern = "<.+?>"
        LoseHtml = regEx.Replace(str,"")
        Set regEx = Nothing
End Function

Function GetLength(strChinese1)
  Dim strWord, ascWord, lenTotal
  strChinese1 = Trim(strChinese1)

  If strChinese1 = "" or Vartype(strChinese1) = vbNull then
    GetLength = 0
    Exit Function
  End If

  lenTotal = 0 
  For GetLengthi=1 to Len(strChinese1)
    strWord = Mid(strChinese1, GetLengthi, 1)
    ascWord = Asc(strWord)
    If ascWord < 0 or ascWord > 127 then
      lenTotal = lenTotal + 2
    Elseif ascWord = 63 And strWord <> "?" then
      lenTotal = lenTotal + 2
    Elseif ascWord = 44 And strWord <> "," then
      lenTotal = lenTotal + 2
    Elseif ascWord = 33 And strWord <> "!" then
      lenTotal = lenTotal + 2
    Else
      lenTotal = lenTotal + 1
    End If
  Next

  GetLength = lenTotal
End Function

Function GetWord(strChinese2, lenMaxWord, strTail)
  strChinese2 = Trim(strChinese2)
  lenMaxWord  = CCur(lenMaxWord)

  If strChinese2 = "" or Vartype(strChinese2) = vbNull or CLng(lenMaxWord) <= 0 then
    GetWord = ""
    Exit Function
  End If

  Dim OverFlow, strTest
  OverFlow = False
  strTest = " "

  If GetLength(strChinese2) > lenMaxWord then OverFlow = True

  If OverFlow = True then
    Dim lenWord, RetString, strWord, ascWord
    lenWord = 0
    RetString = ""
    For GetWordi=1 to Len(strChinese2)
      strWord = Mid(strChinese2, GetWordi, 1)
      ascWord = Asc(strWord)
      If ascWord < 0 or ascWord > 127 then
        lenWord = lenWord + 2
      Elseif ascWord = 63 And strWord <> "?" then
        lenWord = lenWord + 2
      Elseif ascWord = 44 And strWord <> "," then
        lenWord = lenWord + 2
      Elseif ascWord = 33 And strWord <> "!" then
        lenWord = lenWord + 2
      Else
        lenWord = lenWord + 1
      End If
      If lenWord <= (lenMaxWord - Len(strTail)) then
        RetString = RetString + strWord
      Else
        GetWord = RetString + strTail
        Exit For
      End If
    Next
  Else
    GetWord = strChinese2
  End If
End Function

'######################################################
'显示日期
sub showdate()

	response.write "<input type='text' name='n' size='4' class=smallinput>"
	response.write "<b><font color='#003366'>年"
	response.write "<select name='y' class=smallselsect>"
		i=1
		do while i<13 
	response.write "<option>"&i&"</option>"
		i=i+1
		loop
	response.write "</select>"
	response.write "月"
	response.write "<select name='r' class=smallselsect>"
		i=1
		do while i<32
	response.write "<option>"&i&"</option>"
		i=i+1
		loop
	response.write "</select>"
	response.write "日</b></font>"
	
end sub
'############################################################

'##############################################################
'获取字符的ASC码
function getpychar(char)

tmp=65536+asc(char)
if(tmp>=45217 and tmp<=45252) then
getpychar= "A"
elseif(tmp>=45253 and tmp<=45760) then
 getpychar= "B"
elseif(tmp>=45761 and tmp<=46317) then 
getpychar= "C"
elseif(tmp>=46318 and tmp<=46825) then 
getpychar= "D"
elseif(tmp>=46826 and tmp<=47009) then 
getpychar= "E"
elseif(tmp>=47010 and tmp<=47296) then 
getpychar= "F"
elseif(tmp>=47297 and tmp<=47613) then 
getpychar= "G"
elseif(tmp>=47614 and tmp<=48118) then
 getpychar= "H"
elseif(tmp>=48119 and tmp<=49061) then 
getpychar= "J"
elseif(tmp>=49062 and tmp<=49323) then 
getpychar= "K"
elseif(tmp>=49324 and tmp<=49895) then
 getpychar= "L"
elseif(tmp>=49896 and tmp<=50370) then 
getpychar= "M"
elseif(tmp>=50371 and tmp<=50613) then 
getpychar= "N"
elseif(tmp>=50614 and tmp<=50621) then 
getpychar= "O"
elseif(tmp>=50622 and tmp<=50905) then 
getpychar= "P"
elseif(tmp>=50906 and tmp<=51386) then 
getpychar= "Q"
elseif(tmp>=51387 and tmp<=51445) then 
getpychar= "R"
elseif(tmp>=51446 and tmp<=52217) then 
getpychar= "S"
elseif(tmp>=52218 and tmp<=52697) then 
getpychar= "T"
elseif(tmp>=52698 and tmp<=52979) then 
getpychar= "W"
elseif(tmp>=52980 and tmp<=53688) then 
getpychar= "X"
elseif(tmp>=53689 and tmp<=54480) then 
getpychar= "Y"
elseif(tmp>=54481 and tmp<=62289) then 
getpychar= "Z"
else
getpychar=char
end if
end function
'#######################################################

'########################################################
'获取汉字首字母

function getpy(str)
for i=1 to len(str)
getpy=getpy&getpychar(mid(str,i,1))
next
end function
'#####################################################

'#####################################################
'获取当月的天数
Function GetDaysInMonth(iMonth, iYear)
	Select Case iMonth
		Case 1, 3, 5, 7, 8, 10, 12
			GetDaysInMonth = 31
		Case 4, 6, 9, 11
			GetDaysInMonth = 30
		Case 2
			If IsDate("February 29, " & iYear) Then
				GetDaysInMonth = 29
			Else 
				GetDaysInMonth = 28
			End If
	End Select
End Function
'######################################################

'#######################################################
'获取当月的第一天是星期几
Function GetWeekdayMonthStartsOn(iMonth, iYear)
	GetWeekdayMonthStartsOn = WeekDay(CDate(iMonth & "/1/" & iYear))
End Function
'#####################################################

'############################################
'获取前一个月的年月

Function SubtractOneMonth(dDate)
Dim iDay, iMonth, iYear	
	iDay = Day(dDate)
	iMonth = Month(dDate)
	iYear = Year(dDate)

	If iMonth = 1 Then
		iMonth = 12
		iYear = iYear - 1
	Else
		iMonth = iMonth - 1
	End If
	
	If iDay > GetDaysInMonth(iMonth, iYear) Then iDay = GetDaysInMonth(iMonth, iYear)

	SubtractOneMonth = CDate(iMonth & "-" & iDay & "-" & iYear)
End Function
'#########################################################3

'##########################################################
'获取后一个月的年月

Function AddOneMonth(dDate)
Dim iDay, iMonth, iYear	
	iDay = Day(dDate)
	iMonth = Month(dDate)
	iYear = Year(dDate)

	If iMonth = 12 Then
		iMonth = 1
		iYear = iYear + 1
	Else
		iMonth = iMonth + 1
	End If
	
	If iDay > GetDaysInMonth(iMonth, iYear) Then iDay = GetDaysInMonth(iMonth, iYear)

	AddOneMonth = CDate(iMonth & "-" & iDay & "-" & iYear)
End Function
'###########################################################
'################################################3
'过滤字段中间的所有空格
function filt_space(str)
dim t,z
t=trim(str)
dim count
count=len(t)
for i=1 to count
	z=z+Mid(t,i,1)
	z=trim(z)
    
next
filt_space=z
end function
'******************************************
'根据文件路径
'获取文件名  
'方法:找到最后一个'\' 
function getFileName( byVal thePath )
     getFileName = RIGHT( thePath, len( thePath ) - instrREV( thePath, "/" ) )
end function 
'************************************************

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

Function checkImageFormat(checkdata)
' A 图形格式
' B 图形高度
' C 图形宽度
' D 图形颜色
flag=0
' 0 非 jpg/gif/png 类型图片
' 1 jpg/gif/png 类型图片

'-- jpg 格式 --

If flag=0 then
  tempstr=leftB(checkdata,10)
  tstr=chrb(255)&chrb(216)&chrb(255)&chrb(224)&chrb(0)&chrb(16)&chrb(74)&chrb(70)&chrb(73)&chrb(70)

  If strcomp(tempstr,tstr,0)=0 then
    msgstr01="jpg"
    lngSize = len(checkdata)
    flgFound = 0

    strTarget = chrb(255) & chrb(216) & chrb(255)
    flgFound = instrb(checkdata, strTarget)

    lngPos = flgFound + 2
    ExitLoop = false

    Do while ExitLoop = False and lngPos < lngSize

      Do while ascb(midb(checkdata, lngPos, 1)) = 255 and lngPos < lngSize
        lngPos = lngPos + 1
      Loop

      If ascb(midb(checkdata, lngPos, 1)) < 192 or ascb(midb(checkdata, lngPos, 1)) > 195 then
        lngMarkerSize = lngConvert2(midb(checkdata, lngPos + 1, 2))
        lngPos = lngPos + lngMarkerSize + 1
      Else
        ExitLoop = True
      End If

    Loop

    i_Height = lngConvert2(midb(checkdata, lngPos +4, 2))
    i_Width  = lngConvert2(midb(checkdata, lngPos +6, 2))
    i_Depth  = 2 ^ (ascb(midb(checkdata, lngPos + 8, 1)) * 8)
   
    msgstr02=","& i_height & "," & i_width
    flag=2
  Else
    flag=0
  End if
End if

'-- gif 格式 --

If flag=0 then
  tempstr=leftB(checkdata,6)
  tstr=chrb(71)&chrb(73)&chrb(70)&chrb(56)&chrb(57)&chrb(97)
  tstr2=chrb(71)&chrb(73)&chrb(70)&chrb(56)&chrb(55)&chrb(97)
  If strcomp(tempstr,tstr,0)=0 or strcomp(tempstr,tstr2)=0 then
    msgstr03="gif"

    i_width=lngConvert(midb(checkdata,7,2))
    i_height=lngConvert(midb(checkdata,9,2))
    i_Depth = 2 ^ ((ascb(midb(checkdata, 11, 1)) and 7) + 1)
    msgstr04=","& i_height & ","& i_width 

    flag=2
  Else
    flag=0
  End If
End If

'-- png 格式 --

If flag=0 then
  tempstr=leftB(checkdata,4)
  tstr=chrb(137)&chrb(80)&chrb(78)&chrb(71)
  If strcomp(tempstr,tstr,0)=0 then
    msgstr05="png"

    i_Width  = lngConvert2(midb(checkdata, 19, 2))
    i_Height = lngConvert2(midb(checkdata, 23, 2))
    i_Depth  = lngConvert(midb(checkdata, 25, 2))

    Select case ascb(right(i_Depth,1))
        case 0
          i_Depth   = 2 ^ (asc(left(i_Depth, 1)))
          gfxSpex = True
        case 2
          i_Depth   = 2 ^ (asc(left(i_Depth, 1)) * 3)
          gfxSpex = True
        case 3
          i_Depth   = 2 ^ (asc(left(i_Depth, 1)))
          gfxSpex = True
        case 4
          i_Depth   = 2 ^ (asc(left(i_Depth, 1)) * 2)
          gfxSpex = True
        case 6
          i_Depth   = 2 ^ (asc(left(i_Depth, 1)) * 4)
          gfxSpex = True
        case else
          i_Depth   = -1
    End Select
    msgstr06=","& i_height & ","& i_width

    flag=2
  Else 
    flag=0
  End If
End If
If flag=0 then
  msgstr07="no image"
End If
  msgstr=msgstr01 & msgstr02 & msgstr03 & msgstr04 & msgstr05 & msgstr06 & msgstr07
  checkImageFormat=msgstr
End Function

Function lngConvert2(strTemp)
  str1=leftB(strTemp,1)
  str2=rightb(strTemp,1)
  lngConvert2 = clng(ascb(str2) + ((ascb(str1) * 256)))
End Function

Function lngConvert(strTemp)
  str1=leftB(strTemp,1)
  str2=rightb(strTemp,1)
  len1=ascb(str1)
  len2=ascb(str2)
  lngConvert = clng(ascb(str1) + ascb(str2) * 256)
End Function
%>
