2025/07/14

ものすごくなんとなく・・・

おきつね鯖再公開の目処が立たない為 一旦 簡易概要と VBScriptのソースのみ コチラにて掲載。
■ 概要
UACスルーで 任意のアプリケーションを 管理者権限起動可能な 補助スクリプト、タスクスケジューラとの組み合わせでは此の上無き
利便性を実現する。

おきつね環境に於いて 20181016 に基盤を構成し運用開始の後、20220612 に更新して以降 其のまま活用し続けており、最早
本スクリプト無しで Windows と アプリケーションの使用を考えたくない域で多用している。
⚠️ Attention ⚠️
尚、セキュリティ面では極めて大きなリスク要因ともなり得る旨、 充分に留意しつつの運用を要するスクリプトでもある
■ 最終 (20220612) 版スクリプトの内容はコンなカンジ・・・
▼ sStartApp.vbs / .vbe
'***** ↓↓↓ScriptTitle↓↓↓ ************************************************************************************ 
	' sStartApp.vbe/vbs  
	' - Created by LazwardFox -  


'***** ↓↓↓ Log ↓↓↓ ****************************************************************************************** 

	' Update 20220612 014359 - Function oJoin 適用。 
	' Update 20220611 015640 - 対象へのパラメータに ["] ダブルクォーテーションが必要となるケースへの対応。 
	' Update 20220610 212820 - 待機既定値の誤りの修正と 変数 blWait → eWait への変更。 
	' Update 20220610 005411 - ウィンドウ状態 及び 終了待機 の指定を可能に。 
	' Update 20220609 225923 - r93微修正。 
	' Update 20220609 222823 - 最新テンプレート適用と環境変数処理修正。 
	' Update 20220318 220700 - フォルダの環境変数適用可能に。 
	' Update 20190115 025410 - カレントフォルダ処理追加。 
	' Release 20190111 112120  
	' Update 20190111 040002  
	' βRelease 20181016 233453  
	' DevStart 20181016 225114  


'***** ↓↓↓ Memo ↓↓↓ ***************************************************************************************** 

	' ・sStartAppsの機能簡易/パラメータ精査重視の 単一アプリケーション起動版、主にタスクスケジューラ向け。 
	' ・対象の直接実行でもカレントディレクトリを確実に合わせる為 制作した版。 
	' ・実行優先で、ファイル/フォルダの複製、メッセージ表示、iniファイル読み込み 省略。 
	' ・iniを読まない為独自環境変数処理と関連するチェック機能も省略。 
	' ・SGP等 複数のライブラリをパラメータでセットするアプリケーションに対応。  

	' sStartApp {対象アプリケーションとパラメーター群}{;ウィンドウタイプ(Num),待機(Boolean)} 


'***** ↓↓↓ ObjectDecralations ↓↓↓ *************************************************************************** 

	Option Explicit

	Public My, MySh, Fs, Parameters
	'Public My, MySh, ShApp, Fs, Parameters 

	Set My = WScript

	With My

		Set Parameters = .Arguments 'パラメーター取得 
		If Parameters.Count <= 0 Then 
			.Quit '[無効] パラメータ無しの起動。 
		End If
		Set MySh = .CreateObject("WScript.Shell")
		'Set ShApp = .CreateObject("Shell.Application") 
		Set Fs = .CreateObject("Scripting.FileSystemObject")

	End With


