Const HKEY_LOCAL_MACHINE = &H80000002
Const SubKeyName = "Microsoft\Windows\CurrentVersion\Uninstall\"
Const VCVersion = 2015
'antディレクトリ
Const ANT_KEY_PATH = "\ant\apache-ant-1.10.4"
'Apache
Const APACHE_64 = "httpd-2.4.66-251206-Win64-VS17"
Const APACHE_FOLDER = "Apache24"
'VC++インストーラ
Const VC_64 = "VC_redist.x64.exe"
'Proself連携時ApachePort
Const PROSELF_APACHE_LISTEN = "81"
'通常ApachePort
Const ILP_APACHE_LISTEN = "80"
'Const PROSELFJDK_KEY_PATH = "SOFTWARE\Apache Software Foundation\Procrun 2.0\Proself5\Parameters\Java"
Const RPOSELFJDK_KEY_WORD = "Jvm"
'Const STR_JDK_TARGET = "1.8" 'バージョン情報を取得するキー
Const JDK_REG_F_PATH = "\hotspot\MSI"
Const JDK_REG_KEY = "Path"
Const JDK_REG_H_PATH2 = "SOFTWARE\Eclipse Adoptium\JDK"
Const ROOP_COUNT = 600
Const ROOP_SLEEP_TIME = 500

Dim objFS
Dim objWsh
Dim objShell
Dim strApacheRootPath, strSourcePath, strTargetPath, strLeoTmpDirPath,strApacheParentPath
Dim iRetCode
Dim repPort

On Error Resume Next

	Err.Clear
	' NTVersion 6.0以上の場合、管理者権限に昇格させる
	' WinSrv2003に対応させる為に、WSHのバージョンを5.7から5.6に変更
	do while WScript.Arguments.Count = 0 and WScript.Version >= 5.6
	    Set objWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
	    Set osInfo = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
	    
	    Dim sRunas
	    sRunas = "runas"
	    For Each os in osInfo
	        If left(os.Version, 3) < 6.0 Then sRunas = ""
	    Next
	    
	    ' 引数付きでwscriptを管理者権限で再実行
	    Set objShell=CreateObject("Shell.Application")  
	    objShell.ShellExecute "wscript.exe", Chr(34) & WScript.ScriptFullName & Chr(34) & " uac","",sRunas,1
	    WScript.Quit
	loop

	iRetCode = 1
	Set objFS = CreateObject("Scripting.FileSystemObject")
	Set objWsh = WScript.CreateObject("WScript.Shell")

    ' 権限昇格でカレントディレクトリが変わっている可能性があるので、設定
    objWsh.CurrentDirectory = objFS.GetParentFolderName(WScript.ScriptFullname)

    ' 32 or 64?
    Dim arch, inst
    arch = GetArchitecture()

	If arch = 32 Then        
		MsgBox "The installation is not an envisioned environment.",16,"Error."
		WScript.Quit iRetCode
    End If
	'VC++ インストール確認
	If IsInstallVC() Then
		iRetCode = 0
	Else
		' VC++のインストール
		'Msgbox "iVC++のインストール " 
		iRetCode = InstallVC()
	End If
    
    'Msgbox "iRetCode: " & iRetCode
    If iRetCode = 0 Then
	   ' Apacheのインストール先の確認ダイアログ
	    'Msgbox "Apacheのインストール先の確認ダイアログ" 
	    iRetCode = SetApacheFolder()
    End If
    If iRetCode = 0 And Err.Number = 0 Then
	   ' Apacheの解凍
	    iRetCode = UnZipApache()
    End If
    'Msgbox "iRetCode: " & iRetCode
	TraceMsgbox("iRetCode : " & iRetCode)
	TraceMsgbox("UnZipApacheエラー番号 " & CStr(Err.Number) & " " & Err.Description)
     'Msgbox "iRetCode: " & iRetCode
    If iRetCode = 0 And Err.Number = 0 Then
    	' http.confの書き換え
    	iRetCode = HttpdConfOverWrite()
    End If
    
	TraceMsgbox("iRetCode : " & iRetCode)
	TraceMsgbox("HttpdConfOverWriteエラー番号 " & CStr(Err.Number) & " " & Err.Description)
    'Msgbox "iRetCode: " & iRetCode
    If iRetCode = 0 And Err.Number = 0 Then
    	' サービスの登録
	   ' Msgbox "サービスの登録" 
    	iRetCode = ServiceHttpd()
    End If
    	
	TraceMsgbox("iRetCode : " & iRetCode)
	TraceMsgbox("ServiceHttpdエラー番号 " & CStr(Err.Number) & " " & Err.Description)
    	
    'Msgbox "iRetCode: " & iRetCode
	If iRetCode = 0 And Err.Number = 0 Then
		If PROSELF_APACHE_LISTEN = repPort Then
			'IE.Document.getElementById("msg").innerHTML="You completed the installation of Apache HTTP Server. <br/>" & "Apache HTTP Server Listen Port is " & repPort
			Msgbox "You completed the installation of Apache HTTP Server." & vbCrLf & "Apache HTTP Server Listen Port is " & repPort  & ".", 64, "Success"
		Else
			'IE.Document.getElementById("msg").innerHTML="You completed the installation of Apache HTTP Server." 
			Msgbox "You completed the installation of Apache HTTP Server.", 64, "Success"
		End If
    Else
	     'IE.Document.getElementById("msg").innerHTML="You failed in the installation of Apache HTTP Server."
         Msgbox "You failed in the installation of Apache HTTP Server.", 16, "Error"
    End If
    
	
	'IEインジケータ終了
	'WScript.Sleep(1500) '実際は時間の掛かる処理
	'IE.Quit
	
