コメント一括削除 VBscript版

ソースファイルなどから、コメント部分を削除するスクリプトです

Deletecomment.vbs

 '============================================================
'コメント削除
' 2014/07/15
'指定されたフォルダに存在するフォルダ配下のファイルに対して、
'コメントを削除する。
'サブフォルダも対象としている。
'
'対象コメントは次の通り
' 	//
'   --
'	#
'	/*～*/
'コメントの種類を調整したい場合は
' IsStartcomment
' IsBreakecomment
'を調整の事

'起動方法 コマンドプロンプトより
'	>cscript Deletecomment.vbs c:\hogefolder


Const ForWriting = 2


Const spc1 =" "


'============================================================


'コマンドライン引数で対象フォルダ名が
'指定されているかをチェックします
If WScript.Arguments.Count = 1 Then

   '処理フォルダの有無をチェックします
   If FolderCheck(WScript.Arguments(0), strExecFolder) = False Then
      '見つからなかったときはエラーメッセージを表示し
      'プロシージャを終了します
      WScript.Echo "ERROR : 指定したフォルダは存在しません。 " & WScript.Arguments(0)
      WScript.Quit -1
   End If

Else
   'パラメタが正しく指定されていないときは、エラーメッセージを表示し
   'プロシージャを終了します
   	WScript.Echo "ERROR : パラメタを正しく指定してください。"
  	WScript.Quit -1
End If


'ファイル一覧を取得します
strList = sSearchFolderAll(strExecFolder)

'ファイルリストの処理
For Each strFileName In strList

	LoopMain(strFileName)
	
	WScript.Echo strFileName
Next




Function LoopMain(strFileName )
	
	inFilePath = strFileName
	outFilePath = inFilePath & ".tmp"
	
	
	
	Set fso = CreateObject("Scripting.FileSystemObject")
	
	
	'0：コメントではない
	'1：1行コメント
	'2：複数行コメント
	IsCommenting = 0
	
	IsMultiLineCommnet = False
	
	Set file = fso.OpenTextFile(inFilePath)
	Set outFile = fso.OpenTextFile(outFilePath,ForWriting,vbTrue)
	
	Do Until file.AtEndOfStream
		
		'1行単位で読み込む
		readLineBuf = file.ReadLine
		readLineSize = Len(readLineBuf) 
	
		'複数コメント継続中以外は、コメント中をリセットする
		If IsCommenting <> 2 Then
			IsCommenting = 0
		End If
	
		
		writeLineBuf = ""
		matchSize = 0
		
		Do While Len(readLineBuf) > 0
				
			If IsCommenting = 0 Then
				rtn = IsStartcomment(readLineBuf, matchSize)
				If rtn = 1 Then
					IsCommenting = 1
					Exit Do
				ElseIf rtn = 2 Then
					IsCommenting = 2
					writeLineBuf = writeLineBuf & spc1
					readLineBuf = Mid(readLineBuf, matchSize + 1)
				Else
					writeLineBuf = writeLineBuf & Left(readLineBuf, 1)
					readLineBuf = Mid(readLineBuf, 2)
					
				End If
			
			ElseIf IsCommenting = 2 Then
				rtn = IsBreakecomment(readLineBuf, matchSize)
				If rtn Then
					IsCommenting = 0
					readLineBuf = Mid(readLineBuf, matchSize + 1)
				Else	
					readLineBuf = Mid(readLineBuf, 2)
				End If
			End If
	
	
		Loop
		
		outFile.WriteLine(writeLineBuf)
		
		
	Loop
	
	file.Close
	outFile.Close
	
	
	'RENAMEする
	Call fso.DeleteFile(inFilePath,vbTrue)
	Call fso.MoveFile(outFilePath,inFilePath)
	


End Function


Function IsStartcomment(text,matchSize) 
	
	'0：コメントではない
	'1：1行コメント
	'2：複数行コメント
	wkRTN = 0
	matchSize = 0
	
	char1 = Left(text,1)
	
	Select Case char1
		
		
		Case "#"
			wkRTN = 1
			matchSize = 1
			
		Case "-"
			char2 = Mid(text , 2,1)
			If char2 = "-" Then
				wkRTN = 1
				matchSize = 2
			End If
					
		Case "/"
			char2 = Mid(text , 2,1)
			If char2 = "/" Then
				wkRTN = 1
				matchSize = 2
			ElseIf char2 = "*" Then
				wkRTN = 2
				matchSize = 2
			End If
			
		End Select
	
	IsStartcomment = wkRTN

