<%
'=========================================================
'　　　　　　　　　　　飞　扬　网　络
' Copyright (C) 2003-2005 feiyang.Com. All Rights Reserved.
' Web: http://www.feiyang.com
' QQ: 99686532        E-mail: bgh_edu@126.com
'=========================================================
%>
<%'以下为公用函数
Function goback(str,alertstr) '为空时后退
 if str="" then 
  response.write "<script>" 
  response.write "alert('"&alertstr&"');" 
  response.write "history.go(-1)" 
  response.write "</script>" 
  response.end 
 else
  goback=str
 end if
End Function

Function alertback(alertstr,backnum) 
  response.write "<script>" 
  response.write "alert('"&alertstr&"');" 
  response.write "history.go(-"&backnum&")" 
  response.write "</script>" 
  response.end 
End Function

Function AlertUrl(alertstr,url) 
  response.write "<script>" 
  response.write "alert('"&alertstr&"');" 
  response.write "location.href='"&url&"';" 
  response.write "</script>" 
  response.end 
End Function

Function GotoUrl(url) 
  response.write "<script>" 
  response.write "location.href='"&url&"';" 
  response.write "</script>" 
  response.end 
End Function

Function checkuser(user_name)
SQL ="select a.* from (SELECT  user_name  from AdminUser union SELECT  user_name  from userCYHY union SELECT  regname as user_name  from AdminUser_Tracq) a where a.User_name='"&user_name&"'"
set rscheckuser=conn_bestskydb.execute(SQL)
if not rscheckuser.eof then
   response.write "<script language='javascript'>" & VbCRlf
   response.write "alert('这个用户名已经存在!');" & VbCrlf
   response.write "history.go(-1);" & vbCrlf
   response.write "</script>" & VbCRLF
   response.end
end if
rscheckuser.close
End Function

function checkinput_letter(inputstr) '检查用户名输入的合法性
for i = 1 to Len(inputstr)
 c = Lcase(Mid(inputstr, i, 1)) '------------分割成每个字母或数字------------------
  if InStr("abcdefghijklmnopqrstuvwxyz_", c) <= 0 and not IsNumeric(c) then
  response.write "<script language='javascript'>" & VbCRlf
  response.write "alert('请不要在用户名中输入中文,空格或其它非法字符,合法字符为大小写字母,下划线,数字!');" & VbCrlf
  response.write "history.go(-1);" & vbCrlf
  response.write "</script>" & VbCRLF
  response.end
  end if
next
 checkinput_letter=inputstr
end function

function checkinput_blank(inputstr) '检查密码输入的合法性
for i = 1 to Len(inputstr)
 c = Lcase(Mid(inputstr, i, 1)) '------------分割成每个字母或数字------------------
  if InStr(" ", c) > 0 or InStr("　", c) > 0 then
  response.write "<script language='javascript'>" & VbCRlf
  response.write "alert('请不要输入空格!');" & VbCrlf
  response.write "history.go(-1);" & vbCrlf
  response.write "</script>" & VbCRLF
  response.end
  end if
next
 checkinput_blank=inputstr
end function

Function chkstr(inputstr) '过滤单引号
if instr(inputstr,"'")<>0 then 
 chkstr=replace(inputstr,"'","")
else
 chkstr=inputstr
end if
End Function

Function GetFieldValues(TalbeName,FieldNmae,Fieldvalues,FieldType,GetFieldName)  '通用,通过一个表的字段，得到表中某个字段的值
 if FieldType=1 then
	sql="select "&GetFieldName&" from "& TalbeName &" where "& FieldNmae &"="& Fieldvalues
 elseif FieldType=2 then
	sql="select "&GetFieldName&" from "& TalbeName &" where "& FieldNmae &"='"& Fieldvalues &"'"
 end if
 set FieldValues=server.createobject("adodb.recordset")
 FieldValues.open sql,conn,1,1
	if Not FieldValues.eof then
	 GetFieldValues=FieldValues(0)
	end if
	FieldValues.close
End function

function GetUpFieldValues(FieldValues,FieldType,UpTableName,UpFieldName,UpGetFieldName) '通过一个值查找上级表中对应的一个字段的值
 if FieldType=1 then
  sql="select "&UpGetFieldName&" from "&UpTableName&" where "&UpFieldName&"="&FieldValues
 elseif FieldType=2 then
  sql="select "&UpGetFieldName&" from "&UpTableName&" where "&UpFieldName&"='"&FieldValues&"'"
 end if
 set UpFieldValues=server.createobject("adodb.recordset")
 UpFieldValues.open sql,conn,1,1
if Not UpFieldValues.eof then
 GetUpFieldValues=UpFieldValues(0)
end if
UpFieldValues.close
End function

Function ComFirmUserDo(TableName,FieldNmae,Fieldvalues,FieldType,CompareField,Comparevalues)
IF FieldType=1 Then
 Sql="Select "&CompareField&" From "&TableName&" where "&FieldNmae&"="&Fieldvalues
ElseIF FieldType=2 Then
 Sql="Select "&CompareField&" From "&TableName&" where "&FieldNmae&"='"&Fieldvalues&"'"
End IF
 set Rs_ComFirmUserDo=conn.execute(sql)
 if Rs(0)<>Comparevalues then
  response.end
 end if
 Rs_ComFirmUserDo.Close
End Function


function FSOFileRead(filename)
Dim objFSO,objCountFile,FiletempData
Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
Set objCountFile = objFSO.OpenTextFile(Server.MapPath(filename),1,True)
FSOFileRead = objCountFile.ReadAll
objCountFile.Close
Set objCountFile=Nothing
Set objFSO = Nothing
End Function


Function getCategories(aspfile)
on error resume next
Dim oXMLHTTP ' As Object
Dim oCategories ' As Object
Dim BodyText
Dim Pos,Pos1
Set oXMLHTTP = CreateObject("Microsoft.XMLHTTP")
oXMLHTTP.open "GET",aspfile,False  '这个地方换成你自己的地址
oXMLHTTP.send 
 BodyText=oXMLHTTP.responsebody
 BodyText=BytesToBstr(BodyText,"gb2312")
 getCategories=BodyText
Set oXMLHTTP = Nothing 
if err.number<>0 then
response.write "出错了，错误描述："&err.description & "<br>错误来源"& err.source
response.End()
end if
End Function 

Function BytesToBstr(body,Cset)
        dim objstream
        set objstream = Server.CreateObject("adodb.stream")
        objstream.Type = 1
        objstream.Mode =3
        objstream.Open
        objstream.Write body
        objstream.Position = 0
        objstream.Type = 2
        objstream.Charset = Cset
        BytesToBstr = objstream.ReadText 
        objstream.Close
        set objstream = nothing
End Function
Public Function HTMLEncode(fString)
  If Not IsNull(fString) Then
   fString = replace(fString, ">", "&gt;")
   fString = replace(fString, "<", "&lt;")
   fString = Replace(fString, CHR(32), " ")  '&nbsp;
   fString = Replace(fString, CHR(9), " ")   '&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 If
 End Function

%>