Set IE = Nothing
Set objShell = Nothing
Set objWsh   = Nothing
Set objFS    = Nothing

On Error GoTo 0
'Msgbox "iRetCode: " & iRetCode
WScript.Quit iRetCode

'*****************************************************************************************
' VC++のインストール確認
'*****************************************************************************************
Function IsInstallVC()
 
Dim WshShell, arch, reg, firstkey, keys, key, ret, display_name
Set WshShell = WScript.CreateObject("WScript.Shell")
arch = WshShell.Environment("Process").Item("PROCESSOR_ARCHITECTURE")

firstkey = "SOFTWARE\Wow6432Node\"
arch = "x64"
Set reg = CreateObject("WbemScripting.SWbemLocator").ConnectServer(, "root\default").Get("StdRegProv")
reg.EnumKey HKEY_LOCAL_MACHINE, firstkey & SubKeyName, keys

For Each key In keys
   display_name = ""  
   ret = reg.GetStringValue(HKEY_LOCAL_MACHINE, firstkey & SubKeyName & key, "DisplayName", display_name)
   If Instr(display_name, "Redistributable (" & arch & ")") > 0 Then
       If CInt(Mid(display_name, 22, 4)) >= VCVersion Then
			'Msgbox "VC++ 2015以上インストール済みです。" 
			IsInstallVC = true
			Exit Function
       End If
   End If
Next

'Msgbox "VC++ 2015以上インストールされていません。" 
IsInstallVC = false
End Function
'*****************************************************************************************
' VC++のインストール
'*****************************************************************************************
Function InstallVC()

    ' 権限昇格でカレントディレクトリが変わっている可能性があるので、設定
    objWsh.CurrentDirectory = objFS.GetParentFolderName(WScript.ScriptFullname)

    Dim inst
    inst = VC_64
    ' 32 or 64?
    'Dim arch, inst
    'arch = GetArchitecture()

    'If arch = 32 Then
    '   inst = VC_32
    'Else
    '   inst = VC_64
    'End If
    
    ' execute installer
    Dim objExec
    Set objExec = objWsh.Exec(inst)
    
    ' wait
    Do Until objExec.StdOut.AtEndOfStream
        objExec.StdOut.ReadLine
    Loop

    If Err.Number <> 0 Then
        Msgbox "You failed in the installation of VC++2015.", 16, "Error"
    End If

    InstallVC = Err.Number

End Function


