LOGIN ID Password Auto Login Register Now! Lost Password?
XUGJ Forum

どこでもXOOPSの起動から終了までを全自動化

  • このフォーラムに新しいトピックを立てることはできません
  • このフォーラムではゲスト投稿が禁止されています

投稿ツリー


前の投稿 - 次の投稿 | 親投稿 - 子投稿.1 .2 | 投稿日時 2015/7/26 23:02
kamezou  1st Class 居住地: 2013~  投稿数: 51
marineさんの どこでもXOOPS を改造させていただきました。
どこでもXOOPS には、私のxoops歴の最初からお世話になっているので、marineさんには感謝感謝です。

仮想ドライブの作成、XAMPPの起動、xoopsサイトの表示(IE)、XAMPPの終了、仮想ドライブの解除までを、全て自動化しました。
全ての IE(最小化されている別ウインドウや最前面でないタブも含む)から、http://localhost/ を含むURLが無くなることで終了となります。

以下のコードを start_pack2011.vbs の名前で保存してください。

Option Explicit

Dim objWshShell	' WSH Shell オブジェクト
Dim objFSO  	' ファイル システム オブジェクト
Dim objXAMPP	' XAMPP オブジェクト
Dim objShellApp	' 終了判定用 IE & エクスプローラー オブジェクト
Dim strDrive	' ドライブ名
Dim strUrl  	' 表示するページ

Set objWshShell = WScript.CreateObject("WScript.Shell")

'-------- 2重起動の防止
If objWshShell.AppActivate("XAMPP Control Panel") Then
	objWshShell.Popup "XAMPPはすでに起動しています。", 3
	Set objWshShell = Nothing
	WScript.Quit
End If
'-------- Cscript(コマンドプロンプトモード)で実行しなおす
If LCase( Right( WScript.FullName, 11) ) <> "cscript.exe" Then
	objWshShell.Run "cscript " & WScript.ScriptName, 1 ,False
	Set objWshShell = Nothing
	WScript.Quit
End If

Set objFSO = WScript.CreateObject("Scripting.FileSystemObject")
objWshShell.SendKeys "{ESC}"		'以後のウインドウを最前面に表示するために

'-------- 空きドライブを探す
strDrive = "z"
Do While objFSO.DriveExists( strDrive )
	strDrive = Chr( Asc( strDrive ) - 1 )
	If strDrive = "c" Then
		Exit Do
	End If
Loop
If strDrive = "c" Then
	WScript.Echo "空きドライブがありません。"
Else
	'-------- 仮想ドライブの作成
	WScript.StdOut.Write("仮想ドライブ(" & strDrive & ":)を作成します。")
	objWshShell.Run "subst " & strDrive & ": " & objWshShell.CurrentDirectory, 0, True
	WScript.Sleep 400
	Do Until objFSO.DriveExists( strDrive )
		WScript.Sleep 400
		WScript.StdOut.Write(".")
	Loop

	'-------- カレントディレクトリのセット
	If objFSO.FolderExists("xampp") Then
		objWshShell.CurrentDirectory = strDrive & ":\xampp"
	ElseIf objFSO.FolderExists("xampplite") Then
		objWshShell.CurrentDirectory = strDrive & ":\xampplite"
	End If

	If objFSO.FileExists("xampp-control.exe") Then

		'-------- XAMPPを起動
		WScript.StdOut.Write( vbCrLf & "XAMPP を起動します。")
		Set objXAMPP = objWshShell.Exec("xampp-control.exe")
		Do Until objWshShell.AppActivate("XAMPP Control Panel")
			WScript.Sleep 400
			WScript.StdOut.Write(".")
		Loop
		WScript.Sleep 400
		WScript.StdOut.Write( vbCrLf & "Apache & Mysql を起動します。")
		WScript.Echo "しばらくお待ちください。"
		objWshShell.Run "xampp_start.exe", 7, False

		' 4秒待つ。足りないときは増やすこと。
		WScript.Sleep 4000

		'-------- 表示するURLをファイル名から取得
		strUrl = Replace( Wscript.ScriptName, "start", "http://localhost")
		strUrl = Replace( strUrl, "_", "/")
		strUrl = Replace( strUrl, ".vbs", "/")

		'-------- IEの起動 & 終了判定
		WScript.StdOut.Write("IE を起動します。")
		objWshShell.Run "iexplore.exe " & strUrl, 1, False

		Set objShellApp = WScript.CreateObject("Shell.Application")
		' IEのURLに"http://localhost/"が出現するまでループ
		Do Until CheckURL( objShellApp ) = 1
			WScript.Sleep 400
			WScript.StdOut.Write(".")
		Loop
		' 終了判定
		WScript.Echo vbCrLf & vbCrLf & "終了判定の実行中です。"
		WScript.Echo "このウインドウは閉じないでください。" & vbCrLf
		' 全てのIEのURLから"http://localhost/"がなくなるまでループ
		Do Until CheckURL( objShellApp ) = 0
			WScript.Sleep 400
		Loop
		WScript.Sleep 100
		Set objShellApp = Nothing

		'-------- 終了処理
		objWshShell.AppActivate("cscript.exe")
		WScript.Sleep 400
		WScript.Echo "Apache & Mysql を停止します。しばらくお待ちください。"
		objWshShell.Run "xampp_stop.exe", 7, True
		WScript.Echo "XAMPP を終了します。"
		WScript.Sleep 100
		objXAMPP.Terminate
		WScript.Sleep 100
		Set objXAMPP = Nothing
	Else
		WScript.Echo vbCrLf & "xampp-control.exe がありません。終了します。"
		WScript.Sleep 800
	End If

	'-------- 仮想ドライブの解除
	WScript.Echo "仮想ドライブ(" & strDrive & ":)を解除します。"
	objWshShell.Run "subst /d " & strDrive & ":", 0, True