End Function


Function IsBreakecomment(text,matchSize) 
	
	wkRTN = False	
	matchSize = 0
	
	char1 = Left(text,1)
	
	Select Case char1
		Case "*"
			char2 = Mid(text , 2,1)
			If char2 = "/" Then
				wkRTN = True
				matchSize = 2
			End If
	End Select

	IsBreakecomment = wkRTN
	
End Function



Function spc(size) 
		
	ret = ""
	ix = 0
	Do While i < size
		
		rtn = rtn& " "
		
		i = i + 1
	Loop

	spc = ret
	
End Function



'==============================================================
'= ファイルリストの取得(下の階層まで検索する)
'==============================================================
Function sSearchFolderAll(tmpExecFolder)

    Dim objApl
    Dim objFolder
    Dim strFileList()

    'Shellオブジェクトを作成します
    Set objApl = CreateObject("Shell.Application")

    '検索するフォルダのオブジェクトを作成します
    Set objFolder = objApl.Namespace(tmpExecFolder)

    'フォルダ検索処理を呼び出します
    Call sSearchFolderAll_Sub(objFolder.Items, strFileList)

    '戻り値にはファイルの一覧返します
    sSearchFolderAll = strFileList

    'オブジェクトの破棄
    Set objFolder = Nothing
    Set objApl = Nothing

End Function

'==============================================================
'= フォルダ内に含まれるファイルやフォルダを検索する(再帰呼び出し)
'= :sSearchFolderAllのサブルーチン
'==============================================================
Sub sSearchFolderAll_Sub(ByVal tmpFolderItems, ByRef tmpFileList)

    Dim objFolderItems
    Dim objItem
    Dim lngCount

    '配列の大きさを再度求める
    lngCount = 0
    On Error Resume Next
    lngCount = UBound(tmpFileList) + 1
    On Error Goto 0

    'フォルダ内を検索
    For Each objItem In tmpFolderItems

        '取り出した物がファイルかフォルダかを判定
        If objItem.IsFolder Then
           'フォルダであれば、Itemsオブジェクトを作り、
           'それを引数としてsSearchFolderAll_Subを「再帰呼び出し」します
           Set objFolderItems = objItem.GetFolder.Items
           Call sSearchFolderAll_Sub(objFolderItems, tmpFileList)

           '配列の大きさを再度求める
           lngCount = 0
           On Error Resume Next
           lngCount = UBound(tmpFileList) + 1
           On Error Goto 0

        Else
           'ファイルであれば、リストに格納します
           If Mid(objItem.Path, 2,1) = ":"  Or _
              Mid(objItem.Path, 2,2) = "\\" Then
              ReDim Preserve tmpFileList(lngCount)
              tmpFileList(lngCount) = objItem.Path
              lngCount = lngCount + 1
           End If

        End If

    Next

    Set objItem = Nothing
    Set objFolderItems = Nothing

End Sub


'==========================================================
'= フォルダの有無チェック
'==========================================================
Function FolderCheck(ByVal tmpPath, ByRef strPath)

    Dim objFS
    Dim strCheckPath

    FolderCheck = False

    Set objFS = CreateObject("Scripting.FilesystemObject")

    'チェックするフォルダのパス情報を作成（絶対パスに編集）
    strCheckPath = objFS.GetAbsolutePathName(tmpPath)

    '編集したパスでフォルダの有無をチェック
    If objFS.FolderExists(strCheckPath) = True Then
       FolderCheck = True
       strPath = strCheckPath 'パス情報を返す
    End If

    Set objFS = Nothing

End Function



'==========================================================
'= ファイル名を含むパスの場合のフォルダの有無チェック
'==========================================================
Function FileFolderCheck(ByVal tmpPath, ByRef strPath)

    Dim objFS
    Dim objPath
    Dim strCheckPath
    Dim strTmpPath

    FileFolderCheck = False

    Set objFS = CreateObject("Scripting.FilesystemObject")

    '絶対パスに編集
    strTmpPath = objFS.GetAbsolutePathName(tmpPath)

    'さらにファイルまでのフルパスからパス情報だけを取得
    strCheckPath = Replace(strTmpPath, objFS.GetFilename(strTmpPath), vbNullString)

    '編集したパスでフォルダの有無をチェック
    If objFS.FolderExists(strCheckPath) = True Then
       FileFolderCheck = True
       strPath = strTmpPath 'パス情報を返す
    End If

    Set objFS = Nothing

End Function