IPB

Welcome Guest ( Log In | Register )

1 User(s) are reading this topic (1 Guests and 0 Anonymous Users)
0 Members:

 
Reply to this topicStart new topic
> Tutorial: Databases
J3m
post Apr 19 2006, 10:22 AM
Post #1


Full Member
***

Group: Sr. Members
Posts: 594
Joined: 22-February 06
Member No.: 480



Although this is a working plugin it has no other use than showing how to do stuff with databases.

Using databases in VBS is pretty tiresome. So I wrote a class to make its usage a bit easier. If you know VBS you might learn a lot from looking at the code.

If you have suggestions I might enhance this more so its more useful for other plugin-developers.

Questions?


CODE

'db
'0.1

Private Const db_cTypeBoolean = 11
Private Const db_cTypeCurrency = 6
Private Const db_cTypeDate = 7
Private Const db_cTypeDouble = 5
Private Const db_cTypeInteger = 3
Private Const db_cTypeText = 202

Private Const db_cModeReadOnly = 1
Private Const db_cModeForUpdate = 2

Sub db_Event_Load()

    Dim db, t, db_path, rs, l
    Set db = New db_clsDatabase
    db_path = BotPath() & "plugins\db.mdb"
    
    ' open the database, create it if needed
    If not db.Exists(db_path) Then
 If Not db.Create(db_path) Then
     AddChat vbRed, "Could not create database!"
     Exit Sub
 End If
    Else
 If Not db.Open(db_path) Then
     AddChat vbRed, "Could not open database!"
     Exit Sub
 End If
    End If
 
    If db.IsOpen() Then
 AddChat vbGreen, "Database opened."
    Else
 Exit Sub
    End If
    
    If Not db.TableExists("Members") Then
 If db.CreateTable("Members") Then
     AddChat vbGreen, "Created Table Members"
 Else
     AddChat vbRed, "Could not create Table Members"
     Exit Sub
 End If
    End If
    
    Set t = db.Table("Members")
    If Not db.ColumnExists(t.Name, "Name") Then
 t.Columns.Append "Name", db_cTypeText, 32
 AddChat vbGreen, "Created Column Name in Table Members"
    End If
    If Not db.ColumnExists(t.Name, "AIM") Then
 t.Columns.Append "AIM", db_cTypeText, 255
 AddChat vbGreen, "Created Column AIM in Table Members"
    End If

    AddChat vbWhite, "Deleting all records from Members ..."
    l = db.ExecuteQuery("DELETE FROM Members")
    AddChat vbWhite, "Deleted " & l & " records."

    AddChat vbWhite, "Inserting a record via query ..."
    l = db.ExecuteQuery("INSERT INTO Members (Name, AIM) VALUES ('Whoever','Whoever@hotmail.com')")
    AddChat vbWhite, "Inserted " & l & " records via query."

    AddChat vbWhite, "Inserting 2 records via recordset ..."
    Set rs = db.OpenRecordSet("Members", db_cModeForUpdate)
    rs.AddNew
    rs("Name") = "J3m"
    rs("AIM") = "aim_at_me"
    rs.Update
    rs.AddNew
    rs("Name") = "SomeOne"
    rs("AIM") = "SomeOne@aol.com"
    rs.Update
    rs.Close()
    AddChat vbWhite, "Done"
    

    Set rs = db.OpenRecordSet("SELECT * FROM Members ORDER BY Name", db_cModeReadOnly)
    Do While Not rs.EOF
 AddChat vbCyan, rs("Name") & " " & rs("AIM")
 rs.MoveNext
    Loop
    
    AddChat vbWhite, "Searching for a record ..."
    rs.MoveFirst
    rs.Find "Name='J3m'"
    If Not rs.EOF Then
 AddChat vbWhite, "Deleting it via Query ..."
 l = db.ExecuteQuery("DELETE FROM Members WHERE Name='J3m'")
 AddChat vbWhite, "Deleted " & l & " records."
    Else
 AddChat vbWhite, "Not Found"
    End If
    
    Set rs = db.OpenRecordSet("SELECT * FROM Members ORDER BY Name", db_cModeReadOnly)
    Do While Not rs.EOF
 AddChat vbCyan, rs("Name") & " " & rs("AIM")
 rs.MoveNext
    Loop

    AddChat vbWhite, "Now show all AIMs with aol in it..."
    rs.Filter = "AIM LIKE '*aol*'"
    Do While Not rs.EOF
 AddChat vbCyan, rs("Name") & " " & rs("AIM")
 rs.MoveNext
    Loop
 
    rs.Close()
    db.Close()
 
End Sub


& #39;********************************************************
**********************