'*****************************************************************************************
' Apacheのインストール先の確認ダイアログ
'*****************************************************************************************
Function SetApacheFolder()

    Dim errNo
    Dim errDesc

    Err.Clear

	strApacheRootPath = InputBox("Apacheのインストール先を指定してください。" , "Apache インストール先設定", "C:\Program Files\Apache Software Foundation\Apache2.4")

    If strApacheRootPath = "" Then
        SetApacheFolder = 1
        Exit Function
    End If

    If objFS.FolderExists(strApacheRootPath) Then
        MsgBox "The folder already exists. Please delete the folder." & vbCrLf & _
               strApacheRootPath, 16, "Error"
        SetApacheFolder = 1
        Exit Function
    End If

    strApacheParentPath = objFS.GetParentFolderName(strApacheRootPath)

    If strApacheParentPath = "" Then
        MsgBox "The folder setting is invalid." & vbCrLf & _
               strApacheRootPath, 16, "Error"
        SetApacheFolder = 1
        Exit Function
    End If

    ' 過去の処理のエラーを持ち込ませない
    Err.Clear

    On Error Resume Next

    If Not objFS.FolderExists(strApacheParentPath) Then
        prcCreateDirRecursion strApacheParentPath
    End If

    errNo = Err.Number
    errDesc = Err.Description

    On Error GoTo 0

    If errNo <> 0 Then
        MsgBox "Unable to create Apache parent folder." & vbCrLf & vbCrLf & _
               "Parent path: " & strApacheParentPath & vbCrLf & _
               "Install path: " & strApacheRootPath & vbCrLf & _
               "Error number: " & errNo & vbCrLf & _
               "Description: " & errDesc, _
               16, "Error"

        SetApacheFolder = errNo
        Exit Function
    End If

    If Not objFS.FolderExists(strApacheParentPath) Then
        MsgBox "Apache parent folder was not created." & vbCrLf & _
               strApacheParentPath, 16, "Error"

        SetApacheFolder = 1
        Exit Function
    End If

    SetApacheFolder = 0

End Function

