' Готовим файл "Table of Contents_.hhc" для "HTML Help Workshop"' из файла "index.html/index.html", а то парит каждый раз оглавление ручками' делать...''... Просто запусти в каталоге с "index.html"'Автор Трошин Дмитрий, ака trdm 2007 год ' ICQ 308-779-620' ' © trdm 2007 GNUDim FSOSet FSO = CreateObject("Scripting.FileSystemObject")Dim TextStreamDim glTextStartDim glTextEndDim RESet RE = New RegExpRE.IgnoreCase = true RE.Global = TrueRE.Multiline = True' Нарисуем фрагмент оглавления....Function GetTextArticle( psLinkText, psTitleText, psIndent ) valRet = "" ' Пробел кодируется > '%20' tFileName = psLinkText if InStr(psLinkText,"#")>0 Then tFileName = Left(psLinkText,InStr(psLinkText,"#")-1) End IF tFileName = Replace(tFileName, "%20"," ") bFileExist = FSO.FileExists(tFileName) if bFileExist or Len(tFileName)=0 Then valRet = valRet + psIndent + " <LI> <OBJECT type=""text/sitemap"">" + vbcrlf valRet = valRet + psIndent + " <param name=""Name"" value="""+psTitleText+""">" + vbcrlf valRet = valRet + psIndent + " <param name=""Local"" value="""+psLinkText+""">" + vbcrlf valRet = valRet + psIndent + " </OBJECT>" + vbcrlf end if GetTextArticle = valRetEnd Function Private Function FindInStrEx (patrn, strng) FindInStrEx = "" on error resume next RE.Pattern = patrn ' Set pattern. Set Matches = RE.Execute(strng) ' Execute search. if err.number<>0 Then message Err.Description exit Function End If on error goto 0 RetStr = "" For Each Match in Matches ' Iterate Matches collection. if Len(RetStr)>0 Then RetStr = RetStr & vbCrLf & Match.Value else RetStr = Match.Value End if Next FindInStrEx = RetStrEnd FunctionFunction ReRelpace222(patrn, strng, strTo) ReRelpace = "" on error resume next RE.Pattern = patrn ' Set pattern. strng = RE.Replace(strng,strTo) if err.number<>0 Then message Err.Description exit Function End If on error goto 0 RetStr = "" ReRelpace = RetStrEnd FunctionSub MakeHelps2( psPath, psAllText) Set objIE = CreateObject("InternetExplorer.Application") objIE.Navigate psPath While objIE.Busy Wscript.Sleep 200 Wend set Document = objIE.Document set coll = document.all.tags("A") if Not IsObject(coll) Then exit sub end ifstop tPathDoc = Document.location.pathname ' "/D:/Progekts/chm/OpenNET_docs/_%20No_CHM/autoconf-prog/index.html" tPathDocA = Split(tPathDoc,"/") tPathDoc1 = "" for i=1 To UBound(tPathDocA)-1 tPathDoc1 = tPathDoc1 + tPathDocA(i) + "/" Next nnn = "" for i=0 to coll.length-1 set item = coll.item(i) nnn = nnn + item.title + vbcrlf ' item.href "file:///D:/Progekts/chm/OpenNET_docs/_%20No_CHM/XML-web/index.html#sec-bibliography" String 'item.outerText "Ссылки" String 'item.pathname "D:/Progekts/chm/OpenNET_docs/_%20No_CHM/XML-web/index.html" String ' Мне нужен путь относительно переданного, но только файлы, следовательно: If Left(item.href,8) = "file:///" Then textRef = Replace(item.href,"file:///","") textRef = Replace(textRef, tPathDoc1,"") ' теперь в textRef чистая ссылка... textTitle = item.outerText ' и в принцыпе можно запускать генерацию текста psAllText = psAllText + GetTextArticle( textRef, textTitle, " " ) End If nextEnd SubSub MakeHelps() strFileIndex = "index.html" strFileIndex2 = "Table of Contents_.hhc" For i = 1 to 2 if i = 1 Then strFileIndex = "index.html" Else strFileIndex = "index.htm" End If if Not FSO.FileExists(strFileIndex) Then 'MsgBox strFileIndex+" Not Exist" strFileIndex = "" else Exit For End If Next Set SvcService = CreateObject("Svcsvc.Service") strFileIndex = SvcService.SelectFile(False, ""+strFileIndex, "htm, html - files|*.*") if strFileIndex = "" Then MsgBox "File ''index.html'' or ''index.htm'' Not Exist!" exit Sub End If stop tText2 = "" Set TextStream2 = FSO.CreateTextFile(strFileIndex2) Set objFile = FSO.GetFile(strFileIndex) if Not LCase(objFile.Type) = "html document" Then Exit Sub Set TextStream1= objFile.OpenAsTextStream(1) tText2 = tText2 + GetTextArticle( strFileIndex, "Содержание","") tText2 = tText2 + " <UL>" + vbcrlf MakeHelps2 strFileIndex, tText2 TextStream2.Write glTextStart TextStream2.Write tText2 TextStream2.Write glTextEnd TextStream1.Close TextStream2.Close MsgBox "Готово!" + tTextAllLEnd Sub' Стартовый текст в *.hhcglTextStart = "<!DOCTYPE HTML PUBLIC ""-//IETF//DTD HTML//EN"">" + vbcrlfglTextStart = glTextStart + "<HTML>" + vbcrlfglTextStart = glTextStart + "<HEAD>" + vbcrlfglTextStart = glTextStart + "<meta name=""GENERATOR"" content=""Microsoft® HTML Help Workshop 4.1"">" + vbcrlfglTextStart = glTextStart + "<!-- Sitemap 1.0 -->" + vbcrlfglTextStart = glTextStart + "</HEAD><BODY>" + vbcrlfglTextStart = glTextStart + "<OBJECT type=""text/site properties"">" + vbcrlfglTextStart = glTextStart + " <param name=""Window Styles"" value=""0x800025"">" + vbcrlfglTextStart = glTextStart + "</OBJECT>" + vbcrlfglTextStart = glTextStart + "<UL>" + vbcrlfglTextEnd = glTextEnd + " </UL>" + vbcrlfglTextEnd = glTextEnd + "</UL>" + vbcrlfglTextEnd = glTextEnd + "</BODY></HTML>" + vbcrlfMakeHelps