?<%@LANGUAGE="VBSCRIPT" CODEPAGE="65001"%>
<%
Option Explicit
Response.buffer=True
Response.Charset="utf-8"
IF InstalledDll=False Then Response.Redirect("install.asp")
'' 一 修改安全設置  
''------------------------------------------------
Const SafeCode=1       '安全設置:0-關閉,1-開啟
''------------------------------------------------  
'' 二 修改數據庫類型  
''------------------------------------------------
Const DataType={k_sqltype}       '數據類型:0-ACC,1-SQL
''------------------------------------------------  
Dim connstr,conn,Sday
   If DataType=0 then
   Sday="'d'"
      Dim Db
'' 三 修改Access數據庫 
''------------------------------------------
       Db="{k_sitepath}{k_accpath}"      'AC數據庫地址
''------------------------------------------
       connstr = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source="&Server.MapPath(Db)
   Elseif DataType=1 then
   Sday="day"
      Dim DateUserID,DateUserPsd,DateCatalog,DateSource
'' 四 修改SQL數據庫 
''------------------------------------------  
       DateUserID="{k_user}"            'SQL用戶名
       DateUserPsd="{k_pass}"       'SQL用戶密碼
       DateCatalog="{k_catalog}"          'SQL數據庫名
       DateSource="{k_source1}"    'SQL數據庫地址
''------------------------------------------ 
       connstr = "Provider = Sqloledb; User ID = "&DateUserID&"; Password = "&DateUserPsd&"; Initial Catalog = "&DateCatalog&"; Data Source = "&DateSource&"{k_port};"
   End if
'' 五 修改表名前綴 
''------------------------------------------  
Const predb="{k_predb}"

Sub Opendb()
	On Error Resume Next
	Set Conn = Server.CreateObject("ADODB.Connection")
	Conn.Open Connstr
	If Err Then
		Err.Clear
		Set Conn = Nothing
		IF DataType=-1 Then Response.Redirect("install.asp") Else Response.Write("數據庫鏈接錯誤")
		Response.End
	End If
End Sub

Sub Closedb()
  IF IsObject(conn) Then
    conn.close
    Set conn=Nothing
  End IF
End sub

IF SafeCode=1 Then
	Dim My_Sqlchr,My_Sqlchrs,My_ChrContent,My_i,ScriptType
	My_Sqlchr = "select*|and'|or'|insertinto|deletefrom|altertable|update|createtable|createview|dropview|createindex|dropindex|createprocedure|dropprocedure|createtrigger|droptrigger|createschema|dropschema|createdomain|alterdomain|dropdomain|);|select@|declare@|print@|char(|select"
	My_Sqlchrs = split(My_Sqlchr,"|")
	ScriptType=Trim(Request.QueryString("act"))
	IF Instr(ScriptType,"upfileF")<1 then
	If Request.Form<>"" Then
	   For Each My_ChrContent In Request.Form
		 For My_i=0 to Ubound(My_Sqlchrs)
		   Select Case My_Sqlchrs(My_i)
		   Case "select"'為避免select的多表關聯查詢
			  If Instr(LCase(replace(Request.Form(My_ChrContent)," ","")),"select")>0 and Instr(LCase(replace(Request.Form(My_ChrContent)," ","")),"from")>0 Then
				Call My_Title()
			  End IF	   
		   Case "update"'update作額外處理,因update..set..
			  If Instr(LCase(replace(Request.Form(My_ChrContent)," ","")),"update")>0 and Instr(LCase(replace(Request.Form(My_ChrContent)," ","")),"set")>0 Then
				Call My_Title()
			  End IF		  
		   Case Else
			  If Instr(LCase(replace(Request.Form(My_ChrContent)," ","")),My_Sqlchrs(My_i))>0 Then
				Call My_Title()
			  End IF
		   End Select
		 Next
	   Next	   
	End IF
	End IF
	If Request.QueryString<>"" Then
	   For Each My_ChrContent In Request.QueryString
		 For My_i=0 to Ubound(My_Sqlchrs)
		   Select Case My_Sqlchrs(My_i)
		   Case "select"'為避免select的多表關聯查詢
			  If Instr(LCase(replace(Request.QueryString(My_ChrContent)," ","")),"select")>0 and Instr(LCase(replace(Request.QueryString(My_ChrContent)," ","")),"from")>0 Then
				Call My_Title()
			  End IF	   
		   Case "update"'update作額外處理,因update..set..
			  If Instr(LCase(replace(Request.QueryString(My_ChrContent)," ","")),"update")>0 and Instr(LCase(replace(Request.QueryString(My_ChrContent)," ","")),"set")>0 Then
				Call My_Title()
			  End IF		  
		   Case Else
			  If Instr(LCase(replace(Request.QueryString(My_ChrContent)," ","")),My_Sqlchrs(My_i))>0 Then
				Call My_Title()
			  End IF
		   End Select
		 Next
	   Next	   
	End IF
End IF

Sub My_Title()
  response.Write "<script>alert('安全限制，如不需要請到conn.asp關閉！');history.go(-1)</script>"
  response.End()
End Sub

Function InstalledDll()
    Dim xTestObj
    On Error Resume Next
    InstalledDll = False
    Err = 0
    Set xTestObj = Server.CreateObject("KwAsk.Install")
    If Err = 0 Then InstalledDll = True
    If Err = -2147352567 Then InstalledDll = True
    Set xTestObj = Nothing
    Err = 0
    Exit Function
End Function
%>