Class db_clsDatabase

    Private path_, conn_, xconn_
    
    Public Function Exists(path)
 Dim fso
 Exists = False
 Set fso =  CreateObject("Scripting.FileSystemObject")
 If fso.FileExists(path) Then
     Exists = True
 End If
 Set fso = Nothing
    End Function
    
    Public Function Close()
 If Not conn_ Is Nothing Then
     If IsOpen() Then
   conn_.Close
     End If
     Set conn_ = Nothing
 End If
 Close = True
    End Function
    
    Public Function IsOpen()
 IsOpen = False
 If Not conn_ Is Nothing Then
     If conn_.State = 1 Then
   IsOpen = True
     End If
 End If
    End Function
    
    Public Function Open(path)
 On Error Resume Next
 Close()
 Open = False
 path_ = path
 Set conn_ = CreateObject("ADODB.Connection")
 conn_.Provider = "Microsoft.Jet.OLEDB.4.0"
 conn_.Open path_
 If IsOpen() Then
     Set xconn_ = CreateObject("ADOX.Catalog")
     xconn_.ActiveConnection = conn_
     Open = True
 End If
 If Err.Number <> 0 Then
     AddChat vbRed, "Error in Open('" & path & "'): " & Err.Description
     Err.Clear
 End If
    End Function

    Public Function Create(path)
 On Error Resume Next
 Dim obj_
 Close()
 Set obj_ = CreateObject("ADOX.Catalog")
 obj_.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
     "Jet OLEDB:Engine Type=5;Data Source=" & path
 Set obj_ = Nothing
 Create = Open(path)
 If Err.Number <> 0 Then
     AddChat vbRed, "Error in Create('" & path & "'): " & Err.Description
     Err.Clear
 End If
    End Function

    Public Function TableExists(tabname)
 Dim i
 TableExists = False
 If Not IsOpen() Then Exit Function
 If xconn_.Tables.Count = 0 Then Exit Function
 For i = 0 To xconn_.Tables.Count - 1
     If UCase(tabname) = UCase(xconn_.Tables(i).Name) Then
   TableExists = True
   Exit Function
     End If
 Next
    End Function
    
    Public Function ColumnExists(tabname, colname)
 Dim i, t
 ColumnExists = False
 If Not IsOpen() Then Exit Function
 If Not TableExists(tabname) Then Exit Function
 Set t = xconn_.Tables(tabname)
 If t.Columns.Count = 0 Then Exit Function
 For i = 0 To t.Columns.Count - 1
     If UCase(colname) = UCase(t.Columns(i).Name) Then
   ColumnExists = True
   Exit Function
     End If
 Next
    End Function
    
    Public Function CreateTable(tabname)
 On Error Resume Next
 Dim tbl_
 If Not IsOpen() Then Exit Function
 If TableExists(tabname) Then Exit Function
 Set tbl_ = CreateObject("ADOX.Table")
 tbl_.Name = tabname
 xconn_.Tables.Append tbl_
 CreateTable = True
 If Err.Number <> 0 Then
     AddChat vbRed, "Error in CreateTable('" & tabname & "'): " & _
   Err.Description
     Err.Clear
 End If
    End Function
    
    Public Property Get Table(tabname)
 On Error Resume Next
 Dim tbl_
 Set tbl_ = Nothing
 If IsOpen() Then
     Set tbl_ = xconn_.Tables(tabname)
 End If
 Set Table = tbl_
 If Err.Number <> 0 Then
     AddChat vbRed, "Error in Table('" & tabname & "'): " & Err.Description
     Err.Clear
 End If
    End Property  
    
    Public Function OpenRecordset(sql, mode)
 On Error Resume Next
 Dim rs_
 Set OpenRecordset = Nothing
 If Not IsOpen() Then Exit Function
 Set rs_ = CreateObject("ADODB.Recordset")
 rs_.ActiveConnection = conn_
 Select Case mode
     Case db_cModeReadOnly
   rs_.CursorType = 2 ' adOpenStatic
   rs_.LockType = 1   ' adLockReadOnly
     Case db_cModeForUpdate
   rs_.CursorType = 1 ' adOpenKeyset
   rs_.LockType = 3   ' adLockOptimistic
     Case Else
   rs_.CursorType = 0 ' adOpenForwardOnly
   rs_.LockType = 1   ' adLockReadOnly
 End Select
 rs_.Source = sql
 rs_.Open
 If Err.Number <> 0 Then
     AddChat vbRed, "Error in OpenRecordSet('" & sql & "', " & _
   mode & "): " & Err.Description
     Err.Clear
     Exit Function
 End If
 Set OpenRecordset = rs_
    End Function
    
    Public Function ExecuteQuery(sql)
 On Error Resume Next
 Dim rs_, rows_affected
 ExecuteQuery = 0
 If Not IsOpen() Then Exit Function
 Set rs_ = conn_.Execute(sql, rows_affected)
 ExecuteQuery = rows_affected
 If Err.Number <> 0 Then
     AddChat vbRed, "Error in ExecuteQuery('" & sql & "'): " & Err.Description
     Err.Clear
 End If
    End Function
    
    Private Sub Class_Initialize()
 path_ = BotPath() & "plugins\db.mdb"
 Set conn_ = Nothing
 Set xconn_ = Nothing
    End Sub
    Private Sub Class_Terminate()
 Close()
 Set conn_ = Nothing
 Set xconn_ = Nothing
    End Sub
    
End Class


This post has been edited by Jack: Apr 19 2006, 05:54 PM


--------------------
Bye, trash my pinned topics more.
User is offlineProfile CardPM
Go to the top of the page
+Quote Post

Reply to this topicStart new topic
1 User(s) are reading this topic (1 Guests and 0 Anonymous Users)
0 Members:

 



- Lo-Fi Version Time is now: 1st October 2014 - 04:19 PM
Skin by Andrea
Website Legal Information | Hosted by LunarPages