config.asp

这是一个物流网站的源代码

<% 
function Check_Power(sessiomname,tmppower)
if sessiomname=1 then
   power=tmppower
elseif  sessiomname=2 then
   if tmppower=1 or tmppower=2 then
      show_alert
   else
      power=tmppower
   end if
elseif  sessiomname=3 then  
  show_alert 
end if
Check_Power=power  
end function 

sub show_alert
   response.write "<script language='javascript'>" & VbCRlf
   response.write "alert('对不起，你无权执行此操作');" & VbCrlf
   response.write "history.go(-1);" & vbCrlf
   response.write "</script>" & VbCRLF
   response.end
end sub

function Get_TableName(id,table,Ziduan,indexid)
set rs_Dep=server.CreateObject("adodb.recordset")
rs_Dep.open "select "&Ziduan&" from "&table&" where "&indexid&"="&id,conn,1,1
if not rs_Dep.eof then
   Get_TableName=rs_Dep(Ziduan)
else
   exit function
end if
rs_Dep.close
set rs_Dep=nothing
end function


function show_power(num)
if num=1 then
   theman="超级管理员"
elseif num=2 then
   theman="高级管理员"
elseif num=3 then
   theman="管理员"
end if 
show_power=theman
end function
  
function check_alert(a,b)
   response.write "<script language='javascript'>" & VbCRlf
   response.write "alert('"&a&"');" & VbCrlf
   response.write "location.href='"&b&"';" & vbCrlf
   response.write "</script>" & VbCRLF
   response.end
end function

function Check_Language(Language)
if Language="C" then
   theLanguage="中文版"
elseif Language="E" then
   theLanguage="英文版"
elseif Language="B" then
   theLanguage="繁体中文版"
end if 
Check_Language=theLanguage
end function

function Get_Table(table_prefix,Language)
if Language="C" then
   table=table_prefix&"C"
elseif Language="E" then
   table=table_prefix&"E"
elseif Language="B" then
   table=table_prefix&"B" 
else
   table="None"
end if 
Get_Table=table
end function      

function Get_Sort_all(prefix,table,id)
set rs_sort=server.CreateObject("adodb.recordset")
rs_sort.open "select "&prefix&"_Name from "&table&" where "&prefix&"_Id="&id,conn,1,1
if not rs_sort.eof then
   Get_Sort_all=rs_sort(prefix&"_Name")
else
   exit function
end if
rs_sort.close
set rs_sort=nothing
end function 
'
'function Get_Department(id)
'set rs_Dep=server.CreateObject("adodb.recordset")
'rs_Dep.open "select * from Department where d_Id="&id,conn,1,1
'if not rs_Dep.eof then
'   Get_Department=rs_Dep("D_Name")
'else
'   exit function
'end if
''rs_Dep.close
'set rs_Dep=nothing
'end function 

sub clear_quote
	'response.Write("onKeyup="&chr(34)&"this.value=this.value.replace(/(\x22)+/gi,'').replace(/(\x27)+/gi,'')"&chr(34))
	response.Write("onKeyup=''")
end sub

function chhtml(str)
	dim objexp
	set objexp=new regexp
	objexp.IgnoreCase=true
	objexp.Global=true
	objexp.Pattern="<[^>]*>"
	chhtml=objexp.replace(str,"")
	set objexp=nothing
end function

'****************************************************
'function：SendMail_Jmail
'Jmail
'parmeter：ServerAddress  ----
'        AddRecipient  ----from mail address
'        Subject       ----title
'        Body          ----content
'        Sender        ----mail to address
'****************************************************
function SendMail_Jmail(MailServerAddress,AddRecipient,Subject,Body,Sender,MailFrom)
	on error resume next
	Dim JMail
	Set JMail=Server.CreateObject("JMail.SMTPMail")
	if err then
		SendMail_Jmail= "<br><li>No JMail object</li>"
		err.clear
		exit function
	end if
	JMail.Logging=True
	JMail.Charset="gb2312"
	JMail.ContentType = "text/html"
	JMail.ServerAddress=MailServerAddress
	JMail.AddRecipient=AddRecipient
	JMail.Subject=Subject
	JMail.Body=Body
	JMail.Sender=Sender
	JMail.From = MailFrom
	JMail.Priority=1
	JMail.Execute 
	Set JMail=nothing 
	if err then 
		SendMail_Jmail=err.description
		err.clear
	else
		SendMail_Jmail="OK"
	end if
end function

function formatStr(str)
if isnull(str) then
	exit function
