3d_models_viewer/update_models.vbs at main · Mandrew3d/3d_models_viewer · GitHub

1
2
3
4
5
6
7
8
9
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
78
79
80
81
82
83
84
85
86
87
88
89
' update_models.vbs
' Автоматически добавляет новые .glb модели в viewer.html
' Работает при двойном клике, без консоли

Option Explicit

Dim fso, htmlPath, modelPath, htmlText, modelFile, modelName
Dim htmlFile, modelFolder, matches, existingLinks
Dim newLinks, linkText, updatedHtml

Set fso = CreateObject("Scripting.FileSystemObject")

' Пути
htmlPath = fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), "viewer.html")
modelPath = fso.BuildPath(fso.GetParentFolderName(WScript.ScriptFullName), "model")

' Проверки
If Not fso.FileExists(htmlPath) Then
  MsgBox "❌ Не найден файл viewer.html рядом со скриптом.", vbCritical, "Ошибка"
  WScript.Quit
End If

If Not fso.FolderExists(modelPath) Then
  MsgBox "❌ Не найдена папка model рядом со скриптом.", vbCritical, "Ошибка"
  WScript.Quit
End If

' Читаем HTML
Set htmlFile = fso.OpenTextFile(htmlPath, 1, False, 0)
htmlText = htmlFile.ReadAll
htmlFile.Close

' Ищем существующие ссылки
Set existingLinks = CreateObject("Scripting.Dictionary")
Dim regEx, matchesObj, m
Set regEx = New RegExp
regEx.Pattern = "href=""viewer/viewer\.html\?m=([^""]+)"""
regEx.Global = True

Set matchesObj = regEx.Execute(htmlText)
For Each m In matchesObj
  existingLinks.Add m.SubMatches(0), True
Next

' Ищем .glb файлы
Set modelFolder = fso.GetFolder(modelPath)
newLinks = ""

For Each modelFile In modelFolder.Files
  modelName = fso.GetFileName(modelFile)
  If LCase(Right(modelName, 4)) = ".glb" Then
    If Not existingLinks.Exists(modelName) Then
      linkText = "    <a href=""viewer/viewer.html?m=" & modelName & """ class=""model-link"">🧩 " & Replace(modelName, ".glb", "") & "</a>" & vbCrLf
      newLinks = newLinks & linkText
    End If
  End If
Next

If newLinks = "" Then
  MsgBox "✅ Новых моделей нет — viewer.html уже актуален.", vbInformation, "Готово"
  WScript.Quit
End If

' Находим блок для вставки
Dim patternOpen, patternClose, startPos, endPos
patternOpen = InStr(htmlText, "<div id=""modelList""")
patternClose = InStr(htmlText, "</div>")
If patternOpen = 0 Or patternClose = 0 Then
  MsgBox "❌ Не найден блок <div id=""modelList""> в viewer.html", vbCritical, "Ошибка"
  WScript.Quit
End If

Dim insertPos
insertPos = patternClose - 1
updatedHtml = Left(htmlText, insertPos - 1) & vbCrLf & newLinks & Mid(htmlText, insertPos)

' Сохраняем
Set htmlFile = fso.OpenTextFile(htmlPath, 2, False, 0)
htmlFile.Write updatedHtml
htmlFile.Close

MsgBox "✅ Добавлено новых моделей: " & CountLines(newLinks), vbInformation, "Успех"

' Подсчёт строк
Function CountLines(s)
  Dim lines
  lines = Split(Trim(s), vbCrLf)
  CountLines = UBound(lines) + 1
End Function