mirror of
https://gitlab.silvrtree.co.uk/martind2000/booksnew.git
synced 2025-01-11 04:35:11 +00:00
1061 lines
25 KiB
Plaintext
1061 lines
25 KiB
Plaintext
'==============================================================
|
||
' RSS/RDF Syndicate Reader v0.95
|
||
' http://www.kattanweb.com/webdev
|
||
'--------------------------------------------------------------
|
||
' Copyright(c) 2002, KattanWeb.com
|
||
'
|
||
' Change Log:
|
||
'--------------------------------------------------------------
|
||
'==============================================================
|
||
|
||
Const adOpenStatic = 3
|
||
Const adCmdTable = &H0002
|
||
Const adOpenKeyset = 1
|
||
Const adLockReadOnly = 1
|
||
Const adLockPessimistic = 2
|
||
Const adLockOptimistic = 3
|
||
Const adLockBatchOptimistic = 4
|
||
|
||
'const sqlServer = "dsn=rssfeeds;uid=rss_user;pwd=hOC2jBiQFxAOKy9PoUXDhoix8Ec7BRLfHkz7trh7ZMn27H_lESSkRk7m-jX5ibiN;"
|
||
const sqlServer = "dsn=rssfeeds;uid=rss_user;pwd=rss;"
|
||
|
||
|
||
|
||
Const rssInit = 1
|
||
Const rssError = 2
|
||
Const rssBadRSS= 3
|
||
Const rssOK = 0
|
||
Private Const BITS_TO_A_BYTE=8
|
||
Private Const BYTES_TO_A_WORD=4
|
||
Private Const BITS_TO_A_WORD=32
|
||
Private m_lOnBits(30)
|
||
Private m_l2Power(30)
|
||
m_lOnBits(0)=CLng(1)
|
||
m_lOnBits(1)=CLng(3)
|
||
m_lOnBits(2)=CLng(7)
|
||
m_lOnBits(3)=CLng(15)
|
||
m_lOnBits(4)=CLng(31)
|
||
m_lOnBits(5)=CLng(63)
|
||
m_lOnBits(6)=CLng(127)
|
||
m_lOnBits(7)=CLng(255)
|
||
m_lOnBits(8)=CLng(511)
|
||
m_lOnBits(9)=CLng(1023)
|
||
m_lOnBits(10)=CLng(2047)
|
||
m_lOnBits(11)=CLng(4095)
|
||
m_lOnBits(12)=CLng(8191)
|
||
m_lOnBits(13)=CLng(16383)
|
||
m_lOnBits(14)=CLng(32767)
|
||
m_lOnBits(15)=CLng(65535)
|
||
m_lOnBits(16)=CLng(131071)
|
||
m_lOnBits(17)=CLng(262143)
|
||
m_lOnBits(18)=CLng(524287)
|
||
m_lOnBits(19)=CLng(1048575)
|
||
m_lOnBits(20)=CLng(2097151)
|
||
m_lOnBits(21)=CLng(4194303)
|
||
m_lOnBits(22)=CLng(8388607)
|
||
m_lOnBits(23)=CLng(16777215)
|
||
m_lOnBits(24)=CLng(33554431)
|
||
m_lOnBits(25)=CLng(67108863)
|
||
m_lOnBits(26)=CLng(134217727)
|
||
m_lOnBits(27)=CLng(268435455)
|
||
m_lOnBits(28)=CLng(536870911)
|
||
m_lOnBits(29)=CLng(1073741823)
|
||
m_lOnBits(30)=CLng(2147483647)
|
||
|
||
m_l2Power(0)=CLng(1)
|
||
m_l2Power(1)=CLng(2)
|
||
m_l2Power(2)=CLng(4)
|
||
m_l2Power(3)=CLng(8)
|
||
m_l2Power(4)=CLng(16)
|
||
m_l2Power(5)=CLng(32)
|
||
m_l2Power(6)=CLng(64)
|
||
m_l2Power(7)=CLng(128)
|
||
m_l2Power(8)=CLng(256)
|
||
m_l2Power(9)=CLng(512)
|
||
m_l2Power(10)=CLng(1024)
|
||
m_l2Power(11)=CLng(2048)
|
||
m_l2Power(12)=CLng(4096)
|
||
m_l2Power(13)=CLng(8192)
|
||
m_l2Power(14)=CLng(16384)
|
||
m_l2Power(15)=CLng(32768)
|
||
m_l2Power(16)=CLng(65536)
|
||
m_l2Power(17)=CLng(131072)
|
||
m_l2Power(18)=CLng(262144)
|
||
m_l2Power(19)=CLng(524288)
|
||
m_l2Power(20)=CLng(1048576)
|
||
m_l2Power(21)=CLng(2097152)
|
||
m_l2Power(22)=CLng(4194304)
|
||
m_l2Power(23)=CLng(8388608)
|
||
m_l2Power(24)=CLng(16777216)
|
||
m_l2Power(25)=CLng(33554432)
|
||
m_l2Power(26)=CLng(67108864)
|
||
m_l2Power(27)=CLng(134217728)
|
||
m_l2Power(28)=CLng(268435456)
|
||
m_l2Power(29)=CLng(536870912)
|
||
m_l2Power(30)=CLng(1073741824)
|
||
|
||
|
||
|
||
Private Function LShift(lValue,iShiftBits)
|
||
If iShiftBits=0 Then
|
||
LShift=lValue
|
||
Exit Function
|
||
ElseIf iShiftBits=31 Then
|
||
If lValue And 1 Then
|
||
LShift=&H80000000
|
||
Else
|
||
LShift=0
|
||
End If
|
||
Exit Function
|
||
ElseIf iShiftBits<0 Or iShiftBits>31 Then
|
||
Err.Raise 6
|
||
End If
|
||
|
||
If (lValue And m_l2Power(31-iShiftBits)) Then
|
||
LShift=((lValue And m_lOnBits(31-(iShiftBits+1)))*m_l2Power(iShiftBits)) Or &H80000000
|
||
Else
|
||
LShift=((lValue And m_lOnBits(31-iShiftBits))*m_l2Power(iShiftBits))
|
||
End If
|
||
End Function
|
||
|
||
Private Function RShift(lValue,iShiftBits)
|
||
If iShiftBits=0 Then
|
||
RShift=lValue
|
||
Exit Function
|
||
ElseIf iShiftBits=31 Then
|
||
If lValue And &H80000000 Then
|
||
RShift=1
|
||
Else
|
||
RShift=0
|
||
End If
|
||
Exit Function
|
||
ElseIf iShiftBits<0 Or iShiftBits>31 Then
|
||
Err.Raise 6
|
||
End If
|
||
|
||
RShift=(lValue And &H7FFFFFFE)\m_l2Power(iShiftBits)
|
||
|
||
If (lValue And &H80000000) Then
|
||
RShift=(RShift Or (&H40000000\m_l2Power(iShiftBits-1)))
|
||
End If
|
||
End Function
|
||
|
||
Private Function RotateLeft(lValue,iShiftBits)
|
||
RotateLeft=LShift(lValue,iShiftBits) Or RShift(lValue,(32-iShiftBits))
|
||
End Function
|
||
|
||
Private Function AddUnsigned(lX,lY)
|
||
Dim lX4
|
||
Dim lY4
|
||
Dim lX8
|
||
Dim lY8
|
||
Dim lResult
|
||
|
||
lX8=lX And &H80000000
|
||
lY8=lY And &H80000000
|
||
lX4=lX And &H40000000
|
||
lY4=lY And &H40000000
|
||
|
||
lResult=(lX And &H3FFFFFFF)+(lY And &H3FFFFFFF)
|
||
|
||
If lX4 And lY4 Then
|
||
lResult=lResult Xor &H80000000 Xor lX8 Xor lY8
|
||
ElseIf lX4 Or lY4 Then
|
||
If lResult And &H40000000 Then
|
||
lResult=lResult Xor &HC0000000 Xor lX8 Xor lY8
|
||
Else
|
||
lResult=lResult Xor &H40000000 Xor lX8 Xor lY8
|
||
End If
|
||
Else
|
||
lResult=lResult Xor lX8 Xor lY8
|
||
End If
|
||
|
||
AddUnsigned=lResult
|
||
End Function
|
||
|
||
Private Function F(x,y,z)
|
||
F=(x And y) Or ((Not x) And z)
|
||
End Function
|
||
|
||
Private Function G(x,y,z)
|
||
G=(x And z) Or (y And (Not z))
|
||
End Function
|
||
|
||
Private Function H(x,y,z)
|
||
H=(x Xor y Xor z)
|
||
End Function
|
||
|
||
Private Function I(x,y,z)
|
||
I=(y Xor (x Or (Not z)))
|
||
End Function
|
||
|
||
Private Sub FF(a,b,c,d,x,s,ac)
|
||
a=AddUnsigned(a,AddUnsigned(AddUnsigned(F(b,c,d),x),ac))
|
||
a=RotateLeft(a,s)
|
||
a=AddUnsigned(a,b)
|
||
End Sub
|
||
|
||
Private Sub GG(a,b,c,d,x,s,ac)
|
||
a=AddUnsigned(a,AddUnsigned(AddUnsigned(G(b,c,d),x),ac))
|
||
a=RotateLeft(a,s)
|
||
a=AddUnsigned(a,b)
|
||
End Sub
|
||
|
||
Private Sub HH(a,b,c,d,x,s,ac)
|
||
a=AddUnsigned(a,AddUnsigned(AddUnsigned(H(b,c,d),x),ac))
|
||
a=RotateLeft(a,s)
|
||
a=AddUnsigned(a,b)
|
||
End Sub
|
||
|
||
Private Sub II(a,b,c,d,x,s,ac)
|
||
a=AddUnsigned(a,AddUnsigned(AddUnsigned(I(b,c,d),x),ac))
|
||
a=RotateLeft(a,s)
|
||
a=AddUnsigned(a,b)
|
||
End Sub
|
||
|
||
Private Function ConvertToWordArray(sMessage)
|
||
Dim lMessageLength
|
||
Dim lNumberOfWords
|
||
Dim lWordArray()
|
||
Dim lBytePosition
|
||
Dim lByteCount
|
||
Dim lWordCount
|
||
|
||
Const MODULUS_BITS=512
|
||
Const CONGRUENT_BITS=448
|
||
|
||
lMessageLength=Len(sMessage)
|
||
|
||
lNumberOfWords=(((lMessageLength+((MODULUS_BITS-CONGRUENT_BITS)\BITS_TO_A_BYTE))\(MODULUS_BITS\BITS_TO_A_BYTE))+1)*(MODULUS_BITS\BITS_TO_A_WORD)
|
||
ReDim lWordArray(lNumberOfWords-1)
|
||
|
||
lBytePosition=0
|
||
lByteCount=0
|
||
Do Until lByteCount >=lMessageLength
|
||
lWordCount=lByteCount\BYTES_TO_A_WORD
|
||
lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE
|
||
lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(Asc(Mid(sMessage,lByteCount+1,1)),lBytePosition)
|
||
lByteCount=lByteCount+1
|
||
Loop
|
||
|
||
lWordCount=lByteCount\BYTES_TO_A_WORD
|
||
lBytePosition=(lByteCount Mod BYTES_TO_A_WORD)*BITS_TO_A_BYTE
|
||
|
||
lWordArray(lWordCount)=lWordArray(lWordCount) Or LShift(&H80,lBytePosition)
|
||
|
||
lWordArray(lNumberOfWords-2)=LShift(lMessageLength,3)
|
||
lWordArray(lNumberOfWords-1)=RShift(lMessageLength,29)
|
||
|
||
ConvertToWordArray=lWordArray
|
||
End Function
|
||
|
||
Private Function WordToHex(lValue)
|
||
Dim lByte
|
||
Dim lCount
|
||
|
||
For lCount=0 To 3
|
||
lByte=RShift(lValue,lCount*BITS_TO_A_BYTE) And m_lOnBits(BITS_TO_A_BYTE-1)
|
||
WordToHex=WordToHex & Right("0" & Hex(lByte),2)
|
||
Next
|
||
End Function
|
||
|
||
Public Function MD5(sMessage)
|
||
Dim x
|
||
Dim k
|
||
Dim AA
|
||
Dim BB
|
||
Dim CC
|
||
Dim DD
|
||
Dim a
|
||
Dim b
|
||
Dim c
|
||
Dim d
|
||
|
||
Const S11=7
|
||
Const S12=12
|
||
Const S13=17
|
||
Const S14=22
|
||
Const S21=5
|
||
Const S22=9
|
||
Const S23=14
|
||
Const S24=20
|
||
Const S31=4
|
||
Const S32=11
|
||
Const S33=16
|
||
Const S34=23
|
||
Const S41=6
|
||
Const S42=10
|
||
Const S43=15
|
||
Const S44=21
|
||
|
||
x=ConvertToWordArray(sMessage)
|
||
|
||
a=&H67452301
|
||
b=&HEFCDAB89
|
||
c=&H98BADCFE
|
||
d=&H10325476
|
||
|
||
For k=0 To UBound(x) Step 16
|
||
AA=a
|
||
BB=b
|
||
CC=c
|
||
DD=d
|
||
|
||
FF a,b,c,d,x(k+0),S11,&HD76AA478
|
||
FF d,a,b,c,x(k+1),S12,&HE8C7B756
|
||
FF c,d,a,b,x(k+2),S13,&H242070DB
|
||
FF b,c,d,a,x(k+3),S14,&HC1BDCEEE
|
||
FF a,b,c,d,x(k+4),S11,&HF57C0FAF
|
||
FF d,a,b,c,x(k+5),S12,&H4787C62A
|
||
FF c,d,a,b,x(k+6),S13,&HA8304613
|
||
FF b,c,d,a,x(k+7),S14,&HFD469501
|
||
FF a,b,c,d,x(k+8),S11,&H698098D8
|
||
FF d,a,b,c,x(k+9),S12,&H8B44F7AF
|
||
FF c,d,a,b,x(k+10),S13,&HFFFF5BB1
|
||
FF b,c,d,a,x(k+11),S14,&H895CD7BE
|
||
FF a,b,c,d,x(k+12),S11,&H6B901122
|
||
FF d,a,b,c,x(k+13),S12,&HFD987193
|
||
FF c,d,a,b,x(k+14),S13,&HA679438E
|
||
FF b,c,d,a,x(k+15),S14,&H49B40821
|
||
|
||
GG a,b,c,d,x(k+1),S21,&HF61E2562
|
||
GG d,a,b,c,x(k+6),S22,&HC040B340
|
||
GG c,d,a,b,x(k+11),S23,&H265E5A51
|
||
GG b,c,d,a,x(k+0),S24,&HE9B6C7AA
|
||
GG a,b,c,d,x(k+5),S21,&HD62F105D
|
||
GG d,a,b,c,x(k+10),S22,&H2441453
|
||
GG c,d,a,b,x(k+15),S23,&HD8A1E681
|
||
GG b,c,d,a,x(k+4),S24,&HE7D3FBC8
|
||
GG a,b,c,d,x(k+9),S21,&H21E1CDE6
|
||
GG d,a,b,c,x(k+14),S22,&HC33707D6
|
||
GG c,d,a,b,x(k+3),S23,&HF4D50D87
|
||
GG b,c,d,a,x(k+8),S24,&H455A14ED
|
||
GG a,b,c,d,x(k+13),S21,&HA9E3E905
|
||
GG d,a,b,c,x(k+2),S22,&HFCEFA3F8
|
||
GG c,d,a,b,x(k+7),S23,&H676F02D9
|
||
GG b,c,d,a,x(k+12),S24,&H8D2A4C8A
|
||
|
||
HH a,b,c,d,x(k+5),S31,&HFFFA3942
|
||
HH d,a,b,c,x(k+8),S32,&H8771F681
|
||
HH c,d,a,b,x(k+11),S33,&H6D9D6122
|
||
HH b,c,d,a,x(k+14),S34,&HFDE5380C
|
||
HH a,b,c,d,x(k+1),S31,&HA4BEEA44
|
||
HH d,a,b,c,x(k+4),S32,&H4BDECFA9
|
||
HH c,d,a,b,x(k+7),S33,&HF6BB4B60
|
||
HH b,c,d,a,x(k+10),S34,&HBEBFBC70
|
||
HH a,b,c,d,x(k+13),S31,&H289B7EC6
|
||
HH d,a,b,c,x(k+0),S32,&HEAA127FA
|
||
HH c,d,a,b,x(k+3),S33,&HD4EF3085
|
||
HH b,c,d,a,x(k+6),S34,&H4881D05
|
||
HH a,b,c,d,x(k+9),S31,&HD9D4D039
|
||
HH d,a,b,c,x(k+12),S32,&HE6DB99E5
|
||
HH c,d,a,b,x(k+15),S33,&H1FA27CF8
|
||
HH b,c,d,a,x(k+2),S34,&HC4AC5665
|
||
|
||
II a,b,c,d,x(k+0),S41,&HF4292244
|
||
II d,a,b,c,x(k+7),S42,&H432AFF97
|
||
II c,d,a,b,x(k+14),S43,&HAB9423A7
|
||
II b,c,d,a,x(k+5),S44,&HFC93A039
|
||
II a,b,c,d,x(k+12),S41,&H655B59C3
|
||
II d,a,b,c,x(k+3),S42,&H8F0CCC92
|
||
II c,d,a,b,x(k+10),S43,&HFFEFF47D
|
||
II b,c,d,a,x(k+1),S44,&H85845DD1
|
||
II a,b,c,d,x(k+8),S41,&H6FA87E4F
|
||
II d,a,b,c,x(k+15),S42,&HFE2CE6E0
|
||
II c,d,a,b,x(k+6),S43,&HA3014314
|
||
II b,c,d,a,x(k+13),S44,&H4E0811A1
|
||
II a,b,c,d,x(k+4),S41,&HF7537E82
|
||
II d,a,b,c,x(k+11),S42,&HBD3AF235
|
||
II c,d,a,b,x(k+2),S43,&H2AD7D2BB
|
||
II b,c,d,a,x(k+9),S44,&HEB86D391
|
||
|
||
a=AddUnsigned(a,AA)
|
||
b=AddUnsigned(b,BB)
|
||
c=AddUnsigned(c,CC)
|
||
d=AddUnsigned(d,DD)
|
||
Next
|
||
|
||
MD5=LCase(WordToHex(a) & WordToHex(b) & WordToHex(c) & WordToHex(d))
|
||
End Function
|
||
|
||
|
||
function stripBadChars(istr)
|
||
goodchars = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ1234567890"
|
||
|
||
l = len(istr)
|
||
|
||
outstr = ""
|
||
for t= 1 to l
|
||
if instr(goodchars,mid(istr,t,1)) > 0 then outstr = outstr & mid(istr,t,1)
|
||
wscript.echo mid(istr,t,1)
|
||
next
|
||
|
||
stripBadchars = outstr
|
||
|
||
end function
|
||
|
||
|
||
|
||
class kwRSS_reader
|
||
Private Items()
|
||
Private CurrentItem, TotalItems
|
||
Public ChannelRSSURI, ChannelURL, ChannelTitle, ChannelDesc, ChannelLanguage
|
||
Public ImageTitle, ImageLink, ImageURL
|
||
Public TextInputURL, TextInputTitle, TextInputDesc, TextInputName
|
||
public Status
|
||
|
||
'>>>>>>>> Setup Initialize event, called automtially when creating an instant of this class using
|
||
' Set rss = new kwRSS_reader
|
||
Private Sub Class_Initialize
|
||
CurrentItem = -1
|
||
TotalItems = -1
|
||
Redim Items(2, 10) '1st dimension = item's title/link/desc, 2nd dimension the item number
|
||
Status = rssInit
|
||
End Sub
|
||
|
||
'>>>>>>>> Setup Terminate event, called automtially when killing an instant of this class using
|
||
' Set rss = nothing
|
||
Private Sub Class_Terminate
|
||
Erase Items
|
||
End Sub
|
||
|
||
'>>>>>>>> Load an RSS/RDF file and process it.
|
||
Public Function ParseLocation(URL)
|
||
|
||
rssname = stripBadChars(url)
|
||
|
||
wscript.echo "Rssname : " & rssname
|
||
|
||
rssupdate = true
|
||
|
||
'application(rssname & "time") = cdate("1974-10-24")
|
||
|
||
|
||
|
||
|
||
wscript.echo "Just about to retrieve the xml"
|
||
|
||
|
||
ChannelRSSURI = URL
|
||
set xmlObj = wscript.createobject("Msxml2.DOMDocument.3.0")
|
||
set xmlhttp= wscript.createobject("Msxml2.XMLHTTP.3.0")
|
||
|
||
|
||
'var xmlDoc = new ActiveXObject("MSXML2.DOMDocument.3.0");
|
||
|
||
|
||
|
||
wscript.echo "XML objects created...."
|
||
|
||
' xmlObj.validateOnParse = false
|
||
' xmlObj.async = false
|
||
' xmlObj.preserveWhiteSpace = false
|
||
'
|
||
' xmlhttp.open "GET", ChannelRSSURI, False
|
||
' xmlhttp.send
|
||
' rssXML_Data = xmlhttp.responseXML.xml
|
||
|
||
wscript.echo "retrieved news "
|
||
|
||
|
||
xmlObj.validateOnParse = false
|
||
xmlObj.async = false
|
||
xmlObj.preserveWhiteSpace = false
|
||
|
||
xmlhttp.open "GET", ChannelRSSURI, False
|
||
xmlhttp.send
|
||
|
||
|
||
|
||
rssXML_Data = xmlhttp.responseXML.xml
|
||
' rssXML_Data = application(rssname & "xml")
|
||
|
||
|
||
|
||
|
||
if len(rssXML_Data) = 0 then
|
||
Status = rssError
|
||
|
||
wscript.echo "<!-- RSS Status : " & status & " -->" & vbcrlf
|
||
wscript.echo "RSS Status : " & status & vbcrlf
|
||
|
||
Exit Function
|
||
|
||
end if
|
||
|
||
|
||
|
||
|
||
|
||
' --------- PHP-Nuke & PostNuke compatabilaty --------------------------------
|
||
rssXML_Data = replace(rssXML_Data, "<!DOCTYPE", "<!--DOCTYPE")
|
||
rssXML_Data = replace(rssXML_Data, "rss-0.91.dtd"">", "rss-0.91.dtd""-->")
|
||
' ----------------------------------------------------------------------------
|
||
xmlObj.loadXML(rssXML_Data)
|
||
|
||
|
||
If xmlObj.parseError.errorCode = 0 then
|
||
ValidLocation = true
|
||
else
|
||
ValidLocation = false
|
||
end if
|
||
set xmlhttp = nothing
|
||
|
||
if not ValidLocation then
|
||
Status = rssBadRSS
|
||
|
||
wscript.echo "<!-- RSS Status : " & status & " -->" & vbcrlf
|
||
'response.flush
|
||
|
||
Exit Function
|
||
end if
|
||
|
||
set rootNode = xmlObj.selectSingleNode("rdf:RDF")
|
||
if rootNode is nothing then
|
||
set rootNode = xmlObj.selectSingleNode("rss")
|
||
if rootNode is nothing then
|
||
Status = rssError
|
||
wscript.echo "<!-- RSS Status : " & status & " -->" & vbcrlf
|
||
'response.flush
|
||
|
||
else
|
||
Reader rootNode, 0.91
|
||
end if
|
||
else
|
||
Reader rootNode, 1.0
|
||
end if
|
||
|
||
set rootNode = nothing
|
||
set xmlObj = nothing
|
||
Status = rssOK
|
||
End Function
|
||
|
||
'>>>>>>>> Private sub to read the RSS/RDF according to its version
|
||
Private Sub Reader(rootNode, ver)
|
||
itemNum = -1
|
||
|
||
set SingleNode = rootNode.selectSingleNode("//channel/title")
|
||
if Not SingleNode is nothing then ChannelTitle = SingleNode.text
|
||
|
||
set SingleNode = rootNode.selectSingleNode("//channel/link")
|
||
if Not SingleNode is nothing then ChannelURL = SingleNode.text
|
||
|
||
set SingleNode = rootNode.selectSingleNode("//channel/description")
|
||
if Not SingleNode is nothing then ChannelDesc = SingleNode.text
|
||
|
||
set SingleNode = rootNode.selectSingleNode("//channel/language")
|
||
if Not SingleNode is nothing then ChannelLanguage = SingleNode.text
|
||
|
||
if ver = 1 then
|
||
set child = rootNode.selectSingleNode("image")
|
||
else
|
||
set child = rootNode.selectSingleNode("//channel/image")
|
||
end if
|
||
if not child is nothing then
|
||
set SingleNode = child.selectSingleNode("title")
|
||
if Not SingleNode is nothing then ImageTitle = SingleNode.text
|
||
|
||
set SingleNode = child.selectSingleNode("link")
|
||
if Not SingleNode is nothing then ImageLink = SingleNode.text
|
||
|
||
set SingleNode = child.selectSingleNode("url")
|
||
if Not SingleNode is nothing then ImageURL = SingleNode.text
|
||
end if
|
||
set child = nothing
|
||
|
||
if ver = 1 then
|
||
set child = rootNode.selectSingleNode("textinput")
|
||
else
|
||
set child = rootNode.selectSingleNode("//channel/textinput")
|
||
end if
|
||
if not child is nothing then
|
||
set SingleNode = child.selectSingleNode("title")
|
||
if Not SingleNode is nothing then TextInputTitle = SingleNode.text
|
||
|
||
set SingleNode = child.selectSingleNode("description")
|
||
if Not SingleNode is nothing then TextInputDesc = SingleNode.text
|
||
|
||
set SingleNode = child.selectSingleNode("name")
|
||
if Not SingleNode is nothing then TextInputName = SingleNode.text
|
||
|
||
set SingleNode = child.selectSingleNode("link")
|
||
if Not SingleNode is nothing then TextInputURL = SingleNode.text
|
||
end if
|
||
set child = nothing
|
||
|
||
set children = rootNode.selectNodes("//item")
|
||
TotalItems = children.length
|
||
for each child in children
|
||
itemNum = itemNum + 1
|
||
if itemNum > ubound(Items, 2) then
|
||
Redim Preserve Items(2, ubound(Items, 2) + 5)
|
||
end if
|
||
for each ItemChild in child.ChildNodes
|
||
select case ItemChild.baseName
|
||
case "title" Items(0, itemNum) = ItemChild.text
|
||
case "link" Items(1, itemNum) = ItemChild.text
|
||
case "description" Items(2, itemNum) = ItemChild.text
|
||
end select
|
||
next
|
||
next
|
||
if TotalItems > 0 then CurrentItem = 0
|
||
End Sub
|
||
|
||
'>>>>>>>> Returns the title of the the current item
|
||
Public Function GetTitle()
|
||
GetTitle = Items(0, CurrentItem)
|
||
End Function
|
||
|
||
'>>>>>>>> Returns the url/link of the the current item
|
||
Public Function GetLink()
|
||
GetLink = Items(1, CurrentItem)
|
||
End Function
|
||
|
||
'>>>>>>>> Returns the description of the the current item
|
||
Public Function GetDesc()
|
||
GetDesc = Items(2, CurrentItem)
|
||
End Function
|
||
|
||
'>>>>>>>> Goes to the next item
|
||
Public Function MoveNext
|
||
CurrentItem = CurrentItem + 1
|
||
End Function
|
||
|
||
'>>>>>>>> Goes to the first item
|
||
Public Function FirstItem
|
||
if TotalItems > 0 then
|
||
CurrentItem = 0
|
||
|
||
else
|
||
CurrentItem = -1
|
||
|
||
end if
|
||
End Function
|
||
|
||
'>>>>>>>> Checks if the current location is a valid item or not
|
||
Public Function ValidItem
|
||
if CurrentItem > -1 and CurrentItem < TotalItems then
|
||
ValidItem = true
|
||
else
|
||
ValidItem = false
|
||
end if
|
||
End Function
|
||
|
||
'>>>>>>>> Checks if we are at EOF or not
|
||
Public Function EOF
|
||
if CurrentItem < TotalItems then
|
||
EOF = false
|
||
else
|
||
EOF = true
|
||
end if
|
||
End Function
|
||
|
||
'>>>>>>>> Returns status of the class
|
||
Public Function GetStatus()
|
||
GetStatus = Status
|
||
end function
|
||
|
||
'>>>>>>>> Returns Image provided in the RSS/RDF file as a linked image.
|
||
Public Function GetImage()
|
||
if ImageURL <> "" then
|
||
if ImageLink <> "" then GetImage = "<a href=""" & ImageLink & """>"
|
||
GetImage = GetImage & "<img src=""" & ImageURL & """ alt=""" & ImageTitle & """ border=""0"" />"
|
||
if ImageLink <> "" then GetImage = GetImage & "</a>"
|
||
else
|
||
GetImage = ""
|
||
end if
|
||
end function
|
||
|
||
'>>>>>>>> Returns the code for the TextInput provided in the RSS/RDF file.
|
||
Public Function GetTextInput()
|
||
if TextInputURL <> "" then
|
||
GetTextInput = "<form method=""post"" action=""" & TextInputURL & """>" & vbCrLf & _
|
||
"<table>" & vbCrLf & _
|
||
"<tr>" & vbCrLf & _
|
||
" <td>" & TextInputDesc & "</td>" & vbCrLf & _
|
||
"</tr>" & vbCrLf & _
|
||
"<tr>" & vbCrLf & _
|
||
" <td><input type=""text"" name=""" & TextInputName & """ /></td>" & vbCrLf & _
|
||
"</tr>" & vbCrLf & _
|
||
"<tr>" & vbCrLf & _
|
||
" <td><input type=""submit"" value=""" & TextInputTitle & """ /></td>" & vbCrLf & _
|
||
"</tr>" & vbCrLf & _
|
||
"</table>" & vbCrLf & _
|
||
"</form>"
|
||
else
|
||
GetTextInput = ""
|
||
end if
|
||
end function
|
||
|
||
end class
|
||
|
||
|
||
|
||
|
||
|
||
sub showRSSNewsFeeds(rssNewsFeed,id)
|
||
|
||
|
||
' Example for reading RSS or RDF Site Summary files.
|
||
' The file is commented, to be as a simple manual as i hate to write manuals :)
|
||
' First thing to do is to include the rss reader file, as the first line above.
|
||
|
||
|
||
' First step is to create an instance of the class
|
||
Set RSS = new kwRSS_reader
|
||
|
||
' rssURL = "http://feeds.engadget.com/weblogsinc/engadget"
|
||
rssUrl = rssNewsFeed
|
||
|
||
|
||
wscript.echo rssurl
|
||
|
||
|
||
' Second step is to call the RSS parser with a valid RSS address.
|
||
' The address must be a full qualified internet address, not relative.
|
||
' Example on a valid address: http://www.kattanweb.com/webdev/rss.asp
|
||
' on error resume next
|
||
|
||
RSS.ParseLocation(rssURL)
|
||
|
||
If Err.Number <> 0 Then WScript.Echo "Problem with the news feed"
|
||
' Here you can get the needed variables.
|
||
' Available variables are:
|
||
' ChannelRSSURI, ChannelURL, ChannelTitle, ChannelDesc, ChannelLanguage
|
||
' ImageTitle, ImageLink, ImageURL
|
||
' TextInputURL, TextInputTitle, TextInputDesc, TextInputName
|
||
' for more information about each variable are in the writer example "write_rss.asp
|
||
|
||
' WScript.Echo "<h3><a href=""" & RSS.ChannelURL & """ lang=""" & RSS.ChannelLanguage & """ title=""" & RSS.ChannelDesc & """>" & cleanEllipse(RSS.ChannelTitle,20) & "</a></h3>"
|
||
' WScript.Echo "</td></tr><tr><td>"
|
||
|
||
'boxCaption = "<a href=""" & RSS.ChannelURL & """ lang=""" & RSS.ChannelLanguage & """ title=""" & RSS.ChannelTitle & " - " & RSS.ChannelDesc & """>" & cleanEllipse(RSS.ChannelTitle,20) & "</a>"
|
||
wscript.echo "RSS.status : " & RSS.status & "<br />"
|
||
|
||
if rss.status = 0 then
|
||
'call MakeHeadedBox(boxcaption, "100%",0)
|
||
|
||
|
||
' Some function available:
|
||
' [rss].FirstItem: will go to the first item in the rss file (not needed usually, as when the rss is parsed,
|
||
' the pointer will be on the first item.
|
||
' [rss].ValidItem: true/false according if the current item is a valid one (or exist)
|
||
|
||
rssItemCount = 0
|
||
|
||
Set objConn = wscript.CreateObject("ADODB.Connection")
|
||
Set objRec = wscript.CreateObject("ADODB.Recordset")
|
||
|
||
Set objAddConn = wscript.CreateObject("ADODB.Connection")
|
||
' Set objAddRec = wscript.CreateObject("ADODB.Recordset")
|
||
|
||
|
||
objConn.Open sqlServer
|
||
|
||
|
||
objAddConn.Open sqlServer
|
||
|
||
objAddConn.begintrans
|
||
|
||
' objAddRec.Open "ustructrssitems",objAddConn , adOpenStatic, adLockPessimistic, adCmdTable
|
||
|
||
'adOpenKeyset, adLockBatchOptimistic
|
||
|
||
'objAddRec.Open "ustructrssitems",objAddConn , adOpenKeyset, adLockBatchOptimistic
|
||
|
||
|
||
Set objAddRec= wscript.CreateObject("ADODB.Recordset")
|
||
|
||
objAddRec.ActiveConnection = objAddConn
|
||
objAddRec.CursorType = adOpenKeyset
|
||
objAddRec.LockType = adLockBatchOptimistic
|
||
objAddRec.Source = "ustructrssitems"
|
||
objAddRec.Open
|
||
|
||
|
||
|
||
|
||
|
||
|
||
while not RSS.EOF
|
||
' function available for items:
|
||
' [rss].GetTitle: gets the title of the item
|
||
' [rss].GetLink: gets the link of the item
|
||
' [rss].GetDesc: gets the description of the item %>
|
||
|
||
|
||
sqlstr = "select count(*) as cnt from ustructrssitems where titlehash = '" & MD5(RSS.GetTitle ) & "';"
|
||
|
||
wscript.echo sqlstr
|
||
|
||
set objRec = objConn.execute(sqlstr)
|
||
|
||
if not objrec.bof and not objrec.eof then
|
||
itemcount = objrec("cnt")
|
||
else
|
||
wscript.echo "fuck"
|
||
end if
|
||
|
||
|
||
wscript.echo"itemcount : " & itemcount
|
||
if cint(itemcount) = 0 then
|
||
|
||
wscript.echo "Adding..."
|
||
|
||
' addnewItem(objAddRec,id,rss.gettitle,rss.getlink,rss.getdesc)
|
||
|
||
|
||
objAddRec.addnew
|
||
|
||
objAddRec("feedid") = id
|
||
objAddRec("caption") = rss.gettitle
|
||
objAddRec("link") = rss.getlink
|
||
objAddRec("bodytext") = rss.getdesc
|
||
|
||
objAddRec("titlehash") = md5(rss.gettitle)
|
||
objAddRec("bodyhash") = md5(rss.getdesc)
|
||
|
||
objAddRec("readdt") = sqllongdate(now)
|
||
objAddRec("moddt") = sqllongdate(now)
|
||
|
||
|
||
|
||
If Err.Number <> 0 Then
|
||
|
||
wscript.echo "Insert Failed: " & Err.number & ", " & Err.Description
|
||
|
||
end if
|
||
|
||
end if
|
||
|
||
'objrec.clear
|
||
|
||
RSS.MoveNext
|
||
wend
|
||
|
||
|
||
objAddRec.Updatebatch
|
||
|
||
objAddConn.committrans
|
||
|
||
objAddRec.close
|
||
set objAddRec = nothing
|
||
|
||
|
||
objAddConn.close
|
||
set objAddConn = nothing
|
||
|
||
|
||
objrec.close
|
||
set objrec = nothing
|
||
|
||
objconn.close
|
||
set objconn = nothing
|
||
|
||
|
||
sqlstr = "update ustructrssfeeds set feedname='" & rss.channeltitle & "', feednamehash='" & md5(rss.channeltitle) & "',lastupdate='" & sqllongdate(now) & "' where feedid=" & id& ";"
|
||
|
||
wscript.echo sqlstr
|
||
|
||
|
||
|
||
Set objConn = wscript.CreateObject("ADODB.Connection")
|
||
objConn.Open sqlServer
|
||
|
||
objConn.execute(sqlstr)
|
||
|
||
|
||
|
||
objconn.close
|
||
set objconn = nothing
|
||
|
||
|
||
|
||
' [rss].GetTextInput: gets the textinput search box, using a simple table.
|
||
' if you don't want the default form, make your own one using the TextInputURL, TextInputTitle,
|
||
' TextInputDesc, TextInputName variables
|
||
if RSS.GetTextInput <> "" then
|
||
wscript.echo RSS.GetTextInput
|
||
end if
|
||
|
||
|
||
|
||
|
||
|
||
|
||
' [rss].GetImage: gets the image with link (if available)
|
||
' if you don't want the default style, make your own one using the ImageTitle, ImageLink, ImageURL variables
|
||
if RSS.GetImage <> "" then
|
||
' WScript.Echo RSS.GetImage
|
||
end if
|
||
|
||
' Setting RSS to nothing will free the memory
|
||
Set RSS = nothing
|
||
'call closebox()
|
||
|
||
'response.flush
|
||
end if
|
||
end sub
|
||
|
||
|
||
function SQLLongDate(olddate)
|
||
|
||
dy = day(cdate(olddate))
|
||
mn = month(cdate(olddate))
|
||
yr = year(cdate(olddate))
|
||
|
||
mh = hour(cdate(olddate))
|
||
mm = minute(cdate(olddate))
|
||
ss = second(cdate(olddate))
|
||
|
||
if len(mh) <= 1 then mh = "0" & mh
|
||
if len(mm) <= 1 then mm = "0" & mm
|
||
if len(ss) <= 1 then ss = "0" & ss
|
||
|
||
'response.write "Day : " & dy & "<BR>" & vbcrlf
|
||
'response.write "Month : " & mn & "<BR>" & vbcrlf
|
||
'response.write "Year : " & yr & "<BR>" & vbcrlf
|
||
'mv = mn & "/" & dy & "/" & yr
|
||
mv= yr & "-" & mn & "-" & dy & " "
|
||
|
||
mv = mv & mh & ":" & mm & ":" & ss
|
||
|
||
SQLLongDate = mv
|
||
|
||
end function
|
||
|
||
|
||
|
||
|
||
sub addnewitem(sqlconnection,feedid,itemtitle,itemlink,itemdesc)
|
||
|
||
|
||
wscript.echo "Adding..."
|
||
sqlconnection.addnew
|
||
|
||
|
||
sqlconnection("feedid") = feedid
|
||
sqlconnection("caption") = itemtitle
|
||
sqlconnection("link") = itemlink
|
||
sqlconnection("bodytext") = itemdesc
|
||
|
||
sqlconnection("titlehash") = md5(itemtitle)
|
||
sqlconnection("bodyhash") = md5(itemdesc)
|
||
|
||
|
||
sqlconnection("readdt") = sqllongdate(now)
|
||
sqlconnection("moddt") = sqllongdate(now)
|
||
|
||
|
||
|
||
|
||
|
||
|
||
|
||
end sub
|
||
|
||
|
||
|
||
function StripHTML(ByRef asHTML)
|
||
Dim loRegExp ' Regular Expression Object
|
||
|
||
' Create built In Regular Expression object
|
||
Set loRegExp = New RegExp
|
||
loRegExp.Global = True
|
||
' Set the pattern To look For HTML tags
|
||
loRegExp.Pattern = "<[^>]*>"
|
||
|
||
' Return the original String stripped of HTML
|
||
StripHTML = loRegExp.Replace(asHTML, "")
|
||
|
||
' Release object from memory
|
||
Set loRegExp = Nothing
|
||
End function
|
||
|
||
|
||
|
||
function numbersOnly(ival)
|
||
|
||
notallwd = "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ!<21>$%^&*()_+=[]{}#~<>?/\`'.,"
|
||
allwd = "01234567890"
|
||
|
||
|
||
l = len(ival)
|
||
|
||
ws = ""
|
||
|
||
for t = 1 to l
|
||
|
||
|
||
cc = mid(ival,t,1)
|
||
|
||
if instr(allwd,cc) > 0 then ws = ws & cc
|
||
|
||
|
||
next
|
||
|
||
|
||
numbersonly = ws
|
||
|
||
|
||
end function
|
||
|
||
|
||
|
||
sub GatherRSS()
|
||
|
||
Set objConn = wscript.CreateObject("ADODB.Connection")
|
||
Set objRec = wscript.CreateObject("ADODB.Recordset")
|
||
|
||
|
||
objConn.Open sqlServer
|
||
|
||
|
||
sqlstr = "select * from ustructrssfeeds where lastupdate < '" & sqllongdate(dateadd("h",-1,now)) & "' or lastupdate is null;"
|
||
|
||
wscript.echo sqlstr
|
||
|
||
set objRec = objConn.execute(sqlstr)
|
||
|
||
|
||
if not objRec.bof and not objrec.eof then
|
||
|
||
do while not objrec.eof
|
||
wscript.echo "GO!"
|
||
feedid = objrec("feedid")
|
||
|
||
feedurl = objrec("feedurl")
|
||
|
||
call showRSSNewsFeeds(feedurl,feedid)
|
||
|
||
objrec.movenext
|
||
|
||
loop
|
||
|
||
end if
|
||
end sub
|
||
|
||
|
||
sub GetNew()
|
||
|
||
ChannelRSSURI = "http://www.taggrr.com/updaterss.asp"
|
||
|
||
set xmlhttp= wscript.createobject("Msxml2.XMLHTTP.3.0")
|
||
|
||
|
||
|
||
xmlhttp.open "POST", ChannelRSSURI, False
|
||
xmlhttp.send
|
||
|
||
|
||
|
||
WScript.Echo xmlhttp.responsetext
|
||
|
||
|
||
end sub
|
||
|
||
WScript.Echo "RSS UpdaterII"
|
||
|
||
|
||
call GetNew()
|