 |
CuMorrigu
Beginner
Joined: 29 Jul 2004
Posts: 19
Location: United States
|
 Posted: Thu May 25, 2006 8:54 pm
Random Quote
|
I have a widget from Yahoo (formerly Konfabulator) that every so often queryies http://www.quotedb.com and gets a random quote. Now the MUD I play has a quote channel and I thought it would be interesting if I could use the tech to every so often put one of those quotes up on those channels.
Quotedb offers a way to post a random quote to a web site using javascript:
| Code: |
<script language="javascript" src="http://www.quotedb.com/quote/quote.php?action=random_quote&=&=&"></script>
<br>
<a href="http://www.quotedb.com">Quote DB</a> |
I tried using this in zMud and got an error about colum width.
Any ideas? |
|
|
|
|
edb6377
Magician
Joined: 29 Nov 2005
Posts: 482
|
Posted: Fri May 26, 2006 1:41 am
|
whats the command to send the quote to the channel thats all i need to know
|
|
_________________
Confucious say "Bugs in Programs need Hammer" |
 |
|
|
CuMorrigu
Beginner
Joined: 29 Jul 2004
Posts: 19
Location: United States
|
Posted: Fri May 26, 2006 2:26 am Random Quote
|
quote
|
|
|
|
|
edb6377
Magician
Joined: 29 Nov 2005
Posts: 482
|
Posted: Fri May 26, 2006 2:58 am
|
Yes i realize this is probably messier than you expected and i had to add some fixes for cache problems but it works flawlessly. It is in VBSCRIPT not JSCRIPT.
Realizing that many scripts like to progress around muds i setup an alias. You type quotemsg for it to run. You need to create an alias called quotetell for the actual command. It will use the alias for where you want to send the quote when you type quotemsg. I am sure this can be updated to not use a text file and just use the streamed information but atm i wasnt trying to delve that deep into the script. This should be a great starting point for you to work on.
i.e.
#ALIAS QUOTETELL {quote %1}
| Code: |
#SS "VBScript" #CLASS {AddOnScripts|Random Quote} {enable}
#ALIAS quotemsg {#SS "VBScript" Dim strfetch
strfetch = "c:\temp\Fetch.txt"
Dim strURL
' TIME is a fix for cache problems in browsers
strURL = "http://www.quotedb.com/quote/quote.php?action=random_quote&Now=" & time
Dim strout
Set objFSO = CreateObject("Scripting.FileSystemObject")
If (objFSO.FileExists(strfetch)) Then ' File exist; delete it (it will be created by the command itself)
objFSO.DeleteFile(strfetch)
End If
strout = Fetch(strURL,strfetch)
i = 0
Dim arrFileLines
Set objFile = objFSO.OpenTextFile(strfetch, 1)
Do Until objFile.AtEndOfStream
Redim Preserve arrFileLines(i)
arrFileLines(i) = objFile.ReadLine
i = i + 1
Loop
objFile.Close
For l = Ubound(arrFileLines) to LBound(arrFileLines) Step -1
inputline = arrFileLines(I-2) + arrfilelines(i-1)
Next
newString = Replace(inputLine,"document.write('"," ")
newString = Replace(newstring,"');"," ")
newString = Replace(newstring,"More quotes from","-")
With New RegExp
.Pattern = "<(?:([""'])[\s\S]*?\1|[^\s>]*)>"
.IgnoreCase = True
.Global = True
newString = .Replace(newString, "")
End With
With New RegExp
.Pattern = "<a href=(?:([""'])[\s\S]*?\1|[^\s>]*)>"
.IgnoreCase = True
.Global = True
newString = .Replace(newString, "")
End With
sess.processcommand("quotetell " & newstring)
set newstring = nothing
Function Fetch(xURL,xOUT)
On Error Resume Next
Err.Clear
Dim b
With CreateObject("Microsoft.XMLHTTP")
.Open "GET",xURL,False
.Send
b = .ResponseBody
If Err.Number <> 0 Or .Status <> 200 Then
Fetch = False
Exit Function
End If
End With
With CreateObject("ADODB.Stream")
.Type = 1
.Open
.Write b
.SaveToFile xOUT,2
End With
Fetch = Err.Number = 0
End Function}
#CLASS 0
|
|
|
|
|
|
|
|
|
