<?xml version="1.0" encoding="UTF-8"?>
<!DOCTYPE muclient  [
  <!ENTITY days_to_show "14" > 
]>
<!-- Saved on Friday, November 15, 2002, 12:04 PM -->
<!-- MuClient version 3.32 -->

<!-- Plugin "Calendar" generated by Plugin Wizard -->

<!--

-->

<muclient>
<plugin
   name="Calendar"
   author="Nick Gammon"
   id="805364a6309ecdf2b4e366cf"
   language="VBscript"
   purpose="Calendar, to-do list"
   date_written="2002-11-15"
   date_modified="2002-11-16"
   requires="3.24"
   save_state="y"
   version="1.1"
   >
   
<!-- 

Version 1.1 - added checks for all required ActiveX objects in OnSetup.

-->
   
<description trim="y">
<![CDATA[

EVENTS

events              <-- list events (in next ]]>&days_to_show;<![CDATA[ days)
futureevents        <-- lists all forthcoming events (ie. not ones in the past)
allevents           <-- lists every event on file
event text AT date  <-- adds event 'text' at 'date'
delevent n          <-- deletes event n 
eventdate n date    <-- modifies event date for event n  
eventdesc n text    <-- modifies event description for event n 

NB - 'AT' must be in capitals (in case the word "AT" is in your description).
  
EXAMPLES

  event Meeting at work AT 18/11/2002
  delevent 5
  eventdate 6 21/8/2003
  eventdesc 7 go shopping
  events
  
TO-DO ITEMS

todo        <-- list to-do items
todo text   <-- adds to-do item 'text'
done        <-- lists all done items
done n      <-- marks to-do item n as done (eg. done 5)
deltodo n   <-- deletes to-do item n (eg. deltodo 5) 

DATABASE

setdatabase filename  <-- changes to different database file

  eg.  setdatabase c:\mydatabase.mdb

]]>
</description>

</plugin>


<!--  Aliases  -->

<aliases>

<!-- To-do items -->

  <alias
   script="AddToDo"
   match="todo *"
   enabled="y"
  >
  </alias>
  <alias
   script="ListToDo"
   match="^todos?$"
   regexp="y"
   enabled="y"
  >
  </alias>
  <alias
   script="ListDone"
   match="done"
   enabled="y"
  >
  </alias>
  <alias
   script="DeleteToDo"
   match="^deltodo (\d+)$"
   regexp="y"
   enabled="y"
  >
  </alias>
  <alias
   script="ToDoDone"
   match="^done (\d+)$"
   regexp="y"
   enabled="y"
  >
  </alias>
  
<!-- Events -->

  <alias
   script="AddEvent"
   match="event * AT *"
   enabled="y"
  >
  </alias>
  <alias
   script="ListEvent"
   match="^events?$"
   regexp="y"
   enabled="y"
  >
  </alias>
  <alias
   script="ListAllEvents"
   match="^allevents?$"
   regexp="y"
   enabled="y"
  >
  </alias>
  <alias
   script="ListFutureEvents"
   match="^futureevents?$"
   regexp="y"
   enabled="y"
  >
  </alias>
  <alias
   script="DeleteEvent"
   match="^delevent (\d+)$"
   regexp="y"
   enabled="y"
  >
  </alias>
  <alias
   script="ChangeEventDate"
   match="^eventdate (\d+) (.*)$"
   regexp="y"
   enabled="y"
  >
  </alias>
  <alias
   script="ChangeEventDesc"
   match="^eventdesc (\d+) (.*)$"
   regexp="y"
   enabled="y"
  >
  </alias>
  
<!-- General -->

  <alias
   script="SetDatabase"
   match="setdatabase *"
   enabled="y"
  >
  </alias>

  <alias
   script="QueryAlias"
   match="query *"
   enabled="y"
  >
  </alias>
  
</aliases>

<!--  Script  -->

