connectdb_login.asp

一个oa软件 有的地方不太好使 但是因为是开放代码 有基础的人该该就应该可以了

<% Response.Buffer = True %>
<%
	Function ConnCheckKey(sFlag)
		Dim cCheckKey
		Dim sRet
		Dim sStr
		set cCheckKey=server.CreateObject("LKOAPubFun.LKOACheckKey")	
		sRet=cCheckKey.CheckKey (&HC44C,&HC8F8,"Active")
		set ccheckkey=nothing
		
		select case sRet
			Case "SUCCESS"
				sStr="OK"
				ConnCheckKey=3
			Case "NOFILE"
				sStr="系统文件丢失，不能使用"
				ConnCheckKey=1
			Case else
				sStr="没有注册,软件已使用" & sRet & "天,还能使用" & 30-sRet & "天"
				if sRet>30 or sRet<0 then
					ConnCheckKey=2
					sStr="OK"
				else
					ConnCheckKey=0
				end if
		end select		
		if sFlag = "ShowMsg" then
			if sStr<>"OK" and sStr<>"NOFILE"then			
				Response.Write "<SCRIPT LANGUAGE=VBscript>" & vbcrlf
				Response.Write "<!--" & vbcrlf
				Response.Write "msgbox """ & sStr  & """,,""请及时注册""" & vbcrlf
				Response.Write "//-->" & vbcrlf
				Response.Write "</SCRIPT>" & vbcrlf		
			end if
		end if
	end function	
	Dim CheckKeyStr 
	CheckKeyStr = ""
	CheckKeyStr = ConnCheckKey("No")
	if CheckKeyStr <> 0 then
		if CheckKeyStr =1 then
			Response.Write "<p><Font color=red size=2><B>系统文件丢失，不能使用，建议重新安装聚源数据办公助手。</B></font></p>"
		end if
		if CheckKeyStr =2 then
			'Response.Write "<p><Font color=red size=2><B>软件没有注册，请及时注册！</B></font></p>"
		end if
		if CheckKeyStr =3 then
			Response.Write "<p><Font color=red size=2><B>非法注册！请购买正版软件！</B></font></p>"
		end if
		'Response.End 
	end if
	
	Dim Conn
	on error resume next
	Set Conn=server.CreateObject ("ADODB.CONNECTION")	
	'Response.Write Application("ConnectString")
	conn.open Application("ConnectString")
	if Err<>0 then
	%>
		<script language="vbscript">
			msgbox "无法连接数据库！错误信息:" & chr(13)  & chr(13) & "<%=Err.Description%>",vbCritical,"错误"
		</script>
	<%	
		Response.End 
	end if
	on error goto 0
%>

<%
Function conStr(data)
   dim res1,res2,cons
	on error resume next
   res1=instr(1,data,"<",1)
   if  res1<>0 then
       cons = replace(data,"<","&lt")
   else
       cons=data    
   end  if 
   res2=instr(1,cons,">",1)
   if res2<>0 then
      cons = replace(cons,">","&gt")
   else
       cons=cons   
   end if         
   constr = Replace(cons,"'","''")
End Function 
 
 function constr1(data)
 constr1=replace(data,"'","''")
 end function
function constri(data)
    dim res1,res2,cons
 
   res1=instr(1,data,"<",1)
   if  res1<>0 then
       cons = replace(data,"<","&lt")
   else
       cons=data    
   end  if 
   res2=instr(1,cons,">",1)
   if res2<>0 then
      cons = replace(cons,">","&gt")
   else
       cons=cons   
   end if  
   constri=cons       
end function
function constrj(keybord)
   constrj = replace(data,">","&gt")
end function
%>