'*****************************************************************************************
' Apacheの解凍
'*****************************************************************************************
Function UnZipApache()
TraceMsgbox("strApacheRootPath : " & strApacheRootPath)
		'変数・定数宣言
		Dim ApacheDirPath, FileExists,strFrom, strTo, strToFile, delFile
		Dim ApacheName, strApacheFolderName
		Dim ZipFileName, unZipDirPath, objUnZipDirFolder, objApacheFolder
		Dim Cmd
		Dim rRetCode

		'JAVAのインストール先を取得
		Dim oCtx, oLocator, oReg, sJava, sProself
		Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
		'CPUアーキテクチャの切り替え(32/64)
		
	    'Dim arch
	    'arch = GetArchitecture()
	    'If arch = 32 Then
		'    'CPUアーキテクチャ(32)
		'     ApacheName = APACHE_32
		'     oCtx.Add "__ProviderArchitecture", 32
	    'Else
		'    'CPUアーキテクチャ(64)
		'     ApacheName = APACHE_64
		'     oCtx.Add "__ProviderArchitecture", 64
	    'End If
		
		'CPUアーキテクチャ(64)
		oCtx.Add "__ProviderArchitecture", 64
		Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
		Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")
   
		' 文字列を取得(Java)
		' oReg.GetStringValue HKEY_LOCAL_MACHINE, JAVA_KEY_PATH, JAVA_KEY_WORD, sJava
		sJava = InstalledOpenJDKPath2()
		
		TraceMsgbox("sJava : " & sJava)
		'ILPのレジストリ情報から取得できない場合Proselfから取得
		'if IsNull(sJava) = true Or Len(sJava) = 0 Then
		'	sJava = ProselfJdkHome()
		'End If

		ApacheName = APACHE_64
		'vbsファイルの場所を取得
		Dim BasePath,ParPath
		BasePath = objFS.getParentFolderName(WScript.ScriptFullName)
		ParPath = objFS.GetFolder(BasePath).ParentFolder.Path
		TraceMsgbox("ParPath : " & ParPath)
		
		'Apacheファイル名を取得
		ZipFileName = BasePath & "\" & ApacheName & ".zip"

		'ApacheDirPath = strApacheParentPath
		
		'同名のディレクトリがある場合は削除\
		unZipDirPath = strApacheParentPath & "\" & APACHE_FOLDER
		TraceMsgbox("unZipDirPath : " & unZipDirPath)
		If objFS.FolderExists(unZipDirPath) = True Then
		    objFS.DeleteFolder unZipDirPath, True
		End if
		TraceMsgbox("strApacheRootPath : " & strApacheRootPath)
		If objFS.FolderExists(strApacheRootPath) = True Then
		    objFS.DeleteFolder strApacheRootPath, True
		End if

		'buildファイル取得
		Dim buildFile
		buildFile = ParPath & "\ant\build.xml"

		Dim ObjEnv       ' 環境変数情報
		Set ObjEnv = objWsh.Environment("Process")
		    
		'JAVA_HOME
		'TraceMsgbox("JAVA_HOME : " & sJava)
		ObjEnv.Item("JAVA_HOME") = sJava
		'ANT_HOME
		TraceMsgbox("ANT_HOME : " & ParPath & ANT_KEY_PATH)
		ObjEnv.Item("ANT_HOME") = ParPath & ANT_KEY_PATH
		'PATH
		TraceMsgbox("PATH : " & ParPath & ANT_KEY_PATH & "\bin")
		ObjEnv.Item("PATH") = ParPath & ANT_KEY_PATH & "\bin"

		'実行コマンド
		Cmd = "%comspec% /c ant -f """ & buildFile & """ -DSorceZip=""" & ZipFileName & """ -DDestName=""" & strApacheParentPath & """"
		TraceMsgbox("--" & Cmd & "--")

		Dim ObjExecCmd      ' 実行コマンド情報
		'プログラムが終了するまで待機
		Set ObjExecCmd = objWsh.Exec(Cmd)
		While ObjExecCmd.Status = 0
			WScript.Sleep 100
		Wend
		
		TraceMsgbox("--[END-STATUS]：" & ObjExecCmd.ExitCode & "--")
		If Not ObjExecCmd.StdOut.AtEndOfStream Then
			TraceMsgbox("--[STD-OUT]：" & ObjExecCmd.StdOut.ReadAll & "--")
		End If
		If Not ObjExecCmd.StdErr.AtEndOfStream Then
			TraceMsgbox("--[STD-ERR]：" & ObjExecCmd.StdErr.ReadAll & "--")
		End If

		If objFS.FolderExists(unZipDirPath) = True Then
			TraceMsgbox("unZipDirPath is Exists. ")
			' フォルダオブジェクト
			TraceMsgbox("unZipDirPath : " & unZipDirPath)
			Set objUnZipDirFolder = objFS.GetFolder(unZipDirPath)
			' フォルダオブジェクト
			TraceMsgbox("strApacheRootPath : " & strApacheRootPath)

			'エラー発生時はエラーを無視して次の処理に移ります。
			On Error Resume Next
			' 名称変更の確認
			i = 0
			rRetCode = 0
			Do While i < ROOP_COUNT
				WScript.Sleep(ROOP_SLEEP_TIME)
				rRetCode = httpdFolderRename(unZipDirPath,strApacheRootPath)
				If rRetCode = 0 Then
					TraceMsgbox("strApacheRootPath is Exists. ")
					Exit Do
				End If
				i = i + 1
			Loop
			'上記で指定した「On Error Resume Next」は以下の行までとします。
			On Error Goto 0
			
			' 名称変更の確認
			i = 0
			Do While i < ROOP_COUNT
				WScript.Sleep(ROOP_SLEEP_TIME)
				If objFS.FolderExists(strApacheRootPath) = True Then
					TraceMsgbox("strApacheRootPath is Exists. ")
					Exit Do
				End If
				i = i + 1
			Loop
			TraceMsgbox("strApacheParentPath : " & strApacheParentPath)
			strFrom = strApacheParentPath & "\" & "ReadMe.txt"
			TraceMsgbox("strFrom : " & strFrom)
			strToFile = strApacheRootPath & "\" & "ApacheLounge_ReadMe.txt"
			TraceMsgbox("strTo : " & strToFile)
			'ファイルの移動
			objFS.MoveFile strFrom, strToFile
			delFile = strApacheParentPath & "\" & "-- Win64 VS17  --"
			TraceMsgbox("delFile : " & delFile)
			' ファイルの削除
			objFS.DeleteFile delFile
			' ファイル変更の確認
			i = 0
			rRetCode = 1
			Do While i < ROOP_COUNT
				WScript.Sleep(ROOP_SLEEP_TIME)
				If objFS.FileExists(strToFile) = True Then
					TraceMsgbox("strToFile is Exists. ")
					Exit Do
				End If
				i = i + 1
			Loop
		Else
			TraceMsgbox("unZipDirPath is not Exists. ")
			Msgbox "You failed in UnZip Apache HTTP Server.", 16, "Error"
			UnZipApache = 1
			Set ObjEnv = Nothing
			Exit Function
		End If

		If objFS.FolderExists(strApacheRootPath) = False Then
			TraceMsgbox("strApacheRootPath is not Exists. ")
			Msgbox "You failed in ReName Apache HTTP Server.", 16, "Error"
			UnZipApache = 1
			Set ObjEnv = Nothing
			Exit Function
		End If

		Set ObjEnv = Nothing
		
	    If Err.Number <> 0 Then
             Msgbox "You failed in UnZip Apache HTTP Server.", 16, "Error"
			 UnZipApache = Err.Number
	    End If
	    
	    Err.Clear
	
End Function

'*****************************************************************************************
'　フォルダ名変更
'*****************************************************************************************
Function httpdFolderRename(unZipDirPath, strApacheRootPath)
	'エラー発生時はエラーを無視して次の処理に移ります。
	On Error Resume Next
	Dim objFileSystem
	set objFileSystem = CreateObject("Scripting.FileSystemObject")
	TraceMsgbox(unZipDirPath & " is Rename. " & strApacheRootPath)
	objFileSystem.MoveFolder unZipDirPath, strApacheRootPath
	TraceMsgbox("httpdFolderRename Err.Number : " & Err.Number)
	httpdFolderRename = Err.Number
	objFileSystem = null
End Function

'*****************************************************************************************
' http.confの書き換え
'*****************************************************************************************

Function HttpdConfOverWrite()
    Dim errCode
	Dim defTargetPath
	' Apache HTTP Serverインストールフォルダ
	strTargetPath = strApacheRootPath
	'Msgbox "strTargetPath: " & strTargetPath

	strLeoTmpDirPath = objFS.GetSpecialFolder(2).Path & "\ALSI\InterSafeILP"
	TraceMsgbox( "strLeoTmpDirPath: " & strLeoTmpDirPath)
	'strTargetPath = InputBox("Apache HTTP Serverがインストール" & vbCrLf & _ 
	'                         "されているフォルダを入力して下さい", "入力ダイアログ", msg)
	'strTargetPath = InputBox("Please input the folder in which Apache HTTP Server is installed.", "Input Dialog", msg)

	 'ディレクトリが無ければディレクトリを作成
	prcCreateDirRecursion(strLeoTmpDirPath)

	If objFS.FolderExists(strLeoTmpDirPath) Then
	    If strTargetPath <> "" Then
	        ' 権限昇格でカレントディレクトリが変わっている可能性があるので、設定
	        objWsh.CurrentDirectory = objFS.GetParentFolderName(WScript.ScriptFullname)

	        If objFS.FolderExists(strTargetPath) Then
	            strSourcePath = objFS.BuildPath(objWsh.CurrentDirectory, "")
	            On Error Resume Next

	                Dim srcConfPath, dstConfPath, srcDefConfPath, dstDefConfPath
	                dstConfPath = objFS.BuildPath(strLeoTmpDirPath, "httpd.conf")
					
	                srcDefConfPath = objFS.BuildPath(strSourcePath, "httpd-default.conf.src")
	                
	                srcSSLConfPath = objFS.BuildPath(strSourcePath, "httpd-ssl.conf.src")

	                Call prcTextFileRead(strTargetPath)

	                ' httpd.confコピー
					targetConfPath = strTargetPath & "\conf\httpd.conf"
					TraceMsgbox("dstConfPath : " & dstConfPath)
					TraceMsgbox("targetConfPath : " & targetConfPath)
	                objFS.CopyFile dstConfPath, targetConfPath, True
					
					TraceMsgbox("httpd.confコピー Err.Number : " & Err.Number)
	                ' httpd-default.confコピー
					defTargetPath =  strTargetPath & "\conf\extra\httpd-default.conf"
					TraceMsgbox("dstConfPath : " & dstConfPath)
					TraceMsgbox("defTargetPath : " & defTargetPath)
	                objFS.CopyFile srcDefConfPath, defTargetPath, True

					TraceMsgbox("httpd-default.confコピー Err.Number : " & Err.Number)
	                ' httpd-default.confコピー
					defTargetPath =  strTargetPath & "\conf\extra\httpd-ssl.conf"
					TraceMsgbox("srcSSLConfPath : " & srcSSLConfPath)
					TraceMsgbox("defTargetPath : " & defTargetPath)
	                objFS.CopyFile srcSSLConfPath, defTargetPath, True

					TraceMsgbox("httpd-default.confコピー Err.Number : " & Err.Number)
	                ' %TEMP%ディレクトリに作成したhttpd.confを削除
	                objFS.DeleteFile dstConfPath
					TraceMsgbox("TEMP%ディレクトリに作成したhttpd.confを削除 Err.Number : " & Err.Number)
	                
	                ' 処理が早すぎるので時間調整
	                WScript.Sleep(1500)

					TraceMsgbox("処理が早すぎるので時間調整")
					TraceMsgbox("Err.Number : " & Err.Number)
	                If Err.Number = 0 Then
	'                    Msgbox "HTTP Serverの設定が完了しました。", 64, "Success"
	                    'Msgbox "You completed the setting of HTTP Server.", 64, "Success"
	                Else
	'                    Msgbox "HTTP Serverの設定に失敗しました。", 16, "Error"
	                    Msgbox "You failed in the setting of HTTP Server.", 16, "Error"
	                End If
	                errCode = Err.Number
	        Else
	'            Msgbox "フォルダが存在しません。", 16, "Error"
	             Msgbox "The folder doesn't exist.", 16, "Error"
				HttpdConfOverWrite = 1
	    		Err.Clear
             	Exit Function 
	        End If
	    End If
	Else
	'    Msgbox strLeoTmpDirPath & " を作成できませんでした。", 16, "Error"
	    Msgbox "You were not able to make the " & strLeoTmpDirPath, 16, "Error"
	    HttpdConfOverWrite = 1
	    Err.Clear
	End If

	TraceMsgbox("errCode : " + errCode)
	HttpdConfOverWrite = errCode
	Err.Clear
	'Set objWMI   = Nothing
	'Set osInfo   = Nothing
	'Set objShell = Nothing
	'Set objWsh   = Nothing
	'Set objFS    = Nothing

	'Msgbox "iRetCode: " & iRetCode
	'WScript.Quit iRetCode

End Function

Sub prcTextFileRead(strTargetPath)

   '�Dファイルの有無を調べるために定義
   On Error Resume Next

   Dim objFileSys
   Dim objInFile
   Dim objOutFile
   Dim intSep
   Dim strScriptPath
   Dim srcFileName
   Dim dstFileName
   Dim srcFilePath
   Dim dstFilePath
   Dim strRecord,dstRecord,dstRecord2
   Dim sProself

   '�Eパラメタを保存(ファイル名として使用)
   srcFileName = "httpd.conf.src"
   dstFileName = "httpd.conf"

   '�Fプログラムが保存されているフォルダを取得します
   strScriptPath = Replace(WScript.ScriptFullName,WScript.ScriptName,"")

'   TraceMsgbox("Err.Number : " & Err.Number)
   '�Gファイルシステムオブジェクトの作成
   Set objInFileSys = CreateObject("Scripting.FileSystemObject")
   Set objOutFileSys = CreateObject("Scripting.FileSystemObject")

   '�H読み込むファイルのフルパスを編集
   srcFilePath = objInFileSys.BuildPath(strScriptPath,srcFileName)
   dstFilePath = objOutFileSys.BuildPath(strLeoTmpDirPath ,dstFileName)
 '  TraceMsgbox("srcFilePath : " & srcFilePath )
  ' TraceMsgbox("Err.Number : " & Err.Number)

   '書き換え用ポート Proself連携か通常か確認
   sProself = ProselfJvm()
   if IsNull(sProself) = false And Len(sProself) > 0 Then
		TraceMsgbox(sProself)
		repPort = PROSELF_APACHE_LISTEN
   Else
		repPort = ILP_APACHE_LISTEN
   End If
   TraceMsgbox(repPort)

	Dim outstream
	Set outstream = CreateObject("ADODB.Stream")

	' ストリームをテキストモードで開く
	With outstream
		.Type = 2 ' adTypeText
		.Charset = "UTF-8" ' 必要に応じて文字コードを指定 (例: UTF-8)
		.Open
	End With

	With CreateObject("ADODB.Stream")
		.Open
		.Charset = "UTF-8"'BOMあり、BOMなし両対応
		.LineSeparator = -1 '-1=CRLF
		.LoadFromFile srcFilePath
		
		'1行毎に処理
		Do Until .EOS
			srcRecord = .ReadText(-2)'1行取り出す
			dstRecord = Replace(srcRecord, "__APACHE_PATH__", strTargetPath)
			dstRecord2 = Replace(dstRecord, "__APACHE_PORT__", repPort)
			outstream.WriteText dstRecord2 & vbNewLine ' 行末に改行コードを追加
		Loop
		.Close
	End With

	outstream.SaveToFile dstFilePath, 2 ' 2: adSaveCreateOverWrite
	outstream.Close

   '�Pオブジェクトの破棄
   Set outstream = Nothing
   Set objInFileSys = Nothing
   Set objOutFileSys = Nothing
   Set objInFile = Nothing
   Set objOutFile = Nothing
   '一度ここでエラークリア
   Err.Clear
   'TraceMsgbox("Err.Number : " & Err.Number)
   TraceMsgbox("dstFilePath : " & dstFilePath )
End Sub

'*****************************************************************************************
' サービスの登録
'*****************************************************************************************
Function ServiceHttpd()

TraceMsgbox("ServiceHttpd() ")
    Dim strCmd, szStr, inst, StdOut, StdErr
    Set WshShell = CreateObject("WScript.Shell")
    'サービスの登録
    inst = """" & strApacheRootPath & "\bin\httpd"""
    strCmd = inst & " -k install"
    'Msgbox "strCmd " & strCmd
    Return = WshShell.Run(strCmd, 1, true)
 

	TraceMsgbox("ServiceHttpd() " & Err.Number)
    If Err.Number <> 0 Then
        Msgbox "You failed in the Registration of httpd service.", 16, "Error"
    End If

    ServiceHttpd = Err.Number
	Err.Clear

End Function


' フォルダを再帰的に作成する
Sub prcCreateDirRecursion(ByVal strPath)
    Dim strParent   ' 親フォルダ

    strParent = objFS.GetParentFolderName(strPath)
    If objFS.FolderExists(strParent) Then
        If Not objFS.FolderExists(strPath) Then
            objFS.CreateFolder strPath
        End If
    Else
        prcCreateDirRecursion strParent
        objFS.CreateFolder strPath
    End If
End Sub

'
' アーキテクチャ取得
'
Function GetArchitecture()

    Dim PrcSet
    Dim Prc
    Dim Locator
    Dim WMI

    Set WMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
    Set PrcSet= WMI.ExecQuery("Select AddressWidth From Win32_Processor")

    For Each Prc In PrcSet
        GetArchitecture = Prc.AddressWidth
    Next

    Set PrcSet = Nothing
    Set Prc = Nothing
    Set Locator = Nothing
    Set WMI =Nothing
    
End Function

'ProselfJDKを取得します。
'Function ProselfJdkHome()
'    Dim oCtx, oLocator, oReg, sProselfjvm, sProselfRootJDK,objFile,objFolder,ret,strJavaExePath
'    Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
'    Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
'	'CPUアーキテクチャ(64)
'	 oCtx.Add "__ProviderArchitecture", 64
'    Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")

'	oReg.GetStringValue HKEY_LOCAL_MACHINE, PROSELFJDK_KEY_PATH, RPOSELFJDK_KEY_WORD, sProselfjvm
	
'	If IsNull(sProselfjvm) = false And Len(sProselfjvm) > 0 Then
'		Set objFile = objFS.GetFile(sProselfjvm)
'		Set objFolder = objFile.ParentFolder
'		Set objFolder = objFolder.ParentFolder
'		strJavaExePath = objFolder.Path & "\java.exe"
'		'実行コマンド
'		Cmd = "%comspec% /c """ & strJavaExePath & """ " & "-version"
'		Dim ObjExecCmd      ' 実行コマンド情報
'		'プログラムが終了するまで待機
'		Set ObjExecCmd = objWsh.Exec(Cmd)
		'While ObjExecCmd.Status = 0
		'    objWsh.Sleep(100) 
		'Wend
			
'		TraceMsgbox("--[END-STATUS]：" & ObjExecCmd.ExitCode & "--")
		'If Not ObjExecCmd.StdOut.AtEndOfStream Then
		'    Do While Not ObjExecCmd.StdOut.AtEndOfStream
		'        sVersionInfo =  ObjExecCmd.StdOut.ReadLine()
		'        If InStr(sVersionInfo, STR_JDK_KEY) <> 0 Then
		'            '文字列が含まれていた場合の処理をいれる
		'            Exit Do 
		'        End If
			'   Loop
	
		'    TraceMsgbox("--[sVersionInfo]：" & sVersionInfo & "--")
		'    TraceMsgbox("--[STD-OUT]：" & ObjExecCmd.StdOut.ReadAll & "--")
		'End If
		'
'		If Not ObjExecCmd.StdErr.AtEndOfStream Then
'			Do While Not ObjExecCmd.StdErr.AtEndOfStream
'				sVersionInfo =  ObjExecCmd.StdErr.ReadLine()
'				If InStr(sVersionInfo, STR_JDK_KEY) <> 0 Then
'					'文字列が含まれていた場合の処理をいれる
'					Exit Do 
'				End If
'			Loop
	
'			TraceMsgbox("--[sVersionInfo]：" & sVersionInfo & "--")
'		End If
	
'		'JDK8のみ合わせる。
'		If InStr(sVersionInfo, STR_JDK_TARGET) <> 0 Then
'			Set objFolder = objFolder.ParentFolder
'			Set objFolder = objFolder.ParentFolder
''			sProselfRootJDK = objFolder.Path
'		End If
'		TraceMsgbox("sProselfRootJDK : " & sProselfRootJDK & "--")
'	End If

'    ProselfJdkHome = sProselfRootJDK
'End function
''ProselfJvmを取得します。
'Function ProselfJvm()
'    Dim oCtx, oLocator, oReg, sProselfjvm
'    Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
'	'CPUアーキテクチャ(64)
'	 oCtx.Add "__ProviderArchitecture", 64
'    Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
'    Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")

'	oReg.GetStringValue HKEY_LOCAL_MACHINE, PROSELFJDK_KEY_PATH, RPOSELFJDK_KEY_WORD, sProselfjvm


'    ProselfJvm = sProselfjvm
'End function


'*****************************************************************************************
' インストール済みEclipse Foundation OpenJDKの取得
'*****************************************************************************************
Function InstalledOpenJDKPath2()
TraceMsgbox("InstalledOpenJDKPath2()")
	Dim  replacekey,SubKeySet,SubKey,Jdkver, IntVal , sJava, RegJdk,SubKeyVal,sTest

    Dim oCtx, oLocator, oReg, b64Bit
    Dim oClass, lRet, sJre, strEnd, rJre
    Set oCtx = CreateObject("WbemScripting.SWbemNamedValueSet")
    Set oLocator = CreateObject("Wbemscripting.SWbemLocator")
    'CPUアーキテクチャ(64)
    oCtx.Add "__ProviderArchitecture", 64
    Set oReg = oLocator.ConnectServer("", "root\default", "", "", , , , oCtx).Get("StdRegProv")
    

	' サブキーを全て取得する
	oReg.EnumKey HKEY_LOCAL_MACHINE, JDK_REG_H_PATH2, SubKeySet
    If IsEmpty(SubKeySet) = false And IsNull(SubKeySet) = false Then
        for each SubKey in SubKeySet
            TraceMsgbox("SubKey : " & SubKey)
            If IsEmpty(SubKey) = false And IsNull(SubKey) = false Then
                replacekey = Replace(SubKey, ".", "")
                TraceMsgbox("replacekey : " & replacekey)
        
                If IsEmpty(SubKeyVal) = false And IsNull(SubKeyVal) = false Then
                    IntVal = int(replacekey)
                    If IntVal > Jdkver Then
                        Jdkver = IntVal
                        SubKeyVal = SubKey
                    End If
                Else
                    Jdkver = int(replacekey)
                    SubKeyVal =SubKey
                    TraceMsgbox("SubKeyVal : " & SubKeyVal)
                End If
                
            End If
        next
    End If


	TraceMsgbox("SubKeyVal : " & SubKeyVal)
	If Len(SubKeyVal) <> 0 Then
		RegJdk = JDK_REG_H_PATH2 & "\" &  SubKeyVal  & JDK_REG_F_PATH

		TraceMsgbox("RegJdk : " & RegJdk)
		oReg.GetStringValue HKEY_LOCAL_MACHINE, RegJdk, JDK_REG_KEY, sJava

		TraceMsgbox("sJava : " & sJava)
		InstalledOpenJDKPath2 = sJava
	End If
	Set oCtx = Nothing
	Set oLocator = Nothing
	Set oReg = Nothing
End Function


Sub TraceMsgbox(str)
'    Msgbox str
End Sub