end if
	str=trim(str)
	str=replace(str,"<","&lt;")
	str=replace(str,">","&gt;")
	str=replace(str,"'","‘")
	str=Replace(str,"""","&quot;")	
	str=replace(str,"and","")
	str=replace(str,vbCrLf&vbCrlf,"<br><br>")
	str=replace(str,vbCrLf,"<br>")
	str=Replace(str,"&#","&amp;#")
	str=replace(str,"javascript","/javascript") 
	str=replace(str,"cookie","/cookie") 
	str=replace(str,"document","/document") 
	formatStr=str
end function 

Public function unformatStr(str)
if isnull(str) then
	UnformatStr=""
	exit function
end if
	str=trim(str)
	str=replace(str,"&lt;","<")
	str=replace(str,"&gt;",">")
	str=replace(str,"‘","'")
	str=Replace(str,"&quot;","""")	
	'str=replace(str,"and","")
	str=replace(str,"<br><br>",vbCrLf&vbCrlf)
	str=replace(str,"<br>",vbCrLf)
	str=replace(str,"<br>",chr(13))
	str=Replace(str,"&amp;#","&#")
	'str=replace(str,"javascript","/javascript") 
	'str=replace(str,"cookie","/cookie") 
	'str=replace(str,"document","/document") 
	UnformatStr=str
end function

function Show_Member(num)
if num=1 then
   theman="普通会员"
elseif num=2 then
   theman="商务会员"
elseif num=3 then
   theman="VIP会员"
end if 
Show_Member=theman
end function
  
dim topcode 
sub cntop() 
topcode="现在时间是：" 
topcode=topcode&now() 
end sub 

dim leftcode 
sub cnleft() 
for i = 1 to 5 
leftcode=leftcode&"<p>cnbruce.com" 
next 
end sub 

dim rightcode 
sub cnright() 
for i = 1 to 9 
rightcode=rightcode&"<hr color="&i&i&i&i&i&i&">" 
next 
end sub 

''生成文件名的函数
function makefilename(fname)
fname = fname
fname = replace(fname,"-","")
fname = replace(fname," ","") 
fname = replace(fname,":","")
fname = replace(fname,"PM","")
fname = replace(fname,"AM","")
fname = replace(fname,"上午","")
fname = replace(fname,"下午","")
makefilename=fname & ".shtml"
end function 

''保持数据格式不变的函数
function HTMLEncode(fString)
fString = replace(fString, ">", ">")
fString = replace(fString, "<", "<")
fString = Replace(fString, CHR(32), " ")
fString = Replace(fString, CHR(13), "")
fString = Replace(fString, CHR(10) & CHR(10), "<br>")
fString = Replace(fString, CHR(10), "<br>")
HTMLEncode = fString
end function
sub add(table,which,cont)
	sql="insert into "&table&"("&which&") values("&cont&")"
	'response.write sql
	'response.end
	conn.execute sql,0,1
end sub

sub modi(table,cont,req)
	sql="update "&table&" set "&cont&" "&req
	'response.write sql
	'response.end
	conn.execute sql,0,1
end sub

sub del(table,req)
	sql="delete * from "&table&" "&req
	'response.write sql
	'response.end
	conn.execute sql,0,1
end sub

sub view(which,table,req)
	sql="select "&which&" from "&table&" "&req
	'response.write sql
	'response.end
	set rs=Server.CreateObject("ADODB.Recordset")
	rs.open sql,conn,1,2
end sub

'**************************************************
'函数名：JoinChar
'作  用：向地址中加入 ? 或 &
'参  数：strUrl  ----网址
'返回值：加了 ? 或 & 的网址
'**************************************************
function JoinChar(strUrl)
	if strUrl="" then
		JoinChar=""
		exit function
	end if
	if InStr(strUrl,"?")<len(strUrl) then 
		if InStr(strUrl,"?")>1 then
			if InStr(strUrl,"&")<len(strUrl) then 
				JoinChar=strUrl & "&"
			else
				JoinChar=strUrl
			end if
		else
			JoinChar=strUrl & "?"
		end if
	else
		JoinChar=strUrl
	end if
end function

'**************************************************
'函数名：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

'------------------检查某一目录是否存在-------------------
Function CheckDir(FolderPath)
	dim fso
	folderpath=Server.MapPath(".")&"\"&folderpath
	Set fso1 = Server.CreateObject("Scripting.FileSystemObject")
	If fso.FolderExists(FolderPath) then
	'存在
		CheckDir = True
	Else
	'不存在
		CheckDir = False
	End if
	Set fso = nothing
End Function

'-------------根据指定名称生成目录---------
Function MakeNewsDir(foldername)
	dim fso,f
	Set fso = Server.CreateObject("Scripting.FileSystemObject")
    Set f = fso.CreateFolder(foldername)
    MakeNewsDir = True
	Set fso = nothing
End Function
Public Function Objects(id,simplify)
	dim InstalledObjects(6)
	InstalledObjects(0) = "Scripting.FileSystemObject"		'Scripting.FileSystemObject
	InstalledObjects(1) = "JMail.SmtpMail"
	InstalledObjects(2) = "CDONTS.NewMail"
	InstalledObjects(3) = "Persits.MailSender"
	InstalledObjects(4) = "Persits.Jpeg"
	InstalledObjects(5) = "wsImage"
	if simplify = 0 then
		If IsObjInstalled(InstalledObjects(id)) then 
			Objects="<font color=red><b>√</b>服务器支持！</font>" 
		else 
			Objects="<b>×</b>服务器不支持！"
		end if 
	elseif simplify = 1 then
		If IsObjInstalled(InstalledObjects(id)) then 
			Objects="<font color=red><b>√</b></font>"
		else 
			Objects="<b>×</b>" 
		end if
	end if
End Function
%>