'***** ↓↓↓ GlobalDecralations ↓↓↓ *************************************************************************** 
	Public Const vbWq = """"
	Public Const vbSpc = " "
	Public Const vbSep = ":::"


'***** ↓↓↓ConstructDecralations↓↓↓ ************************************************************************** 
	'Const defType = 65 ' Popupメッセージの既定表示指定  
	'Const strExpl = "%WinDir%\Explorer.exe" 
	'Const uKey = "" 


'***** ↓↓↓AuthDecralations↓↓↓ ******************************************************************************* 


'***** ↓↓↓ValiableConstDecralations↓↓↓ ********************************************************************** 


'***** ↓↓↓ exFunctionDecralations ↓↓↓ *********************************************************************** 


'***** ↓↓↓FileControlDecralations↓↓↓ ************************************************************************ 

	Public eWS
	'Public sTitle, sRoot 

	'With My 
		'sTitle = .ScriptName 
		'sRoot = .Path 
		'eWS = vbWq & .FullName & vbWq 
		'eCMD = vbWq & .Path  & "\cmd.exe" & vbWq 
	'End With 

	'With Fs 
	'End With 


'***** ↓↓↓Decralations↓↓↓ *********************************************************************************** 

	Dim sTargetSet, sParameters, sParameter, wType, eWait
	'Dim strMy 
	'Dim strParameters, strParameter, strTargetSet 
	Dim strParameter, strTargetSet
	Dim strTargets, strTarget, strRoot
	Dim strTgtFile, arTgtFiles
	Dim arParameters, blParameters
	Dim blOne, blSingle


'***** ↓↓↓MainRoutine↓↓↓ ************************************************************************************ 

'	On Error Resume Next 

	'▼▼ 付与されたコマンドラインパラメーターを 1行の文字列として取得   

	'For Each strParameter In Parameters ' ← 配列変数では無い為 Join使用不可 
	'	If strTargetSet = "" Then 
	'		strTargetSet = strParameter 
	'	Else 
	'		strTargetSet = strTargetSet & vbSep & strParameter 
	'	End if 
	'Next 
	
	strTargetSet = oJoin(Parameters, vbSep)


	'▼▼ 制御パラメータ―処理                       

	If InStrRev(strTargetSet, ";") = 0 Then ' 制御パラメータの有無を検出 - 20220610 005411 

		' [未指定] 既定値をセット 
		'wType = 1 
		eWait = False

	Else

		'▼ [制御指定抽出] 
		sTargetSet = Split(strTargetSet, ";") ' 実行対象と制御文字列を分離 
		strTargetSet = sTargetSet(0) ' 実行対象と其のパラメータて構成された文字列を再代入 
		sParameters = Split(sTargetSet(1), ",") ' sStartApp への制御文字列を配列化 

		'▼ ウィンドウに対する指定のセット 
		wType = sParameters(0)
		eWait = sParameters(1)

	End If


	'▼▼ 起動対象向け処理                         

	strTargetSet = MySh.ExpandEnvironmentStrings(strTargetSet) '環境変数の内容を適用 - 20220609 215320 
	'※ ini向け独自拡張分サポートは排除 

	arParameters = Split(strTargetSet, vbSep)
	blParameters = (Parameters.Count >= 1)

	strTargetSet = arParameters(0)

	If blParameters Then ' 子プロセスへのパラメータを処理 ▼ 

		If Fs.FolderExists(strTargetSet) Then ' 第一引数の指定はフォルダ? 

			If Parameters.Count <= 1 Then ' 続くパラメータの有無。 

				MyQuit '[無効] 指定がフォルダのみ。 

			Else 

				'▼ 同一フォルダで 実行ファイルと呼び出すライブラリが指定(複数可)されていると識別。 

				blSingle = False

				strRoot = arParameters(0)
				strTargets = Parameters(1)
				arTgtFiles = Split(strTargets, ",")

				blOne = True
				For Each strTgtFile In arTgtFiles

					' ファイルのフルパスを構成。 
					strTarget = Fs.BuildPath(strRoot, strTgtFile)

					If Fs.FileExists(strTarget) Then ' 対象ファイルの有無。 

						If blOne Then
							strTargetSet = vbWq & strTarget & vbWq
							blOne = False
						Else
							strTargetSet = strTargetSet & vbSpc & vbWq & strTarget & vbWq
						End if

					Else '[無効] 対象ファイルが無い。 

						MyQuit

					End If

				Next

			End If

			' 処理済みの配列を排除。 
			blParameters = sArrayControl(arParameters, "1,0", arParameters)

		Else ' 単純実行指示を処理 (パラメーターの指定は単体ファイル) ▼ 
		
			If Fs.FileExists(strTargetSet) Then ' 実行対象の有無。 

				strRoot = Fs.GetParentFolderName(strTargetSet)
				blParameters = sArrayControl(arParameters, "0", arParameters)

			Else '[無効] 対象ファイルが無い。 

				MyQuit

			End if

			blSingle = True

		End If

	End If

	If blSingle Then
	
		strTargetSet = vbWq & strTargetSet & vbWq

	End If

	'▼▼ 残りのパラメータが存在する場合はスプリッタを挟んで文字列として連結する。 
	If blParameters Then

		strTargetSet = strTargetSet & vbSpc & Join(arParameters, vbSpc)

		'▼ 20220611 231415 本スクリプトへのパラメータ付与に関連して廃止 
		'For Each strParameter In arParameters 
			'strParameter = Replace(strParameter, ";", vbWq)  
			'strTargetSet = strTargetSet & vbSpc & strParameter 
		'Next 

	End If

	'▼▼ 実行 
	strTargetSet = Replace(strTargetSet, "'", vbWq)

	With MySh

		.CurrentDirectory = strRoot
		.Run strTargetSet, wType, eWait

	End With

	MyQuit


'***** ↓↓↓ LimitedFunctions ↓↓↓ ***************************************************************************** 


'***** ↓↓↓ GlobalFunctions ↓↓↓ ****************************************************************************** 

	'----------------------------------------------------- 
	' MyQuit - 終了処理  
	' - Created by LazwardFox -  

		' Update 20190122 233146 
		' Release  
		' Update 20151021 042112 -  
		' Release 20120914 085236 
		' DevStart 20120914  

	Function MyQuit()
		'Set objMx = Nothing 
		'Set objSMTP = Nothing 
		'Set xmlHTTP = Nothing 
		'Set ShApp = Nothing 
		Set Fs = Nothing
		Set MySh = Nothing
		Set Parameters = Nothing
		My.Quit
	End Function


	'----------------------------------------------------- 
	' oJoin -  
	' - Created by LazwardFox -  

		'スクリプトに付与されたコマンドラインパラメーターを 1行の文字列として取得 他・・・ 

		' Update  
		' Update 20220612 014858 - 変数名を汎用化。 
		' Release 20220612 014054 - 配列変数では無いJoin使用不可な対象向け。 
		' DevStart 20220612 002720 

	Function oJoin(oTargets, sSep)
		Dim iTarget, strTargets
		For Each iTarget In oTargets
			If strTargets = "" Then
				strTargets = iTarget
			Else
				strTargets = strTargets & sSep & iTarget
			End if
			oJoin = strTargets
		Next
	End Function


	'----------------------------------------------------- 
	' SimpleArrayControl - 配列制御(暫定20190111 050158) 
	' - Created by LazwardFox - 
	
		' Update  
		' Release  
		' βRelease 20190111 050158 数値で指定した要素を配列から削除。 
								'	配列に配列を入れ子している場合機能しない。 
		' DevStart 20190111 044731 

	Function sArrayControl(tgtArray, strPoss, arResult)
		Dim arPos, numArray, strArray, strPos, blResult
		arPos = Split(strPoss, ",")
		numArray = Ubound(tgtArray)
		blResult = (numArray > Ubound(arPos))
		If blResult Then
			strArray = Join(tgtArray, vbSep)
			For Each strPos In arPos
				If IsNumeric(strPos) Then
					'If (numArray >= strPos) Then 
						strArray = Replace(strArray, tgtArray(strPos) & vbSep, "")
					'End If 
				Else
					'strArray = Replace(strArray, ":" & strPos & "::", "") 
				End If
			Next
			arResult = Split(strArray, vbSep)
		Else
			arResult = Array("")
		End If
		sArrayControl = blResult
	End Function


上は 2002年頃から用いていたテンプレートベースなスクリプトに加筆修正を加えたモノを 公開に最適化する事無く 自前のスクリブト
を用いて雑にHTML化した状態となっており、昨今用いている 行に於ける文字数の少ない其れと異なり Web公開には不適な "幅"
がある点 御了承の程()

0 件のコメント:

コメントを投稿

注: コメントを投稿できるのは、このブログのメンバーだけです。