Back to Home: 
01
02
03
04
05
06
07
08
09
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77

Dim fso, objWBD, wbDoc, oListFiles, folder
Dim Files, File, oAnchors, iIndex
Dim oNextElement, arrParts, arrItem, PointToListFile
Dim ListTextStream

sShortURL = "": sPathName = "": S = ""
sRemotePath = ""
Set fso = CreateObject("Scripting.FileSystemObject")
Set objWBD = WScript.CreateObject("wshWebBrowserDialog.ucWBD", "oWBD_")
PathToTempFile = "V:\nvz\forum\0\tree"
objWBD.Navigate PathToTempFile
Set wbDoc = objWBD.Document
Set oListFiles = CreateObject("Scripting.Dictionary")
Set folder = fso.GetFolder("V:\nvz\forum\0\")
Set Files = folder.Files
For Each File In Files
  oListFiles.Add File.Name, ""
Next
Set oAnchors = wbDoc.anchors
Dim N: N = oAnchors.length
iFlag = 0
Do 
   Set oAnchor = oAnchors.Item(N-1)
   sShortURL = oAnchor.name
   If oListFiles.Exists(sShortURL) Then
     'Specified File exists.
   Else
    iFlag = iFlag + 1
     'Specified File doesn't exist
     If oAnchor.nextSibling.protocol = "file:" Then
        sPathName = oAnchor.nextSibling.pathname
        Else
        iIndex = oAnchor.sourceIndex + 1
        Do 
           Set oNextElement = WbDoc.all(iIndex)
           If oNextElement.protocol = "file:" Then Exit Do
           iIndex = iIndex + 1
        Loop While iIndex < 20000
        sPathName = oNextElement.pathname
     End If
     arrParts = Split(sPathName, ":")
     arrItem = Split(arrParts(UBound(arrParts)), "\")
     sRemotePath = Join(arrItem, "/")
     S = S & ";" & vbCrLf & "StoreIn=V:\nvz\forum\0\" & vbCrLf _
         & "Url=http://web.referent.ru" & sRemotePath  & vbCrLf
   End If
   N = N - 1
Loop Until N = 0
Dim Btn1
If iFlag > 0 Then
Btn1 = MsgBox ("In the file does not work  " & iFlag & "  links." & vbCrLf & _
                "Do you want to get list of all such items?	", 68)
        If Btn1 = 7 Then 
          Call ExitScript
        Else
            pathToList = "V:\nvz\forum\0\_!_.wrg"
            fso.CreateTextFile pathToList
            Set PointToListFile = fso.GetFile(pathToList)
            Set ListTextStream = PointToListFile.OpenAsTextStream(8,-2)
            ListTextStream.Write s 
            ListTextStream.close
            MsgBox "Done! URL of all non-exists files write to this list: _!_.wrg"
           Call ExitScript
        End If
Else
       MsgBox "ALL links worked properly!"
       Call ExitScript
End If
'------------------------clean up and exit--------------------------------->
Sub ExitScript()       
Set oNMD = Nothing
Set wbDoc = Nothing
Set objWBD = Nothing
Set fso = Nothing                  
WScript.Quit 0' end of script
End Sub
'<--------------------------------------------------------------------------

Используются технологии uCoz