initial release
This commit is contained in:
Draqoken
676
cosmic rage/worlds/plugins/MudDatabase.xml
Normal file
676
cosmic rage/worlds/plugins/MudDatabase.xml
Normal file
@@ -0,0 +1,676 @@
|
||||
<?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>
|
||||
Reference in New Issue
Block a user