<%&NBSP;
' on Error Resume next
Class connex&NBSP;
Public ConnEx &NBSP;
public DBpath '---------database path Public DBtype '---------database type 1 (Access) 2 (SQL Server) 3 (expandable) &NBSP;
Public Connmethod '--------connection mode (DSN, non-DSN) &NBSP;
Public User&NBSP;
public pass&NBSP;
Sub class_initialize< Span class= "Apple-converted-space" >&NBSP;
End Sub Sub Init ()
ConnStr = "Driver={microsoft Access Driver (*.mdb)};d bq=" &server.mappath ("Date.mdb")
Set ConnEx = Server.CreateObject ("ADODB. CONNECTION ")
Connex.open ConnStr
Catcherror ("Class_Terminate")
End Sub Sub catcherror (STR)
If ERR Then
Err.Clear
Class_Terminate ()
Response.Write ("Catch to Error, end of program!" at &Str&)
Response.End ()
End If
End Sub ' ******************************************
' ****************************************** Function hasrecordbysql (SQL) &NBSP;
call Checksql (sql, "R") &NBSP;
Dim rs,hasr&NBSP;
Set Rs = Connex.execute ( SQL) &NBSP;
Catcherror ("Hasreordsql") &NBSP;
If not (rs.eof Or rs.bof) then Hasr = False&NBSP;
Else Hasr = True&NBSP;
End if Rs.close&NBSP;
Set Rs = Nothing
Hasrecordbysql = Hasr
End Function ' ***************************************
' * Find out if the record exists by ID
’*************************************** Function Hasrecordbyid (strTableName, IntID)
' CheckValue (IntID, 1)
Dim RS,HASR
Sql = "SELECT top 1 * from" &StrTableName& "Where Id =" &intid< Span class= "Apple-converted-space" >&NBSP;
Call Checksql (SQL, "R")
Set Rs = Connex.execute (SQL) &NBSP;
Catcherror ("Hasrecordbyid") &NBSP;
If not (rs.eof Or rs.bof) then
Hasr = False&NBSP;
Else&NBSP;
HASR = True&NBSP;
End if&NBSP;
Rs.close&NBSP;
Set Rs = Nothing
Hasrecordbyid = Hasr&NBSP;
End Function ' **********************************************
' * Get a recordset from an SQL statement
' **********************************************
Function getrsbysql (SQL)
Call Checksql (SQL, "R")
Dim Rs
Set Rs = Server.CreateObject ("Adodb.recordset")
Rs.Open sql,connex,1,1
Set Getrsbysql = Rs
End Function ’*********************************************
' * Get the value of a field
’*********************************************
Function Getvaluebysql (SQL)
Call Checksql (SQL, "R")
Dim Rs,returnvalue
Set Rs = Connex.execute (SQL)
Catcherror ("Getvaluebysql")
If not (rs.eof Or rs.bof) Then
returnvalue = Rs (0)
Else
returnvalue = "no Record"
End If
Rs.close
Set Rs = Nothing
Getvaluebysql = ReturnValue
End Function ' ==================================================update,insert=================================== ' *********************************************
' * Use SQL to modify data
' *********************************************
Function updatebysql (SQL)
Call Checksql (SQL, "w")
Connex.execute (SQL)
Catcherror ("Updatebysql")
Updatebysql = True
End Function ' ********************************************
' * Inserting data using SQL statements
' ********************************************
Function insertbysql (SQL)
Call Checksql (SQL, "w")
Connex.execute (SQL)
Catcherror ("Insertbysql")
Insertbysql = True
End Function ' ======================================================delete======================================== ' ********************************************
' ******************************************** &NBSP;
Function deletebysql (SQL) Call Checksql (sql, "D") &NBSP;
Connex.execute (sql) &NBSP;
Catcherror (" Deletebysql ") &NBSP;
Deletebysql = True&NBSP;
End Function ' ********************************************
' ********************************************< Span class= "Apple-converted-space" >&NBSP;
Sub checksql (SQL, Flag)
Dim strsql,sincounts,doucounts,i
strSQL = Lcase (SQL) &NBSP;
sincounts = 0
DouCounts = 0&NBSP;
For i = 1 to Len (strSQL) &NBSP;
If Mid (strsql,i,1) = "'" Then Sincounts = sincounts + 1&NBSP;
If Mid (strsql,i,1) = "" "T Hen douconnts = doucounts + 1&NBSP;
Next If (sincounts mod 2) <> 0 or (doucounts mod 2) <> 0 Or Instr (strSQL, ";") > 0 Then
Call Class_Terminate ()
Response.Write ("SQL syntax error!")
Response.End ()
End If
Select Case Flag
Case "R", "R":
If Instr (strSQL, "delete") > 0 or Instr (strSQL, "Update") or Instr (strSQL, "Drop") > 0 Or Instr (strSQL, "Insert") > 0 Then
Class_Terminate ()
Response.Write ("Insufficient permissions, no permission to perform write operations")&NBSP;
Response.End () &NBSP;
End If&NBSP;
Case "W", "W": &NBSP;
If Instr (strSQL, "delete") > 0 or Instr (strSQL, "Drop") > 0 or Instr (strSQL, "select") > 0 then&NBSP;
Class_Terminate () &NBSP;
Response.Write (" Insufficient permissions, No permission to perform delete operation ") &NBSP;
Response.End ()
End if&NBSP;
Case "D", "D": Case Else:&NBSP;
Response.Write ("function Checksql flag Error!") &NBSP;
End Select&NBSP;
End Sub Sub Class_Terminate
If not IsEmpty (friendconn) Then
Friendconn.close
Set Friendconn = Nothing
Catcherror ()
End If
End Sub
End Class
%> |