End If
WScript.Sleep 2000
Set objFSO = Nothing
Set objWshShell = Nothing

WScript.Quit

Function CheckURL( objShellApp )
	Dim objWindow
	CheckURL = 0
	On Error Resume Next
	For Each objWindow In objShellApp.Windows
		If TypeName( ObjWindow.Document ) = "HTMLDocument" Then
			If InStr( objWindow.LocationURL,"http://localhost/") Then
				CheckURL = 1
				Exit For
			End If
		End If
	Next
	If Err.Number <> 0 Then
		CheckURL = -1
	End If
	On Error Goto 0
	Set objWindow = Nothing
End Function

Windows Script Host は環境による動作の違いが大きいみたいなので、うまく動作しない場合があるかもしれません。
各所の待ち時間(WScript.Sleep xxxx)は適宜調節してください。( 1000 = 1秒 )

私の所では次の3つの環境で動作確認しました。
Win 7 Home Premium (64bit) + IE9 : TOSHIBA
Win 7 Home Premium (64bit) + IE8 : SONY
XP Home Edition Version2002(SP2) + IE6 : SOTEC

投票数:2 平均点:10.00
前の投稿 - 次の投稿 | 親投稿 - 子投稿なし | 投稿日時 2015/8/16 11:14
marine  Lieutenant   投稿数: 464
kamezou さん

どこでもXOOPSをご利用いただいているのですね。嬉しいです。
VBSを使った機能向上、素晴らしいです。

良かったら、これを同梱させていただきたいと思うのですが、いかがでしょうか?

私については、現在、Macを使っているので、どこでもXOOPSの存在は殆ど忘れていた・・・という事実もありますが・・・
投票数:0 平均点:0.00
前の投稿 - 次の投稿 | 親投稿 - 子投稿なし | 投稿日時 2015/8/16 22:44 | 最終変更
kamezou  1st Class 居住地: 2013~  投稿数: 51
marineさん、ありがとうございます。

これでよければ、いくらでも使ってやってください。
zip版であれば、XAMPPの他のバージョンでも動作すると思います。
複数の xoops をインストールする場合はファイル名の pack2011 の部分を変更してください。

XAMPP Control Panel のウインドウが最小化されている時、2重起動の防止が機能しないようです。
Set objShellApp = WScript.CreateObject("Shell.Application")
If CheckURL( objShellApp ) = 1 Then
	objWshShell.Popup "localhostはすでに起動しています。", 3
	Set objShellApp = Nothing
	Set objWshShell = Nothing
	WScript.Quit
End If
を追加してください。
投票数:1 平均点:10.00
  条件検索へ

Back to Page Top
MainMenu
Manuals
Search
XOOPS Official & Dev.
XOOPS Communities