<script>
<![CDATA[
'
'  Author: Nick Gammon  <nick@gammon.com.au>
'
'  Written: 15th November 2002
'

option explicit

'
'  Amend this to change the location or name of the database.
'
'  Default is world file directory, calendar.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 CreateTables
 
  if not DoesTableExist ("todo") then
    If DoSQL _
        ("CREATE TABLE todo (" & _
        "  todo_id int NOT NULL IDENTITY," & _
        "  description varchar(64) NOT NULL," & _
        "  done int," & _
        "  entered_date date, " & _
        "  done_date date, " & _
        "  PRIMARY KEY  (todo_id)" & _
        ")") Then Exit Sub
  
    ShowInfo "Table 'todo' created."
  end if

  if not DoesTableExist ("event") then
    If DoSQL _
        ("CREATE TABLE event (" & _
        "  event_id int NOT NULL IDENTITY," & _
        "  description varchar(64) NOT NULL," & _
        "  edate date NOT NULL, " & _
        "  PRIMARY KEY  (event_id)" & _
        ")") Then Exit Sub
  
    ShowInfo "Table 'event' created."
  end if
  
end sub

'
'  Called 5 seconds after plugin installation to create the
'   database and its table, if necessary
'
sub OnSetup (sTimerName)
dim obj

  ShowInfo "Plugin " & world.GetPluginName & " installed."

'
'  Check we have all required objects
'

  On Error Resume Next
  Set obj = CreateObject("Scripting.FileSystemObject")
  If Err.Number <> 0 Then
    ShowError Err.Description
    ShowError "Can't create object Scripting.FileSystemObject"
    world.EnablePlugin world.GetPluginID, vbFalse
    Exit Sub 
  End If
  Set obj = nothing

  Set obj = CreateObject("ADOX.Catalog")
  If Err.Number <> 0 Then
    ShowError Err.Description
    ShowError "Can't create object ADOX.Catalog"
    world.EnablePlugin world.GetPluginID, vbFalse
    Exit Sub 
  End If
  Set obj = nothing

  Set obj = CreateObject("ADODB.Connection")
  If Err.Number <> 0 Then
    ShowError Err.Description
    ShowError "Can't create object ADODB.Connection"
    world.EnablePlugin world.GetPluginID, vbFalse
    Exit Sub 
  End If
  Set obj = nothing
  
  Set obj = CreateObject("ADODB.Recordset")
  If Err.Number <> 0 Then
    ShowError Err.Description
    ShowError "Can't create object ADODB.Recordset"
    world.EnablePlugin world.GetPluginID, vbFalse
    Exit Sub 
  End If
  Set obj = nothing
    
  On Error GoTo 0
  
'
'  Don't create databases everywhere once they change the name
'
  if world.GetVariable ("database_changed") <> "Y" then
    CreateDatabase
    CreateTables
  end if

  ShowInfo "Database is: " & GetDatabaseFileName
  
  ListToDo 0, 0, 0
  ListEvent 0, 0, 0
  
  world.colournote "black", "orange", " Type 'calendar:help' for help. "
  
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) & "calendar.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 todo where description = "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 to-do to the list
'
sub AddToDo (sName, sLine, wildcards)
dim description

  description = wildcards (1)

'
'  Quotes will throw us out (because the SQL uses them)
'
  if Instr (description, """") > 0 Then
      ShowError "You cannot use quotes in the description"
    exit sub
  end if

'
'  Insert it
'
  If DoSQL _
    ("INSERT INTO todo (description, entered_date) VALUES (" & _
          """" & description & """, NOW() );") Then Exit Sub         
 
  world.ColourNote "white", "green", "To-do item '" & _
       description & "' added to the database"

end sub

'
'  called from an alias to add an event to the list
'
sub AddEvent (sName, sLine, wildcards)
dim description, edate

  description = wildcards (1)
  edate = wildcards (2)

'
'  Quotes will throw us out (because the SQL uses them)
'
  if Instr (description, """") > 0 Or _
     Instr (edate, """") > 0 Then
      ShowError "You cannot use quotes in the description or date"
    exit sub
  end if

 if Instr (edate, "/") = 0 Then 
      ShowError "Date should be in format xx/xx/year [hh:mm]"
    exit sub
 end if

 if not IsDate (edate) Then
      ShowError "Date should be in format xx/xx/year [hh:mm]"
    exit sub
 end if

'
'  Insert it
'
  If DoSQL _
    ("INSERT INTO event (description, edate) VALUES (" & _
          """" & description & """, " & _
          """" & edate & """ );") Then Exit Sub         
 
  world.ColourNote "white", "green", "Event '" & _
       description & "' AT '" &_
       FormatDateTime (edate) & "' added to the database"

end sub

function DoesToDoExist (todo_id)
'
'  Check already there
'
  if GetOneValue (_
    "select count(*) from todo where todo_id = " & todo_id) > 0  Then
    DoesToDoExist = vbTrue
    exit function
  end if
  
  ShowError "To-do item '" & todo_id & "' is not in the database"
  DoesToDoExist = vbFalse
  
end Function

function DoesEventExist (event_id)
'
'  Check already there
'
  if GetOneValue (_
    "select count(*) from event where event_id = " & event_id) > 0  Then
    DoesEventExist = vbTrue
    exit function
  end if
  
  ShowError "Event item '" & event_id & "' is not in the database"
  DoesEventExist = vbFalse
  
end Function

function GetToDoDescription (todo_id)
dim db, rst, sQuery

  sQuery = "select description from todo where todo_id = " & todo_id

  if ExecuteQuery (db, rst, sQuery) Then Exit Function

  GetToDoDescription = rst.Fields ("description").Value

  db.Close

  Set rst = Nothing
  Set db = Nothing

end function


'
'  called from an alias to delete a todo item from the list
'
sub DeleteToDo (sName, sLine, wildcards)
dim todo_id, description

  todo_id = wildcards (1)

  if not DoesToDoExist (todo_id) Then Exit Sub
  
  description = GetToDoDescription (todo_id) 
  
'
'  Delete it
'
  If DoSQL _
    ("DELETE FROM todo WHERE todo_id = " & todo_id) Then Exit Sub
 
  world.ColourNote "white", "green", "To-do item '" & description & _
     "' deleted from the database"

end sub

'
'  called from an alias to mark a todo item as done
'
sub ToDoDone (sName, sLine, wildcards)
dim todo_id, description

  todo_id = wildcards (1)

  if not DoesToDoExist (todo_id) Then Exit Sub

  description = GetToDoDescription (todo_id) 
  
'
'  Update it
'
  If DoSQL _
    ("UPDATE todo SET done = 1, done_date = NOW() " & _
     "WHERE todo_id = " & todo_id) Then Exit Sub
 
  world.ColourNote "white", "green", "To-do item '" & description & _
     "' marked as done"

end sub

'
'  List the to-do items in a nice way
'
sub ListToDo (sName, sLine, wildcards)
dim db, rst, count, sQuery
dim todo_id, description, entered_date

  sQuery = "SELECT * FROM todo WHERE (NOT done OR done IS NULL) ORDER BY description"

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  count = 0

  ' display each record
  Do Until rst.EOF

    count = count + 1

    if count = 1 then
      world.note ""
      world.colournote "white", "darkblue", "--------Things to do--------"
      world.note ""
    end if
    
    todo_id     = rst.Fields ("todo_id").Value
    description = rst.Fields ("description").Value
    entered_date = rst.Fields ("entered_date").Value

    world.Note  "#" & todo_id & _
                ": " & description & _
                " (since " & FormatDateTime (entered_date) & ")"

    rst.MoveNext
  
  Loop
  
  db.Close
  
  Set rst = Nothing
  Set db = Nothing
  
  if count = 0 then 
    world.note "Nothing to do." 
  else
    world.note ""
  end if

end sub

'
'  List done items
'
sub ListDone (sName, sLine, wildcards)
dim db, rst, count, sQuery
dim todo_id, description, done_date

  sQuery = "SELECT * FROM todo WHERE done = 1 ORDER BY description"

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  count = 0

  ' display each record
  Do Until rst.EOF

    count = count + 1

    if count = 1 then
      world.note ""
      world.colournote "white", "darkblue", "--------Done items--------"
      world.note ""
    end if
    
    todo_id     = rst.Fields ("todo_id").Value
    description = rst.Fields ("description").Value
    done_date   = rst.Fields ("done_date").Value

    world.Note  "#" & todo_id & _
                ": " & description & _
                " (done on " & FormatDateTime (done_date) & ")"

    rst.MoveNext
  
  Loop

  db.Close
  
  Set rst = Nothing
  Set db = Nothing

  if count = 0 then 
    world.note "Nothing done." 
  else
    world.note ""
  end if

end sub

'
'  We list events in 2 different ways, do the bulk of it here ...
'
sub ListEventHelper (sQuery, sHeading)
dim db, rst, count
dim event_id, description, edate

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  count = 0

  ' display each record
  Do Until rst.EOF

    count = count + 1

    if count = 1 then
      world.note ""
      world.colournote "white", "darkblue", "--------" & _
            sHeading & "--------"
      world.note ""
    end if
    
    event_id     = rst.Fields ("event_id").Value
    description = rst.Fields ("description").Value
    edate = rst.Fields ("edate").Value

'    world.Note  "#" & event_id & _
'                ": " & description & _
'                " AT " & edate
    world.Note  "#" & event_id & _
                ": " & FormatDateTime (edate) & _
                " " & description

    rst.MoveNext
  
  
  
  Loop

  db.Close
  
  Set rst = Nothing
  Set db = Nothing
  
  if count = 0 then 
    world.note "No events." 
  else
    world.note ""
  end if

end sub

'
'  List the events in a nice way
'
sub ListEvent (sName, sLine, wildcards)
dim sQuery, days_to_show
'
'  days forward is an ENTITY at the start of this file
'

  days_to_show = ]]> &days_to_show; <![CDATA[

  sQuery = "SELECT * FROM event WHERE edate > NOW() " & _
           "AND DATEDIFF('d', NOW(), edate,) < " & _
           days_to_show & " " & _
           "ORDER BY edate, description"

  ListEventHelper sQuery, "Events in next " & days_to_show & " days"
  
end sub

'
'  List all events
'
sub ListAllEvents (sName, sLine, wildcards)
dim sQuery

  sQuery = "SELECT * FROM event ORDER BY edate, description"

  ListEventHelper sQuery, "All events"
  
end sub

'
'  List future events
'
sub ListFutureEvents (sName, sLine, wildcards)
dim sQuery

  sQuery = "SELECT * FROM event WHERE edate > NOW() " & _
           "ORDER BY edate, description"

  ListEventHelper sQuery, "Future events"
  
end sub

'
'  called from an alias to delete an event from the list
'
sub DeleteEvent (sName, sLine, wildcards)
dim event_id, description, edate, sQuery, db, rst

  event_id = wildcards (1)

  if not DoesEventExist (event_id) Then Exit Sub
  
  sQuery = "select description, edate from event where event_id = " & event_id

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  description = rst.Fields ("description").Value
  edate = rst.Fields ("edate").Value

  db.Close

  Set rst = Nothing
  Set db = Nothing
  
'
'  Delete it
'
  If DoSQL _
    ("DELETE FROM event WHERE event_id = " & event_id) Then Exit Sub
 
  world.ColourNote "white", "green", "Event item '" & description & _
     " AT " & FormatDateTime (edate) & "' deleted from the database"

end sub

'
'  called from an alias to change an event date
'
sub ChangeEventDate (sName, sLine, wildcards)
dim event_id, description, edate, sQuery, db, rst

  event_id = wildcards (1)
  edate = wildcards (2)

'
'  Quotes will throw us out (because the SQL uses them)
'
  if Instr (edate, """") > 0 Then
      ShowError "You cannot use quotes in the date"
    exit sub
  end if

 if Instr (edate, "/") = 0 Then 
      ShowError "Date should be in format xx/xx/year [hh:mm]"
    exit sub
 end if

 if not IsDate (edate) Then
      ShowError "Date should be in format xx/xx/year [hh:mm]"
    exit sub
 end if

  if not DoesEventExist (event_id) Then Exit Sub
    
'
'  Delete it
'
  If DoSQL _
    ("UPDATE event SET edate = """ & _
      edate & """ WHERE event_id = " & event_id) Then Exit Sub
 
  sQuery = "select * from event where event_id = " & event_id

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  description = rst.Fields ("description").Value
  edate = rst.Fields ("edate").Value

  db.Close

  Set rst = Nothing
  Set db = Nothing
 
  world.ColourNote "white", "green", "Event item " & _
        event_id & " updated to '" & description & _
     " AT " & FormatDateTime (edate) & "'."

end sub

'
'  called from an alias to change a event description
'
sub ChangeEventDesc (sName, sLine, wildcards)
dim event_id, description, edate, sQuery, db, rst

  event_id = wildcards (1)
  description = wildcards (2)

'
'  Quotes will throw us out (because the SQL uses them)
'
  if Instr (description, """") > 0 Then
      ShowError "You cannot use quotes in the description"
    exit sub
  end if

  if not DoesEventExist (event_id) Then Exit Sub
    
'
'  Delete it
'
  If DoSQL _
    ("UPDATE event SET description = """ & _
      description & """ WHERE event_id = " & event_id) Then Exit Sub
 
  sQuery = "select * from event where event_id = " & event_id

  if ExecuteQuery (db, rst, sQuery) Then Exit Sub

  description = rst.Fields ("description").Value
  edate = rst.Fields ("edate").Value

  db.Close

  Set rst = Nothing
  Set db = Nothing
 
  world.ColourNote "white", "green", "Event item " & _
        event_id & " updated to '" & description & _
     " AT " & FormatDateTime (edate) & "'."

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="Calendar:help"
   enabled="y"
   ignore_case="y"
  >
  </alias>
</aliases>

<script>
<![CDATA[
Sub OnHelp (sName, sLine, wildcards)
  World.Note World.GetPluginInfo (World.GetPluginID, 3)
End Sub
]]>
</script> 

</muclient>
