~siggi-bjarnason/siggivbscript/vbscript

Option Explicit

Dim FileObj, fso, strOutFileName, objFileOut, HTTP, strDeadLinkFolder

Dim WshShell, strFavorite, strDocuments, subfolder, subfiles, subFlds2, fld2

 

set WshShell = WScript.CreateObject("WScript.Shell")

strFavorite = WshShell.SpecialFolders("Favorites")

strDocuments = WshShell.SpecialFolders("MyDocuments")

 

strOutFileName = "FavoritesValidation.log"

 

strDeadLinkFolder = "DeadLinks"

 

Set fso = CreateObject("Scripting.FileSystemObject")

Set objFileOut = fso.createtextfile(strDocuments & "\" & strOutFileName)

Set HTTP = CreateObject("Microsoft.XMLHTTP")

 

FolderContent strFavorite

 

Sub FolderContent (strCurrentFolder)

        Dim folder, files, file, subFlds, fld, strPath, strLine, strLineParts, bFoundURL

 

        Set folder = fso.GetFolder(strCurrentFolder)

        strPath = mid(folder.path, len(strFavorite)+2)

        if strPath <> "" then strPath = strPath & "\"

        Set files = folder.Files

        Set subFlds = folder.SubFolders

        

        For Each file in files

                if file.name <> "desktop.ini" then

                        bFoundURL = false

'                       wscript.echo "Opening " & file.path '& "\" & file.name

                        Set FileObj = fso.opentextfile(file.path)

'                       writeout strpath & file.name

                        While not fileobj.atendofstream

                                strLine = Trim(FileObj.readline)

                                strLineParts = split (strLine, "=")

                                If strLineParts(0) = "URL" Then

'                                       wscript.echo "testing URL " & strLineParts(1)

                                on error resume next

                                        HTTP.Open "GET", strLineParts(1), False

                                        HTTP.Send

                                        if Err.Number > 0 then

                                                writeout strpath & file.name & "; " & strLineParts(1) & "; " & Err.Number & Err.Description

                                        else

                                                writeout strpath & file.name & "; " & strLineParts(1) & "; " & HTTP.statusText

                                        end if

                                on error goto 0

                                        If HTTP.statusText <> "OK" Then

'                                               writeout strLineParts(1) & " is not OK, moving to c:\" & strDeadLinkFolder & "\" & file.name

'                                               file.copy ("c:\" & strDeadLinkFolder & "\" & file.name)

'                                               file.move ("c:\" & strDeadLinkFolder & "\" & file.name)

'                                               file.delete (true)

'                                               fso.movefile file.path, "c:\" & strDeadLinkFolder & "\" & file.name

                                        End If

                                        bFoundURL = true

                                End If 

                        Wend

                        if bFoundURL = false Then

                                writeout "Couldn't find URL in " & file.path & "\" & file.name

                        End If

                End if

        Next

        For Each fld in subFlds

                FolderContent fld

        Next

End Sub

 

Sub writeout (msg)

        

        wscript.echo msg

        objFileOut.writeline msg

 

End Sub