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.

Version 1.1 - added 'setdatabase filename'

Version 1.2 - a) added error handling for errors on queries and sql statements
              b) Sort mud list by mud name

Version 1.3 - changed error handling to show exact error reason

Version 1.4 - a) improved error handling (eg. on database open)
              b) detect if database exists on 'setdatabase'
              c) a bit more modular

-->

<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"
   date_modified="2002-11-10 14:30"
   requires="3.24"
   save_state="y"
   version="1.4"
   >
<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 game.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

setdatabase filename  <-- changes to different database file

  eg.  setdatabase c:\mydatabase.mdb

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>


<!--  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>
  <alias
   script="SetDatabase"
   match="setdatabase *"
   enabled="y"
  >
  </alias>
</aliases>

<!--  Script  -->


<script>
<![CDATA[
'
'  Author: Nick Gammon  <nick@gammon.com.au>
'
'  Written: 7th November 2002
'

option explicit

'
'  Amend this to change the location or name of the database.
'
'  Default is world file directory, mushclient_db.mdb
'
function GetDatabaseFileName
  GetDatabaseFileName = _
     world.GetVariable ("database")
end function

'
'  Central spot for showing errors, so we can easily customise colours
'
sub ShowError (sMessage)
  world.ColourNote "white", "red", sMessage 
end sub

'
'  Central spot for showing information, so we can easily customise colours
'
sub ShowInfo (sMessage)
  world.ColourNote "lightblue", "midnightblue", sMessage 
end sub

'
'  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

  On Error Resume Next

  Set db = CreateObject ("ADOX.Catalog")

  If Err.Number <> 0 Then
    ShowError Err.Description
    Exit Function 
  End If

  db.ActiveConnection = GetProvider

  If Err.Number <> 0 Then
    ShowError Err.Description
    Set db = Nothing
    Exit Function 
  End If

  On Error GoTo 0

  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

  ShowInfo "Database '" & GetDatabaseFileName & "' created."

end sub

'
'  Execute some arbitrary SQL
'
Function DoSQL (sSQL)
dim db

  DoSQL = vbTrue	' error return

  On Error Resume Next
  
  Set db = CreateObject ("ADODB.Connection")

  If Err.Number <> 0 Then
    ShowError Err.Description
    Exit Function 
  End If

' Open the connection

  db.Open GetProvider

  If Err.Number <> 0 Then
    ShowError Err.Description
    Set db = Nothing
    Exit Function 
  End If

' Execute it
  db.Execute sSQL

  If Err.Number <> 0 Then
    ShowError Err.Description
    Set db = Nothing
    Exit Function 
  End If

  On Error GoTo 0

' Wrap up
  db.Close
  Set db = Nothing

  DoSQL = vbFalse	' OK return

end Function 

'
'  Create the table we want
'
sub CreateTable
 
  if DoesTableExist ("muds") then
    exit sub
  end if

  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)" & _
      ")") Then Exit Sub

  ShowInfo "Table 'muds' created."

end sub

'
'  Called 5 seconds after plugin installation to create the
'   database and its table, if necessary
'
sub OnSetup (sTimerName)
  ShowInfo "Plugin " & world.GetPluginName & " installed."

'
'  Don't create databases everywhere once they change the name
'
  if world.GetVariable ("database_changed") <> "Y" then
    CreateDatabase
    CreateTable
  end if

  ShowInfo "Database is: " & GetDatabaseFileName
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"

'
'  Set up default database name if variable does not exist
'
  if IsEmpty (world.GetVariable ("database")) Then
    world.SetVariable "database",  _
     world.GetInfo (57) & "mushclient_db.mdb"
  end if

end sub

'
'  Since we are doing queries in a few places, we will do the main
'    part here ...
'  A "true" result means the query failed.
'  A "false" (zero) result means the query succeeded
' 

Function ExecuteQuery (db, rst, sQuery)

  ExecuteQuery = vbTrue  ' assume bad result

  On Error Resume Next

  Set db = CreateObject ("ADODB.Connection")

  If Err.Number <> 0 Then
    ShowError Err.Description
    Exit Function
  End If

  Set rst = CreateObject ("ADODB.Recordset")

  If Err.Number <> 0 Then
    ShowError Err.Description
    set db = Nothing
    Exit Function
  End If

  ' Open the connection
  db.Open GetProvider

  If Err.Number <> 0 Then
    ShowError Err.Description
    Set rst = Nothing
    Set db = Nothing
    Exit Function
  End If

  ' Open the Recordset
  rst.Open sQuery, db

  If Err.Number <> 0 Then
    ShowError Err.Description
    Set rst = Nothing
    Set db = Nothing
    Exit Function
  End If

  On Error GoTo 0

  ExecuteQuery = vbFalse  ' good result

End Function

'
'  Do some arbitrary query, display the results
'
sub DoQuery (sQuery)
dim db, rst, count, fld

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  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.ColourTell "white", "darkblue", _
                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

  if ExecuteQuery (db, rst, sQuery) Then Exit Function

  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
      ShowError "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
     ShowError "MUD '" & mud_name & "' is already in the database"
    exit sub
  end if

'
'  Insert it
'
  If DoSQL _
    ("INSERT INTO muds (mud_name, ip_address," & _
      "port, description) VALUES (" & _
          """" & mud_name & """, " & _
          """" & ip_address & """, " & _
          """" & port & """, " & _
          """" & description & """ );") Then Exit Sub         
 
  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
    ShowError "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
    ShowError "MUD '" & mud_name & "' is not in the database"
    exit sub
  end if

'
'  Delete it
'
  If DoSQL _
    ("DELETE FROM muds WHERE mud_name = " & _
          """" & mud_name & """ ") Then Exit Sub
 
  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

'
'  a wildcard means to match on a subset
'
  if wildcards (1) = "" then
    sQuery = "SELECT * FROM muds ORDER BY mud_name"
  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) & "%"" " & _
         "ORDER BY mud_name"
  end if

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  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)
  If DoSQL (wildcards (1)) Then Exit Sub
  ShowInfo "SQL statement processed OK."
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

'
'  Change to some other database so we can do queries on it
'
sub SetDatabase (sName, sLine, wildcards)

'
'  Check database is there
'
  if not DoesFileExist (wildcards (1)) then
    ShowError "File '" & wildcards (1) & "' does not exist."
    exit sub
  end if

  world.SetVariable "database", wildcards (1)
  world.SetVariable "database_changed", "Y"
  ShowInfo "Database changed to: " & GetDatabaseFileName
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>