Option Explicit

Const oldCaDn = "CN=netNACCS. Secure Client CA, O=Nippon Automated Cargo And Port Consolidated System, Inc."
Const newCaDn = "CN=netNACCS. Secure Client CA, OU=G2, O=Nippon Automated Cargo And Port Consolidated System, Inc."
Const TITLE01 = "デジタル証明書削除ツール"
Dim MSG01  : MSG01  = "以下の旧証明書を削除しますか？"
Dim MSG01a : MSG01a = "証明書："
Dim MSG01b : MSG01b = "有効期限："
Dim MSG02  : MSG02  = "以下の旧証明書を削除しました。"
Dim MSG02a : MSG02a = MSG01a
Dim MSG02b : MSG02b = MSG01b
Dim MSG02c : MSG02c = vbCrLf & "他の旧証明書が残っていますので、" & vbCrLf & "削除画面に戻ります。"
Dim MSG03  : MSG03  = "削除する旧証明書がないため" & vbCrLf & "削除処理は必要ありません。"
Dim MSG04  : MSG04  = "旧証明書の削除を中止しました。"
Dim MSG05  : MSG05  = "旧証明書の削除が完了しました。"
Dim MSG91  : MSG91  = "旧証明書を自動で削除できませんでした。" & vbCrLf & "デジタル証明書更新手順書に従い、" & vbCrLf & "「手動による旧証明書の削除」を実施してください。"

Class objCertUtil
    Public num
    Public seq
    Public notafter
    Public cn
    Public issuer
    Public newcerts
    Public newcertNum
    Public removable
    Public isRemovable
    Public certUtilSuccess

    Public Sub Class_Initialize()
        num = 0
        ReDim seq(0)
        ReDim notafter(0)
        ReDim cn(0)
        ReDim issuer(0)
        ReDim newcerts(0)
        newcertNum = 0
        removable = 0
        isRemovable = False
        certUtilSuccess = False
    End Sub

    Public Sub removeCert(Iseq)
        certUtilSuccess = False
        Dim certUtilCmd, str
        certUtilCmd = "certutil -user -delstore My " & Iseq
        Dim WshShell, outExec, outStream, strOut
		Set WshShell = CreateObject("WScript.Shell")
		On Error Resume Next
		Set outExec = WshShell.Exec(certUtilCmd)
		If Err.Number <> 0 Then MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
		On Error Goto 0
		Set outStream = outExec.StdOut
		Do
            str = outStream.ReadLine()
            If str = "CertUtil: -delstore コマンドは正常に完了しました。" Then
                certUtilSuccess = True
            End If
        Loop While str <> "" And Not outStream.AtEndOfStream

    End Sub

    Public Sub loadCsp()
        Class_Initialize()
        certUtilSuccess = False
        Dim WshShell, outExec, outStream
		Set WshShell = CreateObject("WScript.Shell")
		On Error Resume Next
		Set outExec = WshShell.Exec("certutil -user -store My ")
		If Err.Number <> 0 Then MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
		On Error Goto 0
		Set outStream = outExec.StdOut


		Do While Not outStream.AtEndOfStream
            Dim str, regEx, Matches, seq, issuer, notafter, cn, certsNum
            seq = ""
            Do
                str = outStream.ReadLine()
				set regEx = New RegExp
				regEx.pattern = "================ 証明書 ([0-9][0-9]*) ================"
				set Matches = regEx.Execute(str)
				If Matches.count > 0 Then
                    seq = Matches(0).SubMatches(0)

                    certsNum = certsNum + 1
				else If str = "CertUtil: -store コマンドは正常に完了しました。" Then certUtilSuccess = True

                End If
            Loop While seq = "" And Not outStream.AtEndOfStream

            str = outStream.ReadLine()

            str = outStream.ReadLine()

			set regEx = New RegExp
			regEx.pattern = "^発行者: (.*)$"
			set Matches = regEx.Execute(str)
			If Matches.count > 0 Then
                issuer = Matches(0).SubMatches(0)
            End If

            str = outStream.ReadLine()
            str = outStream.ReadLine()
			set regEx = New RegExp
			regEx.pattern = "^ この日以前: ([0-9]{4}/[0-9]{1,2}/[0-9]{1,2} [0-9]{1,2}:[0-9]{1,2})$"
			set Matches = regEx.Execute(str)
			If Matches.count > 0 Then
                notafter = Matches(0).SubMatches(0)
            End If

            str = outStream.ReadLine()
			set regEx = New RegExp
			regEx.pattern = "^サブジェクト: .*CN=([[a-zA-Z0-9\!\%\$\&\@\_\-\.]{1,64}),.*$"
			set Matches = regEx.Execute(str)
			If Matches.count > 0 Then
                cn = Matches(0).SubMatches(0)
                Call add(seq, cn, notafter, issuer)
            End If

            Do
                str = outStream.ReadLine()
                If str = "CertUtil: -store コマンドは正常に完了しました。" Then
                    certUtilSuccess = True
                End If
            Loop While str <> "" And Not outStream.AtEndOfStream
        Loop
    End Sub

    Private Sub add(Iseq, Icn, Inotafter, Iissuer)
        If ubound(seq) < num Then
            ReDim Preserve seq(ubound(seq) + 1)
            ReDim Preserve notafter(ubound(notafter) + 1)
            ReDim Preserve cn(ubound(cn) + 1)
            ReDim Preserve issuer(ubound(issuer) + 1)
        End If

        seq(num) = Iseq
        notafter(num) = Inotafter
        cn(num) = Icn
        issuer(num) = Iissuer

        num = num + 1
    End Sub

    Public Function searchfornewcert()
        newcertNum = 0
        ReDim newcerts(0)
        Dim i
        For i = 0 To num - 1
            If issuer(i) = newCaDn Then
                If ubound(newcerts) < newcertNum Then
                    ReDim Preserve newcerts(ubound(newcerts) + 1)
                End If
                newcerts(newcertNum) = i
                newcertNum = newcertNum + 1
            End If
        Next
    End Function

    Public Function sbRemove(Iseq)
        isRemovable = False
        Dim i
        For i = 0 To num - 1
            If issuer(i) = oldCaDn And _
                cn(Iseq) = cn(i) _
            Then
                removable = i
                isRemovable = True
            End If
        Next
        sbRemove = isRemovable
    End Function

    Public Function sbRemoveAll()
        Dim IsbRemove : IsbRemove = False
        Dim i : For i = 0 To ubound(newcerts)
            Do
                If sbRemove(newcerts(i)) = False Then Exit Do
                IsbRemove = True
            Loop Until 1
        Next
        sbRemoveAll = IsbRemove


    End Function
