Posted by
| Nick Gammon
Australia (22,973 posts) bio
Forum Administrator |
Message
| Tada!
This rather extensive plugin demonstrates in one place all that is needed to get/store data into a database from MUSHclient.
It uses the default Jet engine which should be automatically installed with recent versions of Windows. The plugin demonstrates:
- Creating a database if necessary
- Creating a table if necessary
- Adding records after checking if they are already there
- Deleting records
- Listing records
- Executing any SQL statement (eg. drop database nick)
- Executing any SQL query and displaying the results in tabular form (eg. select * from mytable)
As it stands it is a reasonably useful "mud database". You can use it to add your favourite muds to a database, and then query the database to get all, or a selected subset, back from it.
Have fun.
You can download it from:
http://www.mushclient.com/plugins/MudDatabase.xml
<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE muclient>
<!-- Saved on Thursday, November 07, 2002, 12:57 PM -->
<!-- MuClient version 3.31 -->
<!-- Plugin "MudDatabase" generated by Plugin Wizard -->
<!--
Amend the start of the script to change the database name or location.
-->
<muclient>
<plugin
name="MudDatabase"
author="Nick Gammon"
id="464461cbb3a282dc839f1e5d"
language="VBscript"
purpose="Maintains a database of MUDs, demonstrates using SQL"
date_written="2002-11-07 12:51:24"
requires="3.24"
version="1.0"
>
<description trim="y">
<![CDATA[
This plugin demonstrates accessing a Database from within a plugin.
It uses the Microsoft.Jet.OLEDB.4.0 database provider, which
should be installed with default Windows 98 and upwards
installations. If it doesn't work, try installing the Jet engine.
Functions provided are:
addmud name ip port description <-- adds a MUD
eg. addmud realms_of_despair smaug.org 4000 Realms of Despair MUD
deletemud name <-- deletes a MUD from the database by name
eg. deletemud realms_of_despair
listmuds [searchstring] <-- lists MUDs with optional search
eg. listmuds
listmuds realms
sql command <-- issues arbitrary SQL command to the database
eg. sql DELETE FROM muds WHERE port = 4000
query command <-- issues SQL query, displays results
eg. query SELECT * FROM muds WHERE port > 1000 ORDER BY mud_name
The plugin attempts to create the database file, and then the muds
table, 5 seconds after it is installed. It checks to see if the database
is there so it doesn't get created twice.
]]>
</description>
</plugin>
<!-- Get our standard constants -->
<include name="constants.vbs"/>
<!-- Aliases -->
<aliases>
<alias
script="AddMud"
match="addmud * * * *"
enabled="y"
>
</alias>
<alias
script="DeleteMud"
match="deletemud *"
enabled="y"
>
</alias>
<alias
script="ListMuds"
match="listmuds"
enabled="y"
>
</alias>
<alias
script="ListMuds"
match="listmuds *"
enabled="y"
>
</alias>
<alias
script="SQLalias"
match="sql *"
enabled="y"
>
</alias>
<alias
script="QueryAlias"
match="query *"
enabled="y"
>
</alias>
</aliases>
<!-- Script -->
<script>
<![CDATA[
'
' Author: Nick Gammon
'
' Written: 7th November 2002
'
'
' Amend this to change the location or name of the database.
'
' Default is world file directory, mushclient_db.mdb
'
function GetDatabaseFileName
GetDatabaseFileName = _
world.GetInfo (57) & "\mushclient_db.mdb"
end function
'
' We need the provider (engine, database name) in various
' spots so we make a function to return it.
'
function GetProvider
GetProvider = "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=" & _
GetDatabaseFileName & _
";" & _
"Jet OLEDB:Engine Type=5;"
end function
'
' Helper function to see if a file exists
'
function DoesFileExist (sFileName)
Dim FSO
Set FSO = CreateObject("Scripting.FileSystemObject")
DoesFileExist = FSO.FileExists (sFileName)
Set FSO = Nothing
end function
'
' Helper function to see if a table exists in the database
'
function DoesTableExist (sTableName)
dim db, oTable
Set db = CreateObject ("ADOX.Catalog")
db.ActiveConnection = GetProvider
DoesTableExist = vbFalse
For Each oTable In db.Tables
If UCase(oTable.Name) = UCase(sTableName) Then
DoesTableExist = vbTrue
Exit For
End If
Next
Set db = Nothing
end function
'
' Create database in MUSHclient world file directory
'
sub CreateDatabase
Dim db
'
' Don't create the database twice - so check if file exists
'
if DoesFileExist (GetDatabaseFileName) then
exit sub
end if
'
' Doesn't exist? Create it.
'
Set db = CreateObject ("ADOX.Catalog")
db.Create GetProvider
Set db = Nothing
world.ColourNote "lightblue", "midnightblue", _
"Database '" & GetDatabaseFileName & "' created."
end sub
'
' Execute some arbitrary SQL
'
sub DoSQL (sSQL)
dim db
Set db = CreateObject ("ADODB.Connection")
' Open the connection
db.Open GetProvider
' Execute it
db.Execute sSQL
' Wrap up
db.Close
Set db = Nothing
end sub
'
' Create the table we want
'
sub CreateTable
if DoesTableExist ("muds") then
exit sub
end if
DoSQL _
"CREATE TABLE muds (" & _
" mud_id int NOT NULL IDENTITY," & _
" mud_name varchar(64) NOT NULL," & _
" ip_address varchar(64) NOT NULL," & _
" port int NOT NULL default '4000'," & _
" description text," & _
" PRIMARY KEY (mud_id)" & _
")"
world.ColourNote "lightblue", "midnightblue", _
"Table 'muds' created."
end sub
'
' Called 5 seconds after plugin installation to create the
' database and its table, if necessary
'
sub OnSetup (sTimerName)
world.ColourNote "lightblue", "midnightblue", _
"Plugin " & world.GetPluginName & " installed."
CreateDatabase
CreateTable
end sub
'
' When the plugin is installed we will wait 5 seconds
' and then create the database and table.
'
sub OnPluginInstall
' timer: enabled, one-shot, active-if-not-connected
world.addtimer "", 0, 0, 5, "", 1 + 4 + 32, "OnSetup"
end sub
'
' Do some arbitrary query, display the results
'
sub DoQuery (sQuery)
dim db, rst, count, fld
Set db = CreateObject ("ADODB.Connection")
Set rst = CreateObject ("ADODB.Recordset")
' Open the connection
db.Open GetProvider
' Open the Recordset
rst.Open sQuery, db
count = 0
' display each record
Do Until rst.EOF
count = count + 1
' display each field name
if count = 1 then
For Each fld In rst.Fields
world.tell fld.Name & chr(9)
Next
world.note "" ' newline
end if
' display each field
For Each fld In rst.Fields
world.tell fld.Value & chr(9)
Next
world.note "" ' newline
rst.MoveNext
Loop
db.Close
Set rst = Nothing
Set db = Nothing
world.note count & " record(s)"
end sub
'
' Does a query, and returns the first field returned
' eg. select count(*) from muds where mud_name = "foo"
'
function GetOneValue (sQuery)
dim db, rst
Set db = CreateObject ("ADODB.Connection")
Set rst = CreateObject ("ADODB.Recordset")
' Open the connection
db.Open GetProvider
' Open the Recordset
rst.Open sQuery, db
If Not rst.EOF Then
GetOneValue = rst.Fields (0).Value
End If
db.Close
Set rst = Nothing
Set db = Nothing
end function
'
' called from an alias to add a mud to the list
'
sub AddMud (sName, sLine, wildcards)
dim mud_name, ip_address, port, description
mud_name = wildcards (1)
ip_address = wildcards (2)
port = wildcards (3)
description = wildcards (4)
'
' Quotes will throw us out (because the SQL uses them)
'
if Instr (mud_name, """") > 0 or _
Instr (ip_address, """") > 0 or _
Instr (port, """") > 0 or _
Instr (description, """") > 0 Then
world.ColourNote "white", "red", _
"You cannot use quotes in the mud name/port/ip/description"
exit sub
end if
'
' Check not already there
'
if GetOneValue (_
"select count(*) from muds where mud_name = """ & _
mud_name & _
"""") > 0 Then
world.ColourNote "white", "red", "MUD '" & mud_name & _
"' is already in the database"
exit sub
end if
'
' Insert it
'
DoSQL _
"INSERT INTO muds (mud_name, ip_address," & _
"port, description) VALUES (" & _
"""" & mud_name & """, " & _
"""" & ip_address & """, " & _
"""" & port & """, " & _
"""" & description & """ );"
world.ColourNote "white", "green", "MUD '" & mud_name & _
"' added to the database"
end sub
'
' called from an alias to delete a mud from the list
'
sub DeleteMud (sName, sLine, wildcards)
dim mud_name
mud_name = wildcards (1)
'
' Quotes will throw us out (because the SQL uses them)
'
if Instr (mud_name, """") > 0 Then
world.ColourNote "white", "red", _
"You cannot use quotes in the mud name"
exit sub
end if
'
' Check already there
'
if not GetOneValue (_
"select count(*) from muds where mud_name = """ & _
mud_name & _
"""") > 0 Then
world.ColourNote "white", "red", "MUD '" & mud_name & _
"' is not in the database"
exit sub
end if
'
' Delete it
'
DoSQL _
"DELETE FROM muds WHERE mud_name = " & _
"""" & mud_name & """ "
world.ColourNote "white", "green", "MUD '" & mud_name & _
"' deleted from the database"
end sub
'
' List the muds in a nice way
'
sub ListMuds (sName, sLine, wildcards)
dim db, rst, count, sQuery
dim mud_name, ip_address, port, description
Set db = CreateObject ("ADODB.Connection")
Set rst = CreateObject ("ADODB.Recordset")
'
' a wildcard means to match on a subset
'
if wildcards (1) = "" then
sQuery = "select * from muds"
else
sQuery = "select * from muds WHERE " & _
"mud_name like ""%" & wildcards (1) & "%"" " & _
"OR ip_address like ""%" & wildcards (1) & "%"" " & _
"OR port like ""%" & wildcards (1) & "%"" " & _
"OR description like ""%" & wildcards (1) & "%"" "
end if
' Open the connection
db.Open GetProvider
' Open the Recordset
rst.Open sQuery, db
count = 0
' display each record
Do Until rst.EOF
count = count + 1
mud_name = rst.Fields ("mud_name").Value
ip_address = rst.Fields ("ip_address").Value
port = rst.Fields ("port").Value
description = rst.Fields ("description").Value
world.ColourTell "white", "darkred", mud_name
world.ColourTell "white", "black", " IP: " & ip_address
world.ColourTell "white", "black", " Port: " & port
world.Note ""
world.ColourNote "silver", "black", description
world.Note ""
rst.MoveNext
Loop
db.Close
Set rst = Nothing
Set db = Nothing
world.note count & " MUD(s)"
end sub
'
' Alias to execute arbitrary SQL
'
' eq. sql drop table muds
'
sub SQLalias (sName, sLine, wildcards)
DoSQL wildcards (1)
end sub
'
' Alias to execute arbitrary query
'
' eq. query select * from muds order by port
'
sub QueryAlias (sName, sLine, wildcards)
DoQuery wildcards (1)
end sub
]]>
</script>
<!-- Plugin help -->
<aliases>
<alias
script="OnHelp"
match="MudDatabase:help"
enabled="y"
>
</alias>
</aliases>
<script>
<![CDATA[
Sub OnHelp (sName, sLine, wildcards)
World.Note World.GetPluginInfo (World.GetPluginID, 3)
End Sub
]]>
</script>
</muclient>
|
- Nick Gammon
www.gammon.com.au, www.mushclient.com | top |
|