フォルダ内の非SJIS文字を_に置き換える

fermeture.vbs

''' フォルダ内の非SJIS文字を_に置き換える
''' zip圧縮時の不正文字対策

Sub Main()

    If WScript.Arguments.Count <> 1 Then WScript.Quit

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim fn
    fn = WScript.Arguments(0)
    If fso.FolderExists(fn) = False Then WScript.Quit

    Dim st
    Set st = CreateObject("ADODB.Stream")
    st.Open
    st.Type = 2 ' adTypeText
    st.Charset = "UTF-8"

    Dim tmp
    Dim arr
    Dim tmpFolder, tmpFile
    
    If fso.FileExists(fn & "\fermeture.log") = False Then

        ' fermeture.logが存在しない場合、置換モード
        Call st.WriteText(Replace(ReplaceNonSJIS(fso.GetFolder(fn), True), fn & "\", ""))
        Call st.SaveToFile(fn & "\fermeture.log", 2) ' adSaveCreateOverWrite
        st.Close

    Else
        
        ' fermeture.logが存在する場合、復元モード
        Call st.LoadFromFile(fn & "\fermeture.log")

        If st.ReadText <> vbCrLf Then
            Call st.LoadFromFile(fn & "\fermeture.log")
            Do While Not st.EOS
                tmp = st.ReadText(-2) ' adReadLine
                arr = Split(tmp, vbTab)
                arr(0) = fn & "\" & arr(0)
                arr(1) = fn & "\" & arr(1)

                If fso.FolderExists(arr(1)) Then
                    Set tmpFolder = fso.GetFolder(arr(1))
                    tmpFolder.Name = fso.GetFileName(arr(0))
                ElseIf fso.FileExists(arr(1)) Then
                    Set tmpFile = fso.GetFile(arr(1))
                    tmpFile.Name = fso.GetFileName(arr(0))
                End If
            Loop

            st.Close
            Call fso.DeleteFile(fn & "\fermeture.log", True)
        Else
            ' fermeture.logが空の場合
            st.Close
            Call fso.DeleteFile(fn & "\fermeture.log", True)
        End If

    End If

    Set fso = Nothing
    Set st = Nothing

End Sub

''' フォルダを再帰で探り、非SJISファイル名を置換する
Private Function ReplaceNonSJIS(ByVal objFolder, ByVal boolEnableReplace)
    
    Dim objNextFolder, objNextFile

    Dim fn
    Dim tmp
    Dim buf
    buf = ""

    For Each objNextFolder In objFolder.SubFolders

        fn = objNextFolder.Name

        If NameAvailable(fn) = False Then

            tmp = ReplaceFolderName(objFolder, fn)
            If boolEnableReplace Then objNextFolder.Name = tmp

        End If

        buf = buf & ReplaceNonSJIS(objNextFolder, boolEnableReplace)

        ' 復元時に、フォルダ名を先に復元してしまうとファイルを追えない
        If NameAvailable(fn) = False Then
            buf = buf & objFolder.Path & "\" & fn & vbTab
            buf = buf & objFolder.Path & "\" & tmp & vbCrLf
        End If
    Next

    For Each objNextFile In objFolder.Files
        
        fn = objNextFile.Name

        If NameAvailable(fn) = False Then

            buf = buf & objFolder.Path & "\" & fn & vbTab
            tmp = ReplaceFileName(objFolder, fn)
            If boolEnableReplace Then objNextFile.Name = tmp
            buf = buf & objFolder.Path & "\" & tmp & vbCrLf

        End If
    Next

    ReplaceNonSJIS = buf
    
End Function

''' fnがSJIS文字のみで構成されている場合にTrue
Private Function NameAvailable(ByVal fn)
    Dim i
    For i = 1 To Len(fn)

        ' Asc関数がSJISにない文字を判定する戻り値はChr(63)
        If (Mid(fn, i, 1) <> Chr(63)) And (Asc(Mid(fn, i, 1)) = Asc(Chr(63))) Then
            NameAvailable = False
            Exit Function
        End If
    Next
    NameAvailable = True
End Function

''' fnの非SJIS文字を"_"に置換する
Private Function ReplaceFileName(ByVal objFolder, ByVal fn)

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim i
    Dim tmp
    tmp = fn

    For i = 1 To Len(tmp)
        If (Mid(tmp, i, 1) <> Chr(63)) And (Asc(Mid(tmp, i, 1)) = Asc(Chr(63))) Then
            tmp = Replace(tmp, Mid(tmp, i, 1), "_")
        End If
    Next

    Do While True
        If fso.FileExists(objFolder.Path & "\" & tmp) = False Then
            ReplaceFileName = tmp
            Exit Do
        Else
            tmp = "_" & tmp
        End If
    Loop

    Set fso = Nothing
End Function

Private Function ReplaceFolderName(ByVal objFolder, ByVal fn)

    Dim fso
    Set fso = CreateObject("Scripting.FileSystemObject")

    Dim i
    Dim tmp
    tmp = fn

    For i = 1 To Len(tmp)
        If (Mid(tmp, i, 1) <> Chr(63)) And (Asc(Mid(tmp, i, 1)) = Asc(Chr(63))) Then
            tmp = Replace(tmp, Mid(tmp, i, 1), "_")
        End If
    Next

    Do While True
        If fso.FolderExists(objFolder.Path & "\" & tmp) = False Then
            ReplaceFolderName = tmp
            Exit Do
        Else
            tmp = "_" & tmp
        End If
    Loop

    Set fso = Nothing
End Function

Call Main