
laatste aanpassing
para: nee van planet.nl/news
{news.vbs}
TMP_FILE = "DutchNews.tmp" 'the name of the temp file you want to use for the script
SITE_URL = "http://www.planet.nl/news/" 'the url of the site you want to get your data from
PAGE_CHECK = "<title>Planet" 'a string to verify that you have got the right page
FIRST_CHECK = "<td class=""m"" valign=""top"" width=""30"">" 'find the line of the posttime of the headline
FIRST_CHECK2 = "<td class=""m"" valign=""top"" width=""30"">" 'the code before the posttime of the headline
END_CHECK = "</td>" 'the code after the posttime of the headline
hl_FIRST_CHECK = "<td valign=""top"" width=""100%""><a href=""/planet/show/id=" 'find the line of the headline
hl_FIRST_CHECK2 = "return true;"" onmouseout=""window.status=''; return true;"">" 'the code before the headline
hl_END_CHECK = "</a></td>" 'the code after the headline
Function GetInfo()
dim htmlResult,output,newsItem,mainFeature
htmlResult = ReturnHTML(SITE_URL)
output = NULL
startPos = instr(htmlResult, PAGE_CHECK)
if startPos > 0 then
Do While instr(startPos, htmlResult, FIRST_CHECK)>0
posOne = instr( startPos, htmlResult, FIRST_CHECK)
posOne = instr( posOne, htmlResult, FIRST_CHECK2) + Len(FIRST_CHECK2)
posTwo = instr( posOne, htmlResult, END_CHECK)
if posOne > 0 AND posTwo > posOne Then
'grab the time of the news item
newsItem = right(mid( htmlResult, posOne, posTwo-posOne ), posTwo-posOne)
end if
hl_posOne = instr( startPos, htmlResult, hl_FIRST_CHECK)
hl_posOne = instr( hl_posOne, htmlResult, hl_FIRST_CHECK2) + Len(hl_FIRST_CHECK2)
hl_posTwo = instr( hl_posOne, htmlResult, hl_END_CHECK)
if hl_posOne > 0 AND hl_posTwo > hl_posOne Then
'grab the headline of the news item
hl_newsItem = right(mid( htmlResult, hl_posOne, hl_posTwo-hl_posOne ), hl_posTwo-hl_posOne)
end if
' new start position
startPos = posTwo
'place the posttime of the headline and the headline in one line
newsline = newsItem & " " & hl_newsItem
'append the user to the list and put a newline char after it
output = output & newsline
' don't add a newline to the last item
If instr(startPos, htmlResult, FIRST_CHECK)>0 Then
output = output & (Chr(13) & Chr(10))
End If
Loop
else
output = "Could not obtain data."
end if
GetInfo = TrimHTML(output)
End Function
Function GetInfoTempFile()
set fs=CreateObject("Scripting.FileSystemObject")
set f=fs.CreateTextFile(TMP_FILE,true)
f.write(GetInfo())
f.close
set f=nothing
set fs=nothing
GetInfoTempFile = "OK!"
End Function
Private Function ReturnHTML(sURL)
Dim objXMLHTTP,HTML
Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
objXMLHTTP.Open "GET", sURL, False
objXMLHTTP.Send
HTML = objXMLHTTP.responseBody
Set objRS = CreateObject("ADODB.Recordset")
objRS.Fields.Append "txt", 200, 45000, &H00000080
objRS.Open
objRS.AddNew
objRS.Fields("txt").AppendChunk HTML
ReturnHTML = objRS("txt").Value
objRS.Close
Set objRS = Nothing
Set objXMLHTTP = Nothing
End Function
' ******************************
' Following function by Alderaic
' ******************************
'very simple function that will remove all html tags
Private Function TrimHTML(str)
pos_deb = InStr(1, str, "<")
Do Until pos_deb = 0
pos_fin = InStr(pos_deb, str, ">")
part_d = Mid(str, 1, pos_deb - 1)
part_f = Mid(str, pos_fin + 1, Len(str) - pos_fin)
str = part_d & part_f
pos_deb = InStr(1, str, "<")
Loop
TrimHTML = str
End Function
{news.vbs}
TMP_FILE = "DutchNews.tmp" 'the name of the temp file you want to use for the script
SITE_URL = "http://www.planet.nl/news/" 'the url of the site you want to get your data from
PAGE_CHECK = "<title>Planet" 'a string to verify that you have got the right page
FIRST_CHECK = "<td class=""m"" valign=""top"" width=""30"">" 'find the line of the posttime of the headline
FIRST_CHECK2 = "<td class=""m"" valign=""top"" width=""30"">" 'the code before the posttime of the headline
END_CHECK = "</td>" 'the code after the posttime of the headline
hl_FIRST_CHECK = "<td valign=""top"" width=""100%""><a href=""/planet/show/id=" 'find the line of the headline
hl_FIRST_CHECK2 = "return true;"" onmouseout=""window.status=''; return true;"">" 'the code before the headline
hl_END_CHECK = "</a></td>" 'the code after the headline
Function GetInfo()
dim htmlResult,output,newsItem,mainFeature
htmlResult = ReturnHTML(SITE_URL)
output = NULL
startPos = instr(htmlResult, PAGE_CHECK)
if startPos > 0 then
Do While instr(startPos, htmlResult, FIRST_CHECK)>0
posOne = instr( startPos, htmlResult, FIRST_CHECK)
posOne = instr( posOne, htmlResult, FIRST_CHECK2) + Len(FIRST_CHECK2)
posTwo = instr( posOne, htmlResult, END_CHECK)
if posOne > 0 AND posTwo > posOne Then
'grab the time of the news item
newsItem = right(mid( htmlResult, posOne, posTwo-posOne ), posTwo-posOne)
end if
hl_posOne = instr( startPos, htmlResult, hl_FIRST_CHECK)
hl_posOne = instr( hl_posOne, htmlResult, hl_FIRST_CHECK2) + Len(hl_FIRST_CHECK2)
hl_posTwo = instr( hl_posOne, htmlResult, hl_END_CHECK)
if hl_posOne > 0 AND hl_posTwo > hl_posOne Then
'grab the headline of the news item
hl_newsItem = right(mid( htmlResult, hl_posOne, hl_posTwo-hl_posOne ), hl_posTwo-hl_posOne)
end if
' new start position
startPos = posTwo
'place the posttime of the headline and the headline in one line
newsline = newsItem & " " & hl_newsItem
'append the user to the list and put a newline char after it
output = output & newsline
' don't add a newline to the last item
If instr(startPos, htmlResult, FIRST_CHECK)>0 Then
output = output & (Chr(13) & Chr(10))
End If
Loop
else
output = "Could not obtain data."
end if
GetInfo = TrimHTML(output)
End Function
Function GetInfoTempFile()
set fs=CreateObject("Scripting.FileSystemObject")
set f=fs.CreateTextFile(TMP_FILE,true)
f.write(GetInfo())
f.close
set f=nothing
set fs=nothing
GetInfoTempFile = "OK!"
End Function
Private Function ReturnHTML(sURL)
Dim objXMLHTTP,HTML
Set objXMLHTTP = CreateObject("Microsoft.XMLHTTP")
objXMLHTTP.Open "GET", sURL, False
objXMLHTTP.Send
HTML = objXMLHTTP.responseBody
Set objRS = CreateObject("ADODB.Recordset")
objRS.Fields.Append "txt", 200, 45000, &H00000080
objRS.Open
objRS.AddNew
objRS.Fields("txt").AppendChunk HTML
ReturnHTML = objRS("txt").Value
objRS.Close
Set objRS = Nothing
Set objXMLHTTP = Nothing
End Function
' ******************************
' Following function by Alderaic
' ******************************
'very simple function that will remove all html tags
Private Function TrimHTML(str)
pos_deb = InStr(1, str, "<")
Do Until pos_deb = 0
pos_fin = InStr(pos_deb, str, ">")
part_d = Mid(str, 1, pos_deb - 1)
part_f = Mid(str, pos_fin + 1, Len(str) - pos_fin)
str = part_d & part_f
pos_deb = InStr(1, str, "<")
Loop
TrimHTML = str
End Function
idd 
k zal het maar eerlijk zeggen
k loop gewoon een beetje te jennen 
dat .rar bestand was de no-cd crack voor Monster Garage. Onder die andere vlekken stont avant browser, een map van de save-games van Monster Garage en Traktor dj-studio 2. Rechts ondering draait eMule, winamp, quickcam en nav2004
heel wat anders dan jullie dachten hahahahaha 
k zal het maar eerlijk zeggen
dat .rar bestand was de no-cd crack voor Monster Garage. Onder die andere vlekken stont avant browser, een map van de save-games van Monster Garage en Traktor dj-studio 2. Rechts ondering draait eMule, winamp, quickcam en nav2004




























