Option Explicit
On Error Resume Next


Dim strFolderPath   'インストールフォルダパス


Call Main()
WScript.Quit


Sub main()
    
    Call StartProcess()         '開始処理
    Call GetFolderPath()        'ゆうプリRインストールフォルダの指定
    Call RunUpBatch()           '最適化処理の実行
    Call EndProcess()           '終了処理

End Sub

Sub StartProcess()

On Error Resume Next

    If Not MsgBox("最適化処理を行います。よろしいですか？" & vbCrLf & vbCrLf & "※ゆうプリRを終了した状態で開始して下さい※", vbOKCancel + vbQuestion, "ゆうプリR") = 1 Then
        WScript.Quit
    End If

If Err.number <> 0 then
    MsgBox "※異常終了※　最適化処理に失敗しました。", vbCritical, "ゆうプリR"
    WScript.Quit
End If

End Sub


Sub GetFolderPath()


    Dim objFso
    Dim objAppShell
    Dim objWshShell
    Dim objFolder
    Dim strDesktopPath

On Error Resume Next

    strFolderPath = "C:\ゆうプリR"  'デフォルトパス

    Set objFso = WScript.CreateObject("Scripting.FileSystemObject") 

    If Not objFso.FileExists(strFolderPath & "\420107K01P01V01.exe") Then
		MsgBox "ゆうプリRのインストール先がCドライブ直下ではありませんでした。" & vbCrLf & "インストールしたフォルダを選択して下さい。", vbInformation, "ゆうプリR"
        
    '--フォルダ参照ダイアログを表示しインストール先を選択
        Set objAppShell = WScript.CreateObject("Shell.Application")
        Set objFolder = objAppShell.BrowseForFolder(0, "ゆうプリRのインストールフォルダを選択して下さい。", 0)

        'デスクトップパスを取得
        Set objWshShell = WScript.CreateObject("WScript.Shell")
        strDesktopPath = objWshShell.SpecialFolders("Desktop")
        Set objWshShell = Nothing
        
        If Not objFolder Is Nothing Then
            Select Case objFolder

            Case "デスクトップ"   'Err.Number = 91 対策
                strFolderPath = strDesktopPath
            Case Else
                strFolderPath = objFolder.Items.Item.Path
			If Not objFso.FileExists(strFolderPath & "\420107K01P01V01.exe") Then
				MsgBox "選択したフォルダにはゆうプリRのファイルがありませんでした。" & vbCrLf & "再度、やり直してください。", vbCritical, "ゆうプリR"
    				WScript.Quit
			End if
            End Select
        End If
                        
        Set objAppShell = Nothing
    End if

If Err.number <> 0 then
    MsgBox "※異常終了※　最適化処理に失敗しました。", vbCritical, "ゆうプリR"
    WScript.Quit
End If

End Sub

Sub RunUpBatch()
    
    Dim objFso
    Dim objWshShell
    Dim strXmlPath
    Dim strXmlItem
    Dim intDbType
    Dim strBatchPath
    Dim strOptimizationPath
    Dim strLinkPath
    Dim intParameter_Opt
    Dim intParameter_Link

On Error Resume Next

    strBatchPath = strFolderPath & "\RTBTOOL.exe"

'--ファイルがが存在しない場合はエラーMSG
    Set objFso = WScript.CreateObject("Scripting.FileSystemObject") 

    If Not objFso.FileExists(strBatchPath) Then
          MsgBox "ゆうプリRのフォルダ内に RTBTOOL.exe ファイルが存在しません。" & vbCrLf & "お手数ですがサポートセンターへお問い合わせください。", vbInformation, "ゆうプリR"
          WScript.Quit
    End if

    Set objFso = Nothing

'--DB種別を判別し、最適化処理を実行
    strXmlPath = strFolderPath & "\Configuration\Settings.xml"
    strXmlItem = "/SysSettings/SQLType"

    intDbType = getXmlParam(strXmlPath, strXmlItem)

    SELECT case intDbType 
       case "1"     'SQL版の場合は、サポセンへのメッセージを表示
          MsgBox "SQL版のため、処理を中止しました。" & vbCrLf & "お手数ですがサポートセンターへお問い合わせください。", vbInformation, "ゆうプリR"
          WScript.Quit

       case "0"     'MDB版の場合は、何もしない

       case else  '取得できなかった場合はエラーMSG
          MsgBox "DB種別の取得に失敗しました。", vbExclamation, "ゆうプリR"
          WScript.Quit

    End SELECT

	'最適化用に値をセット
    intParameter_Opt = 000
    strOptimizationPath = strBatchPath & " " & intParameter_Opt

	'再リンク用に値をセット
	intParameter_Link = 100
    strLinkPath = strBatchPath & " " & intParameter_Link
    
'--最適化処理の実行
    Set objWshShell = WScript.CreateObject("WScript.Shell") 

    objWshShell.Run strOptimizationPath, 0, True

    Set objWshShell = Nothing

'--再リンク処理の実行
    Set objWshShell = WScript.CreateObject("WScript.Shell") 

    objWshShell.Run strLinkPath, 0, True

    Set objWshShell = Nothing

If Err.number <> 0 then
    MsgBox "※異常終了※　最適化処理に失敗しました。", vbCritical, "ゆうプリR"
    WScript.Quit
End If

End Sub



Sub EndProcess()


On Error Resume Next


If Err.number <> 0 then
    MsgBox "※異常終了※　最適化処理に失敗しました。", vbCritical, "ゆうプリR"
    WScript.Quit
End If

    MsgBox "最適化処理が完了しました", vbInformation, "ゆうプリR"

End Sub




'XML要素取得
Function getXmlParam(strXmlPath, strXmlNode)
    
    Dim objFso
    Dim objXML
    Dim objNode
    Dim obj
    Dim fig

On Error Resume Next

'--XMLファイル存在チェック
    Set objFso = WScript.CreateObject("Scripting.FileSystemObject") 

    If Not objFso.FileExists(strXmlPath) Then
        MsgBox "「Settings.xml」が存在しません。処理を中断します。", vbExclamation, "ゆうプリR"
        Set objFso = Nothing
        WScript.Quit
    End if

    Set objFso = Nothing

'--XMLファイル読み込み
    Set objXML = WScript.CreateObject("MSXML2.DOMDocument")

    objXML.Async = False
    objXML.Load(strXmlPath)

    Set objNode = objXML.selectSingleNode(strXmlNode)
    
    'ノードが存在しなかった場合は空文字列を返す
    If objNode Is Nothing Then
        getXmlParam = ""
    Else
        getXmlParam = objNode.text
    End If

    Set objNode = Nothing
    Set objXML = Nothing

If Err.number <> 0 then
    MsgBox "※異常終了※　最適化処理に失敗しました。", vbCritical, "ゆうプリR"
    WScript.Quit
End If

End Function