Bij mij krijg ik de laatste 2 weken mijn dagelijkse portie fokke en sukke niet meer te zien. Het script staat nog gewoon in de goede map, en er is niks aan veranderd, hij haalt alleen de stripjes niet op. Is dit bekend, of werkt hij bij anderen wel nog gewoon?
Dit is het script:
Function FokSuk_Image
Path = "C:\Program Files\Samurize\Scripts\" 'This is the path where the images are stored. Make sure you always end with '\'
Archief = 0 'If Archief=1 then the old images are not deleted from your PC
'************* BEGIN: COPY FOKSUK.NL TO TEXTFILE ***********************************
GetURL = "http://www.foksuk.nl"
Dim Http
Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
Http.Open "GET", GetURL, False
Http.Send
HtmlResult = Http.ResponseText
Set Http = Nothing
Set fs = CreateObject("Scripting.FileSystemObject")
Set File = fs.CreateTextFile(Path & "FokSuk.txt", True, False)
File.Write HtmlResult
File.Close
Set File = Nothing
Set fs = Nothing
'************* END: COPY FOKSUK.NL TO TEXTFILE *************************************
'************* BEGIN: FIND LINK IN TEXTFILE ****************************************
Set file_obj = CreateObject("Scripting.FileSystemObject")
Set file_path = file_obj.GetFile(Path & "FokSuk.txt")
Set File = file_path.OpenAsTextStream(1, -2)
GetFileContents = File.readall
Do While Not ZoekString = "imggif.php"
tel = tel + 1
ZoekString = Mid(GetFileContents, tel, 10)
teloud = tel
Loop
Do While Not ZoekChar = Chr(34)
tel = tel + 1
ZoekChar = Mid(GetFileContents, tel, 1)
Loop
ZoekString = Mid(GetFileContents, teloud, (tel - teloud))
File.Close
Set file_path = Nothing ' Resets variable
Set file_obj = Nothing ' Resets variable
FokSuk_Image = "http://www.foksuk.nl/" & ZoekString
'************* END: FIND LINK IN TEXTFILE ******************************************
'**************BEGIN: COPY IMAGE TO LOCAL PC ***************************************
Set Http = CreateObject("WinHttp.WinHttpRequest.5.1")
Http.Open "GET", FokSuk_Image, False
Http.Send
BinaryGetURL = Http.ResponseBody
Const adTypeBinary = 1
Const adSaveCreateOverWrite = 2
Dim BinaryStream
Set BinaryStream = CreateObject("ADODB.Stream")
BinaryStream.Type = adTypeBinary
BinaryStream.Open
BinaryStream.Write BinaryGetURL
If Archief = 1 Then BinaryStream.SaveToFile Path & "FokSuk_" & Date & ".gif", adSaveCreateOverWrite
BinaryStream.SaveToFile Path & "FokSuk.gif", adSaveCreateOverWrite
FokSuk_Image=Path & "FokSuk.gif"
Dim fso
Set fso = CreateObject("Scripting.FileSystemObject")
fso.DeleteFile(Path & "FokSuk.txt")
'**************END: COPY IMAGE TO LOCAL PC *****************************************
End Function
Ik ben zelf heel slecht in scripten dus kom niet ver. Als ik het script test in samurize krijg ik de melding:
[Error] - Ongeldige procedure-aanroep of ongeldig argument
In FokSuk.vbs (FokSuk_Image)
Line 18, column 4
[
Voor 95% gewijzigd door
Dav0s op 16-03-2006 23:10
]