Delete submodule reference(s). D&D working directory to vbs

DeleteSubmodule.vbs

Option Explicit

Const CstStrGit = "C:\Program Files\Git\bin\git.exe"
Const CstStrAll = "*"

'引数取得
Dim ObjArgs, ObjUnnamed, StrWork
Set ObjArgs = WScript.Arguments
Set ObjUnnamed = ObjArgs.Unnamed
StrWork = ObjUnnamed(0)
Set ObjUnnamed = Nothing
Set ObjArgs = Nothing

'処理実行
Dim ObjModule
Set ObjModule = New ClsSubmodule
Call ObjModule.Run(StrWork)
Set ObjModule = Nothing
Call WScript.Quit(0)

Class ClsSubmodule
	Private PriObjFSO
	Private PriObjShell
	Private PriObjReg
	
	'コンストラクタ
	Private Sub Class_Initialize()
		Set PriObjFSO   = WScript.CreateObject("Scripting.FileSystemObject")
		Set PriObjShell = WScript.CreateObject("WScript.Shell")
		Set PriObjReg   = New RegExp
			PriObjReg.Pattern = "([0-9a-f]{40})\s+([^\s]+)"
	End Sub
	
	Public Sub Run(ByVal StrWork)
		'ワーキングディレクトリが妥当か確認
		If Not Check(StrWork) Then
			Call Error(1, "ワーキングディレクトリエラー", "ディレクトリが存在しないか、Submoduleがないリポジトリです")
		End If
		PriObjShell.CurrentDirectory = StrWork
		
		'Submoduleリストを取得
		Dim ObjModules
		Set ObjModules = GitModules()
		If ObjModules.Count = 0 Then
			Call Error(1, "Submoduleが壊れています", ".gitmodulesがあるのにsubmoduleがありません")
		End If
		
		'削除するSubmoduleを入力
		Dim StrDelete
		StrDelete = InputBox(Join(ObjModules.Keys, vbCrLf), "削除するSubmoduleを入力（" & CstStrAll & "で全て）")
		If StrDelete = "" Then
			Call WScript.Quit(0)
		End If
		If Not ObjModules.Exists(StrDelete) And StrDelete <> CstStrAll Then
			Call Error(1, "Submodule指定エラー", "入力したSubmoduleは見つかりませんでした")
		End If
		
		'Submodule削除処理
		Dim StrModule
		For Each StrModule In ObjModules.Keys
			If StrModule = StrDelete Or StrDelete = CstStrAll Then
				If GitDeinit(StrModule) Then
					Call Debug.WriteLine(StrModule & "(" & ObjModules(StrModule) & ")削除成功")
				End If
			End If
		Next
		
		'Submoduleがなくなれば.gitmodulesを削除
		Set ObjModules = Nothing
		Set ObjModules = GitModules()
		If ObjModules.Count = 0 Then
			Dim IntCode, StrOut, StrErr
			IntCode = Git(StrOut, StrErr, "rm -f .gitmodules")
			If IntCode <> 0 Or StrErr <> "" Then
				Call Error(IntCode, StrModule & "rm .gitmoduleでエラー", StrErr)
			End If
		End If
	End Sub
	
	'入力引数のチェック
	Private Function Check(ByVal StrWork)
		Check = False
		
		If PriObjFSO.FolderExists(StrWork) Then
			If PriObjFSO.FileExists(PriObjFSO.BuildPath(StrWork, ".gitmodules")) Then
				Check = True
			End If
		End If
	End Function
	
	'Gitコマンド実行
	Private Function Git(ByRef StrStdOut, ByRef StrStdErr, ByVal StrArgument)
		Dim ObjStatus, ObjStdOut, ObjStdErr
		Set ObjStatus = PriObjShell.Exec("""" & CstStrGit & """ " & StrArgument)
		Git = ObjStatus.ExitCode
		
		Set ObjStdOut = ObjStatus.StdOut
		StrStdOut = Replace(Replace(ObjStdOut.ReadAll(), vbCrLf, vbLf), vbCr, vbLf)
		Set ObjStdOut = Nothing
		Set ObjStdErr = ObjStatus.StdErr
		StrStdErr = Replace(Replace(ObjStdErr.ReadAll(), vbCrLf, vbLf), vbCr, vbLf)
		Set ObjStdErr = Nothing
		Set ObjStatus = Nothing
	End Function
	
	'Submoduleリスト取得
	Private Function GitModules()
		Dim IntCode, StrOut, StrErr
		Dim StrLine, ObjMatches, ObjMatch, ObjSubmatches
		
		Set GitModules = WScript.CreateObject("Scripting.Dictionary")
		IntCode = Git(StrOut, StrErr, "submodule status")
		If IntCode <> 0 Or StrErr <> "" Then
			Call Error(IntCode, "Submodule取得エラー", StrErr)
		End If
		For Each StrLine In Split(StrOut, vbLf)
			Set ObjMatches = PriObjReg.Execute(StrLine)
			If ObjMatches.Count = 1 Then
				Set ObjMatch = ObjMatches(0)
				Set ObjSubmatches = ObjMatch.Submatches
				Call GitModules.Add(ObjSubmatches(1), ObjSubmatches(0))
				Set ObjSubmatches = Nothing
				Set ObjMatch = Nothing
			End If
			Set ObjMatches = Nothing
		Next
	End Function
	
	'Deinit実行
	Private Function GitDeinit(StrModule)
		Dim IntCode, StrOut, StrErr
		
		GitDeinit = False
		IntCode = Git(StrOut, StrErr, "submodule deinit -f """ & StrModule & """")
		If IntCode <> 0 Or StrErr <> "" Then
			Call Error(IntCode, StrModule & " deinitでエラー", StrErr)
		End If
		IntCode = Git(StrOut, StrErr, "rm -f """ & StrModule & """")
		If IntCode <> 0 Or StrErr <> "" Then
			Call Error(IntCode, StrModule & " rmでエラー", StrErr)
		End If
		GitDeinit = True
	End Function
	
	'エラー表示
	Private Sub Error(IntCode, StrTitle, StrMessage)
		Call MsgBox(StrMessage, vbOKOnly + vbCritical, StrTitle)
		Call WScript.Quit(IntCode)
	End Sub
	
	'デストラクタ
	Private Sub Class_Terminate()
		Set PriObjReg   = Nothing
		Set PriObjShell = Nothing
		Set PriObjFSO   = Nothing
	End Sub
End Class