End Class

Function dateFormat(Iymdhms)
    Dim s : s = Split(Iymdhms, " ")
    dateFormat = s(0)
End Function

sub main()
	Dim certs : Set certs = New objCertUtil

	Dim isComplete : isComplete = False

	certs.loadCsp()
	If certs.certUtilSuccess <> True Then
		MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
	End If

	certs.searchfornewcert()

	If certs.newcertNum <= 0 Or certs.sbRemoveAll() = False Then
		MsgBox MSG03, vbOKOnly + vbInformation,TITLE01
		wscript.quit
	End If

	Do
		Dim i, newCerts, newCertsNum
		newCerts = certs.newcerts
		newCertsNum = ubound(certs.newcerts)
		i = 0
		Do
			certs.sbRemove(newCerts(i))
			i = i + 1
		Loop While certs.isRemovable = False
		If certs.isRemovable = True Then
			Dim Imsg01 : Imsg01 = MSG01 & vbCrLf & MSG01a & certs.cn(certs.removable) & vbCrLf & MSG01b & dateFormat(certs.notafter(certs.removable))
			Dim Imsg02 : Imsg02 = MSG02 & vbCrLf & MSG02a & certs.cn(certs.removable) & vbCrLf & MSG02b & dateFormat(certs.notafter(certs.removable))
			Dim mr : mr = MsgBox(Imsg01, vbYesNo + vbQuestion, TITLE01)
			If mr = vbNo Then
				MsgBox MSG04, vbOKOnly + vbInformation,TITLE01
				wscript.quit
			Else
				Dim beforeCertsNum : beforeCertsNum = certs.num
				Dim certsBeforeRemove : Set certsBeforeRemove = New objCertUtil
				certsBeforeRemove.loadCsp()
				If certsBeforeRemove.certUtilSuccess <> True Then
					MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
				End If

				If certs.cn(certs.removable) = certsBeforeRemove.cn(certs.removable) And _
				certs.issuer(certs.removable) = oldCaDn Then
					certs.removeCert(certs.seq(certs.removable))

					If certs.certUtilSuccess <> True Then
						MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
					End If

				else
					MsgBox MSG91 , vbOKOnly + vbCritical,TITLE01:wscript.quit
				end if

				set certsBeforeRemove = Nothing

				Dim certsAfterRemove : Set certsAfterRemove = New objCertUtil
				certsAfterRemove.loadCsp()
				If certsAfterRemove.certUtilSuccess <> True Then
					MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
				End If

				certsAfterRemove.searchfornewcert()
				If certsAfterRemove.num <> beforeCertsNum - 1 Then
					MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
				Else
                    ' Mod start 2020718
					'MsgBox Imsg02, vbOKOnly + vbInformation,TITLE01
                    set certs = Nothing
                    Set certs = New objCertUtil
                    certs.loadCsp()
                    certs.searchfornewcert()
                    if ( certs.sbRemoveAll() = True ) Then
                        MsgBox Imsg02 + MSG02c , vbOKOnly + vbInformation,TITLE01
                    Else
                        MsgBox Imsg02, vbOKOnly + vbInformation,TITLE01
                    End IF
                    set certs = Nothing
                    ' Mod end 2020718
				End If
				set certsAfterRemove = Nothing
			End If
		End If

		set certs = Nothing
		Set certs = New objCertUtil
		certs.loadCsp()
		If certs.certUtilSuccess <> True Then
			MsgBox MSG91, vbOKOnly + vbCritical,TITLE01:wscript.quit
		End If

		certs.searchfornewcert()
	Loop While certs.sbRemoveAll() = True
	MsgBox MSG05, vbOKOnly + vbInformation,TITLE01:wscript.quit
end sub

main()