677 lines
13 KiB
XML
677 lines
13 KiB
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>
|