'
' Seiru's SS Text Extractor
' by Mayuki Sawatari.
'
' $Id: extract.vbs,v 1.3 2002/01/24 21:44:24 Mayuki Sawatari Exp $
'
Option Explicit

Const cstrApplicationName = "がおがおせいるずえすえすてきすとえくすとらくたー。"
Const cstrMessageInputDest = "展開先フォルダ名を指定してくださいとか。"
Const cstrMessageErrorInvaildDest = "う〜、展開先フォルダが無効だよぉ。"
Const cstrMessageErrorCanNotCreateFolder = "展開先フォルダを作成できませんでした。すでにファイルが存在しているか、フォルダ名に無効な文字が含まれている可能性があります。"

' きどー。
Call Main


' /////////////////////////////////////////////////////////////////////////////
Sub Main()

    Dim fso
    Dim fldCurrent  ' カレントフォルダオブジェクト
    Dim fldDestDir
    Dim filFileItem 
    Dim tsHTML      ' 展開元
    Dim tsExtract   ' 展開先
    Dim strSource
    Dim strDestDir
    Dim lngCount
    Dim lngTimeStart
    Dim lngTimeEnd
    Dim regEx
    
    On Error Resume Next
    
    Set regEx = New RegExp
    With regEx
        .Pattern = "<[^>]*>"
        .Global = True
    End With
    
    Set fso = CreateObject("Scripting.FileSystemObject")
    Set fldCurrent = fso.GetFolder(".\")
    
    strDestDir = InputBox(cstrMessageInputDest, cstrApplicationName, "text")
    If strDestDir = "" Then
        MsgBox cstrMessageErrorInvaildDest, vbCritical, cstrApplicationName
        WScript.Quit 1
    End If
    
    Set fldDestDir = fso.GetFolder(".\" & strDestDir)
    If fldDestDir Is Nothing Then
        Set fldDestDir = fso.CreateFolder(".\" & strDestDir)
        If fldDestDir Is Nothing Then
            MsgBox cstrMessageErrorCanNotCreateFolder, vbCritical, cstrApplicationName
            WScript.Quit 1
        End If
    End If
    
    lngTimeStart = Timer
    For Each filFileItem In fldCurrent.Files
        If (StrComp(Left(filFileItem.Name, 2), "ss", 1) = 0) And _
           (StrComp(Right(filFileItem.Name, 3), "htm", 1) = 0) And _
           (Len(filFileItem.Name) > 6) Then
           
            Set tsHTML = fso.OpenTextFile(filFileItem.Path, 1)
            strSource = tsHTML.ReadAll
            strSource = Mid(strSource, InStrRev(strSource, "<pre>") + Len("<pre>") + 1)
            strSource = Replace(strSource, "<b>Return</b>", "")
            regEx.Pattern = "<[^>]*>"
            strSource = regEx.Replace(strSource, "")
            strSource = Replace(strSource, vbCrLf, vbCr)
            strSource = Replace(strSource, vbLf, vbCr)
            strSource = Replace(strSource, vbCr, vbCrLf)
            regEx.Pattern = "(\r\n){5,}"
            strSource = regEx.Replace(strSource, vbCrLf & vbCrLf)
            'strSource = Mid(strSource, 1, InStr(strSource, "<") - Len("<"))
            'strSource = Replace(strSource, vbCrLf & vbCrLf, vbCrLf)
            Set tsExtract = fso.OpenTextFile(".\text\" & filFileItem.Name & ".txt", 2, True)
            Call tsExtract.Write(strSource)
            lngCount = lngCount + 1
        End If
    Next
    lngTimeEnd = Timer
    
    Call MsgBox("たぶん" & CStr(lngCount) & "個のファイル変換かんりょー。" & vbCrLf & _
                "処理所要時間:" & FormatNumber(lngTimeEnd - lngTimeStart, 3) & "sec", vbInformation, cstrApplicationName)
End Sub