SQLの窓

2018年02月20日


VBScript + PowerShell : PowerShell がファイルを開くダイアログで取得したパスをテキストファイル経由で VBScript に戻して使用する

PowerShell : ファイルを開くダイアログを使うのに System.Windows.Forms を参照する二つの方法 で、C# のコードを使って PowerShell 内で『ファイルを開くダイアログ』を使用しました。

ここでは、その結果のパスを VBScript に渡す方法として、TEMP フォルダに適当なファイルを作成して引き渡します。呼び出しはもちろん VBScript から行います。この呼び出しは同期処理なので、特に問題なく順番に実行されます。

方法として、PowerShell の標準出力を VBScript で取り込む方法もあるのですが、その場合は VBScrip からの呼び出しが非同期となってしまうので、ユーザ側の操作が少し煩雑になるのでテキストファイル渡しとしました。

さらにもう一つ、InternetExplorer.Application オブジェクトを使用してクリップボード経由で取り込む方法もありますが、IE11 はさすがにいつどうなるか解らないので避けたいところです。( htmlfile オブジェクトでもできるはずですが、やはりテキストファイル経由が確実と思われます )

Windows7 の PowerShell で -Sta 引数を使う

PowerShell スクリプトの呼び出しは、セキュリティ上の問題で設定が必要なので、PowerShell の引数で一時的に実行可能にするのですが、Windows7 で -Sta を指定しないと動作しないので注意です。(Windows10 は動いています。Windows7 : バージョン2 / Windows10 : バージョン5 )

get_ps_tempfile.vbs
Set WshShell = WScript.CreateObject("WScript.Shell")
Set Fso = CreateObject( "Scripting.FileSystemObject" )

' 同期処理で実行( コマンドプロンプトは開かない )
Call WshShell.Run( "powershell -NoProfile -ExecutionPolicy Unrestricted .\open_file_dialog_cs.ps1", 0, True )
' Windows7 では、powershell -Sta -NoProfile -ExecutionPolicy Unrestricted .\open_file_dialog_cs.ps1

strPath = WshShell.ExpandEnvironmentStrings("%temp%")

' PowerShell 内の C# が出力したパスを取得
Set objHandle = Fso.OpenTextFile( strPath & "\_param.txt", 1 )
strParam = objHandle.ReadAll
objHandle.Close

if strParam = "キャンセルされました" then
	MsgBox "ここで処理を中断"
else
	' 取得したパス
	MsgBox strParam
end if



PowerShell 独特の世界をいまさら覚える時間もったいないので、C# で書いたほうがいろいろ手っ取り早いと思います。(取り回しは、VBScript だけでなんとかなりそうな気もしてます)

open_file_dialog_tempfile_cs.ps1
$code = @"
using System;
using System.IO;
using System.Text;
using System.Windows.Forms;
public class MyClass {
	public static string Open() {

		OpenFileDialog obj = new OpenFileDialog();
		obj.Filter = "Excel|*.xlsx|旧 Excel|*.xls|全て|*.*";
		obj.InitialDirectory = @"C:\";

		if (obj.ShowDialog() == DialogResult.OK) {
			return obj.FileName;
		}
		else {
			return "キャンセルされました";
		}

	}
	public static void Put(string param) {
		string path = Environment.GetEnvironmentVariable("temp");
		if (path == null) {
			path = Path.GetDirectoryName(System.Reflection.Assembly.GetExecutingAssembly().Location);
		}
		path = string.Format(@"{0}\_param.txt", path);

		// SHIFT_JIS で書き込み
		Encoding Enc = Encoding.GetEncoding(932);
		using (StreamWriter WriteFile = new StreamWriter( path, false, Enc )) {
			WriteFile.Write(param);
			WriteFile.Close();
		}
	}
}
"@

Add-Type -Language CSharp -TypeDefinition $code -ReferencedAssemblies ("System.Windows.Forms")

$param = [MyClass]::Open()
[MyClass]::Put($param)



posted by lightbox at 2018-02-20 18:20 | Comment(0) | VBScript | このブログの読者になる | 更新情報をチェックする

2018年02月19日


VBScript : XMLファイルのテキストノードの値の更新

概要

ターゲットは、WEB 上にあるサンプルXML です。その中にある param-value の中の一つを書き換えます( 中の値によって対象かどうかを判断しています )

objXML.async = False を指定しないと、処理中のどの時点で XML ドキュメントが有効になるかを判断できません。VBScript はイベント処理がオブジェクトに依存するので、このようにしています。

※ VBScript は SHIFT_JIS で記述されていますが、XML を UTF-8 で記述しているので、オブジェクト的に問題ありません。書き出した sample.xml も utf8n で保存されています。
' オブジェクト作成
Set Fso = CreateObject("Scripting.FileSystemObject")
Set objXML = CreateObject("Msxml2.DOMDocument.6.0")

' WEB からのデータ取得をその場で完了させる
objXML.async = False

' スクリプトのあるディレクトリ
strCurDir = WScript.ScriptFullName
Set obj = Fso.GetFile( strCurDir )
Set obj = obj.ParentFolder
strCurDir = obj.Path

' XML を読み込み
objXML.load( "https://lightbox.sakura.ne.jp/demo/sample.xml" )

' 全体の表示
MsgBox( objXML.xml )

Set ParamValue = objXML.getElementsByTagName("param-value")

For I = 0 to ParamValue.length - 1

	if ParamValue.item(I).firstChild.nodeValue = "UTF8N で保存してます" then
		' 置き換え
		ParamValue.item(I).firstChild.nodeValue = "本文を変更しました"
		Exit For
	end if
Next

' XML を保存
objXML.save( strCurDir & "\sample.xml" )



MsgBox の結果



<?xml version="1.0" encoding="UTF-8"?>
<note>
  <param-value>あなた</param-value>
  <param-value>私</param-value>
  <param-value>XMLサンプル</param-value>
  <param-value>UTF8N で保存してます</param-value>
</note>






タグ:VBScript xml DOM
posted by lightbox at 2018-02-19 14:16 | VBScript | このブログの読者になる | 更新情報をチェックする

2018年02月16日


HTA : 指定したキーでレジストリエディタを開く



WSH : 指定したキーでレジストリエディタを開く は、WSH での処理なので、どちらかと言えばバッチ処理です。連続してレジストリエディタの作業をするのでは無く、その場限りの処理で使ったりします( とにかくある場所のレジストリキーを開きたい等 )

このサンプルは、ある目的の作業中にレジストリエディタの特定のキーを、何度も連続して開く事を想定していますので、GUI を持つ HTA を使っています。
右端のアイコンよりダウンロードできます
<SCRIPT language="VBScript">

	Dim WshShell

	Set WshShell = CreateObject( "WScript.Shell" )

	Dim objWMIService

	Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

</SCRIPT>
<html>
<head>
<title>指定したキーでレジストリエディタを開く</title>
<meta http-equiv="content-type" content="text/html; charset=SHIFT_JIS">
<HTA:APPLICATION ID="Sqlwin"
	BORDERSTYLE="sunken"
	INNERBORDER="yes"
	SCROLL="no"
	ICON="http://winofsql.jp/WinOfSql.ico"
>

<style type="text/css">
* {
	font-family: "メイリオ"
	font-size: 16px;
}
body {
	margin:0;
	background-color: white;
}

.action {
	margin-top: 20px;
	margin-left: 20px;
}

</style>

<SCRIPT language="VBScript">

Function ActionOpenReg( str )

	Dim colProcessList

	Set colProcessList = objWMIService.ExecQuery _ 
		("Select * from Win32_Process Where Name = 'regedit.exe'") 
	For Each objProcess in colProcessList 
		WshShell.AppActivate("レジストリ エディタ")
		WshShell.SendKeys ("%{F4}")
	Next 

	Call window.setTimeout("Call OpenReg(""" & str & """)", 500 )

End Function

Function OpenReg( str )

	Dim colProcessList

	Set colProcessList = objWMIService.ExecQuery _ 
		("Select * from Win32_Process Where Name = 'regedit.exe'") 
	For Each objProcess in colProcessList 
		on error resume next
		objProcess.Terminate() 
		on error goto 0
	Next 

	Dim strRegSavePoint

	if GetOSVersion() >= 6 then
		str = "コンピュータ\" & str
	else
		str = "マイ コンピュータ\" & str
	end if

	strRegSavePoint = "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"
	WshShell.RegWrite "HKCU\" & strRegSavePoint, str, "REG_SZ"

	Call WshShell.Run( "regedit" )

End Function

' **********************************************************
' OS バージョンの取得
' **********************************************************
Function GetOSVersion()

	Dim colTarget,str,aData,I,nTarget

	Set colTarget = objWMIService.ExecQuery( _
		 "select Version from Win32_OperatingSystem" _
	)
	For Each objRow in colTarget
		str = objRow.Version
	Next

	aData = Split( str, "." )
	For I = 0 to Ubound( aData )
		if I > 1 then
			Exit For
		end if
		if I > 0 then
			nTarget = nTarget & "."
		end if
		nTarget = nTarget & aData(I)
	Next

	GetOSVersion = CDbl( nTarget )

End Function
</SCRIPT>


</head>
<body>

<input class="action" type="text" id="key" style='width:600px;' value="HKEY_LOCAL_MACHINE\Software\Microsoft\Windows\CurrentVersion\Run">
<input class="action" type="button" value=" 開く " onClick='Call ActionOpenReg(document.getElementById("key").value)'>

</BODY>
</html>
<SCRIPT for="window" event="onload" language="VBScript">

	window.focus()
	top.moveTo 0, 0
	top.resizeTo 800, 120

</SCRIPT>

<SCRIPT for="window" event="onunload" language="VBScript">


</SCRIPT>




posted by lightbox at 2018-02-16 08:27 | VBScript | このブログの読者になる | 更新情報をチェックする

2018年01月28日


WSH(VBScript) : 指定したキーでレジストリエディタを開く

今まで、コマンドプロンプトやエクスプローラから実行するのが一般的でしたが、Windows10 の PowerShell ウインドウからも実行できます( コマンドプロンプトと一応は同じです )



open_reg.vbs
ソースツールバーの右端のアイコンよりダウンロードできます
Set obj = Wscript.CreateObject("Shell.Application")
Dim strParam
if Wscript.Arguments.Count = 0 then
	' 引数が無い場合は、まずクリップボードを確認

	' クリップボード用
	' ※ HTA 等では直接 window.clipboardData より実行
	' ※ するように書き換える必要があります
	Set objIE = CreateObject("InternetExplorer.Application")
	objIE.Navigate("about:blank")
	Do While objIE.Busy
		' 100 ミリ秒
		Wscript.Sleep 100
	Loop
	strParam = objIE.document.parentWindow.clipboardData.GetData( "Text" ) & ""
	objIE.Quit

	strParam = Trim( strParam )
	' 無ければ入力
	if strParam = "" then
		strParam = InputBox("開く対象となるレジストリーのキーを入力して下さい","指定したキーでレジストリエディタを開く","HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft")
	end if

	' 管理者として実行を強制する
	obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas """ & strParam & """", "", "runas", 1
	Wscript.Quit

else
	strParam = WScript.Arguments(0)
	if strParam <> "runas" then
		' 管理者として実行を強制する
		Set obj = Wscript.CreateObject("Shell.Application")
		if Wscript.Arguments.Count = 1 then
			obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas """ & strParam & """", "", "runas", 1
			Wscript.Quit
		end if
	end if
end if


' 引数
strParam = WScript.Arguments(1)

strParam = Trim( strParam )

' レジストリ書き込み用
Set WshShell = CreateObject( "WScript.Shell" )
' WMI用
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

' レジストリエディタが最後に開いていたキーの登録を行います
strPath = "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"
if GetOSVersion() >= 6 then
	strRegPath = "コンピュータ\" & strParam
else
	strRegPath = "マイ コンピュータ\" & strParam
end if

' 既に regedit が実行中の場合はいったん終了させます
Set colProcessList = objWMIService.ExecQuery _ 
	("Select * from Win32_Process Where Name = 'regedit.exe'") 
For Each objProcess in colProcessList
	' 最後のウインドウの位置とサイズを保存する為の終わらせ方
	WshShell.AppActivate("レジストリ エディタ")
	Wscript.Sleep(500)
	WshShell.SendKeys ("%{F4}")
	Wscript.Sleep(500)
	' 上記終わらせ方が失敗した時の強制終了
	on error resume next
	objProcess.Terminate() 
	on error goto 0
Next 

WshShell.RegWrite "HKCU\" & strPath, strRegPath, "REG_SZ"

' レジストリエディタを起動します
Call WshShell.Run( "regedit.exe" )
' レジストリエディタが終わるまで待つ場合は以下のようにします
' Call WshShell.Run( "regedit.exe", , True )

REM **********************************************************
REM OS バージョンの取得
REM **********************************************************
Function GetOSVersion()

	Dim colTarget,str,aData,I,nTarget

	Set colTarget = objWMIService.ExecQuery( _
		 "select Version from Win32_OperatingSystem" _
	)
	For Each objRow in colTarget
		str = objRow.Version
	Next

	aData = Split( str, "." )
	For I = 0 to Ubound( aData )
		if I > 1 then
			Exit For
		end if
		if I > 0 then
			nTarget = nTarget & "."
		end if
		nTarget = nTarget & aData(I)
	Next

	GetOSVersion = CDbl( nTarget )

End Function

ファイル名を指定、またはコマンドプロンプトから実行では、以下のようにします。
wscript.exe open_reg.vbs HKEY_CURRENT_USER\Console
クリップボードにキーがある場合は open_reg.vbs をそのままエクスプローラからダブルクリックします。 クリツプボードにデータが空の場合は、入力ダイアログを表示します(上記コードではデフォルトとして HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft を表示しています) 権限やセキュリティの関係でいろいろダイアログが表示されると事がほとんどです。 ▼ IE11 のクリップボード操作の制限 (IE の設定で、常に使用可能にする事もできます) また、これ以外にも、regedit.exe を実行する際に、管理者実行の確認がありますが、サンプルとして常に管理者権限で実行できるようにしています。。 管理者権限を取得しない単純コード
ソースツールバーの右端のアイコンよりダウンロードできます
Dim strParam

if Wscript.Arguments.Count = 0 then
	strParam = "HKEY_LOCAL_MACHINE\SYSTEM\CurrentControlSet\Control\ComputerName\ComputerName"
else
	strParam = WScript.Arguments(0)
end if



' レジストリ書き込み用
Set WshShell = CreateObject( "WScript.Shell" )
' WMI用
Set objWMIService = GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")

' レジストリエディタが最後に開いていたキーの登録を行います
strPath = "Software\Microsoft\Windows\CurrentVersion\Applets\Regedit\LastKey"
if GetOSVersion() >= 6 then
	strRegPath = "コンピュータ\" & strParam
else
	strRegPath = "マイ コンピュータ\" & strParam
end if

' 既に regedit が実行中の場合はいったん終了させます
Set colProcessList = objWMIService.ExecQuery _ 
	("Select * from Win32_Process Where Name = 'regedit.exe'") 
For Each objProcess in colProcessList
	' 最後のウインドウの位置とサイズを保存する為の終わらせ方
	WshShell.AppActivate("レジストリ エディタ")
	Wscript.Sleep(500)
	WshShell.SendKeys ("%{F4}")
	Wscript.Sleep(500)
	' 上記終わらせ方が失敗した時の強制終了
	on error resume next
	objProcess.Terminate() 
	on error goto 0
Next 

WshShell.RegWrite "HKCU\" & strPath, strRegPath, "REG_SZ"

' レジストリエディタを起動します
Call WshShell.Run( "regedit.exe" )
' レジストリエディタが終わるまで待つ場合は以下のようにします
' Call WshShell.Run( "regedit.exe", , True )

REM **********************************************************
REM OS バージョンの取得
REM **********************************************************
Function GetOSVersion()

	Dim colTarget,str,aData,I,nTarget

	Set colTarget = objWMIService.ExecQuery( _
		 "select Version from Win32_OperatingSystem" _
	)
	For Each objRow in colTarget
		str = objRow.Version
	Next

	aData = Split( str, "." )
	For I = 0 to Ubound( aData )
		if I > 1 then
			Exit For
		end if
		if I > 0 then
			nTarget = nTarget & "."
		end if
		nTarget = nTarget & aData(I)
	Next

	GetOSVersion = CDbl( nTarget )

End Function





posted by lightbox at 2018-01-28 21:58 | VBScript | このブログの読者になる | 更新情報をチェックする

2017年12月20日


XCOPYで新しいファイルのみバックアップする為のスクリプトを作成するスクリプト



ディレクトリ選択でバックアップするディレクトリを決定し、カレントディレクトリにバックアップする為のスクリプトを作成します。

▼ 実行時に表示されるディレクトリ選択


そのスクリプトを実行すると、スクリプトがあるカレントのディレクトリに目的のディレクトリをバックアップとしてコピーします。
XCOPY なので、2回目以降は新しいファイルのみコピーします

▼ 使用するオプション
/D : コピー元の日付がコピー先の日付より新しいファイルだけをコピーします
/E : ディレクトリまたはサブディレクトリが空であってもコピーします
/C : エラーが発生してもコピーを続けます
/S : 空の場合を除いて、ディレクトリとサブディレクトリをコピーします
/Y : 既存のファイルを上書きする前に確認のメッセージを表示しません

一番重要なのは、/D です。/S /E で、存在するディリクトリはすべてコピーされます。/E /Y によって、最後まで停止する事なく実行されます。

追加で使う事が想定されるオプション

コピーしたくないディレクトリやファイルがある場合、以下のように指定します。

/EXCLUDE:ファイルのパス

ファイルのパスが示すテキストファイル内に、除外するディレクトリやファイルにある文字列の一部を1 行に 1 つずつ記述します。

その文字列が、コピー対象ファイルの絶対パスの一部と一致した場合、そのファイルはコピーから除外されます。たとえば、"\obj\" という文字列を指定するとディレクトリ obj の下の全ファイルが除外 されます。".obj" という文字列を指定すると .obj という拡張子のファイルがすべて除外されます

ソースコード
' ***********************************************************
' 処理開始
' ***********************************************************
Set Fso = Wscript.CreateObject( "Scripting.FileSystemObject" )
Set Shell = Wscript.CreateObject( "Shell.Application" )

' ***********************************************************
' 実行中ディレクトリの取得
' ***********************************************************
strPath = Wscript.ScriptFullName 
Set objFile = Fso.GetFile( strPath )
strBackupFolder = Fso.GetParentFolderName( objFile )

' ***********************************************************
' バックアップ対象ディレクトリの取得
' ***********************************************************
' マイ コンピュータを基準にディレクトリ選択
Set objFolder = Shell.BrowseForFolder( 0, "バックアップするフォルダを選択してください", &H4B, _
	"::{20D04FE0-3AEA-1069-A2D8-08002B30309D}" )
if objFolder is nothing then
	WScript.Quit
end if
if not objFolder.Self.IsFileSystem then
	WScript.Echo "ファイルシステムではありません"
	WScript.Quit
end if

strTargetFolder = objFolder.Self.Path
strName = Replace( strTargetFolder, ":", "" )
strName = Replace( strName, "\", "_" )
strName = Replace( strName, " ", "" )
strName = "BK_" & strName

' ***********************************************************
' スクリプト作成
' ***********************************************************
Set OutFile = Fso.OpenTextFile( strBackupFolder & "\" & strName & ".vbs", 2, True )

OutFile.WriteLine "strName = Replace( UCase(WScript.ScriptName), "".VBS"", """" )"
OutFile.WriteLine "strTarget = """ & strTargetFolder & """"
OutFile.Write "if MsgBox( strTarget & vbCrLf & ""のバックアップを開始します。"
OutFile.WriteLine "よろしいですか?"", 1 ) = 2 then"
OutFile.WriteLine "	Wscript.Quit"
OutFile.WriteLine "end if"

OutFile.WriteLine "Set WshShell = Wscript.CreateObject( ""WScript.Shell"" )"
OutFile.Write "ExecCommand = ""cmd.exe /C """"xcopy.exe """""
OutFile.Write strTargetFolder & """"" """""
OutFile.Write strBackupFolder & "\"" & strName & ""\"""""
OutFile.WriteLine " /D /E /C /S /Y & PAUSE"""""""
OutFile.WriteLine "Call WshShell.Run( ExecCommand )"

OutFile.Close

WScript.Echo "バックアップスクリプト : " &  strName & ".vbs" & " を作成しました"

更新履歴
2009-06-28 : 記事作成
2013-04-02 : ダウンロード追加
2015-08-07 : ダウンロードを zip 化( Google Chrome 対応 )



posted by lightbox at 2017-12-20 11:33 | VBScript | このブログの読者になる | 更新情報をチェックする

2014年03月11日


VBScript : WEB上のHTMLを使用して、InternetExplorer.Application でパスワード入力を実装する

昔はセキュリティがゆるかったので、ローカルの C:\ のパスで使えたのですが、今は http:// でないと使え無いので画面を http://winofsql.jp/password.htm として置いています。



入力後、きちんと IE は閉じます。

また、IE11 環境で実行しているので、VBScript を利用可能にする為、以下の記述は必要です。
<meta http-equiv="X-UA-Compatible" content="IE=8">
<html>
<head>
<meta http-equiv="X-UA-Compatible" content="IE=8">
<SCRIPT LANGUAGE="VBScript">
 
Sub RunScript 
	document.getElementById("OKClicked").Value = "OK"
End Sub 

Sub CancelScript 
	document.getElementById("OKClicked").Value = "Cancelled"
End Sub 

</SCRIPT> 

<BODY> 
<pre>
Password:
<input type="password" id="UserPassword" size="40">
<input type="hidden" id="OKClicked" size="20"> 
<input class="button" type="button" value=" OK " onClick="RunScript"
> <input class="button" type="button" value="Cancel" onClick="CancelScript">
</pre>
</body>
</html>
※ ローカルでは無いので必ず、Busy 対処は必要です。
※ Sleep を使用して、入力されたかどうかを監視して待機しています。
' 管理者として実行を強制する
Set obj = Wscript.CreateObject("Shell.Application")
if Wscript.Arguments.Count = 0 then
	obj.ShellExecute "wscript.exe", WScript.ScriptFullName & " runas", "", "runas", 1
	Wscript.Quit
end if

' オブジェクト作成
Set objExplorer = WScript.CreateObject("InternetExplorer.Application") 
 
' オブジェクト設定
objExplorer.Navigate "http://winofsql.jp/password.htm"	
objExplorer.ToolBar = 0 
objExplorer.StatusBar = 0 
objExplorer.Width = 400 
objExplorer.Height = 350  
objExplorer.Left = 300 
objExplorer.Top = 200 
objExplorer.Visible = True

' ページのロードを待つ
Do While objExplorer.Busy
	' 100 ミリ秒
	Wscript.Sleep 100
Loop
 
' 入力状態を監視
Do While (objExplorer.document.getElementById("OKClicked").Value = "") 
	Wscript.Sleep 250
Loop  

' パスワード取得
strPassword = objExplorer.document.getElementById("UserPassword").Value
' ボタンの判定用
strButton = objExplorer.document.getElementById("OKClicked").Value

' オブジェクト終了
objExplorer.Quit
' 少し待機
Wscript.Sleep 250 

' 入力判定
If strButton = "Cancelled" Then 
	Wscript.Quit 
Else 
	Wscript.Echo strPassword 
End If

Wscript.Echo strPassword


関連する記事

IE11 で VBScript を使う場合の注意事項 ( 古い社内アプリ移行時必見 )



posted by lightbox at 2014-03-11 20:27 | VBScript | このブログの読者になる | 更新情報をチェックする

2011年12月21日


VBS : 正規表現で、URL リストの中のドメイン部分のみを取り出す

処理そのものは一般的なものですが、VBScript の正規表現の記述は、
JavaScript のそれより少し複雑です。

まず、最初に New RegExp で正規表現処理用のオブジェクトを作成し
て、どのような検索をするかは、プロパティに設定します。

さらに、() を使った中の文字列を取得するには、Pattern に指定した
正規表現全体の文字列が入っている Match に対して、プロパティとし
て SubMatches コレクションが存在するので、その中の先頭として取り
出しています

今回、() の指定は一つだったので、SubMatches(0) しか存在しませんが、複数
の場合は、インデックスに 1 以上を使って参照します

※ .jp のみの場合は regEx.Pattern = "http://(.+?\.jp)/"

Dim str : str = "http://winofsql.jp/php/cnvtext/frame.htm" & vbCrLf & _
"http://js4web.seesaa.net/article/122772668.html" & vbCrLf & _
"http://hp.vector.co.jp/authors/VA003334/mslink.htm"

MsgBox(str)

Dim regEx : Set regEx = New RegExp

' 検索パターンを文字列で設定
regEx.Pattern = "http://(.+?)/"
' 大文字小文字を区別しない
' ( この場合はどちらでも良い )
regEx.IgnoreCase = True
' 文字列全体を検索
' False だと一件しか検索しない
regEx.Global = True   

' 検索の実行
Dim Matches : Set Matches = regEx.Execute(str)

Dim Match
For Each Match in Matches
	' 検索結果の中の () 内の文字列を取得
	MsgBox(Match.SubMatches(0))
Next



posted by lightbox at 2011-12-21 13:17 | VBScript | このブログの読者になる | 更新情報をチェックする

2011年08月14日


文字列を指定してその名前の変数でオブジェクトを作成する : WEB に VBScript ライブラリ

WEB に VBScript ライブラリ

Dim で定義するのと同等の処理となります。
この処理は、関数内でグローバルスコープの変数を作成する事が可能な事を示しています。

※ 拡張子を .vbs にして実行してみて下さい。
' 関数のソースコードを読みだして、関数として定義
strResult = HTTPGet( "http://toolbox.winofsql.jp/vbs/createobject.php" )
' エラー処理は省略しています
ExecuteGlobal strResult 

' 実行中のスクリプトのタイプ
Call GetObj( "WshShell", "WScript.Shell" )
print WshShell.CurrentDirectory

Function HTTPGet( strUrl )

	Dim http

	Set http = CreateObject( "Msxml2.ServerXMLHTTP" )

	on error resume next
	Call http.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		HTTPGet = Empty
		Exit Function
	end if
	on error goto 0

	Call http.Send()

	HTTPGet = http.responseText

End Function

PHP でホスティングされた関数
( ScriptType 関数が別途必要です ) 
<?
header( "Content-Type: text/plain; Charset=shift_jis" );
header( "pragma: no-cache" );
header( "Expires: Wed, 31 May 2000 14:59:58 GMT" );
header( "Cache-control: no-cache" );
?>
REM **********************************************************
REM 実行中のスクリプト別簡易表示
REM **********************************************************
Sub print( strData )

	Dim strType

	strType = ScriptType( )

	Select Case strType
		Case 1
			Wscript.Echo strData
		Case 2
			alert( strData )
		Case 3
			Response.Write strData
	End Select

End Sub

REM **********************************************************
REM 文字列を指定して、変数にオブシェクトを作成させる
REM **********************************************************
Function GetObj( strTarget, strObjectName )

	Dim ExecuteString

	ExecuteString = "Dim " & strTarget & " : "
	ExecuteString = ExecuteString & "Set " & strTarget & " = "

	Select Case ScriptType
		Case 1
			ExecuteString = ExecuteString & _
			"WScript.CreateObject("
		Case 2
			ExecuteString = ExecuteString & _
			"CreateObject("
		Case 3
			ExecuteString = ExecuteString & _
			"Server.CreateObject("
		Case Else
			ExecuteString = ExecuteString & _
			"CreateObject("
	End Select

	ExecuteString = ExecuteString & """" & strObjectName & """" & ")"

	ExecuteGlobal ExecuteString

End Function

関連する記事

実行中のスクリプトのタイプを知る : WEB に VBScript ライブラリ


posted by lightbox at 2011-08-14 17:36 | VBScript | このブログの読者になる | 更新情報をチェックする

実行中のスクリプトのタイプを知る : WEB に VBScript ライブラリ

WEB に VBScript ライブラリ

特に実用的なコードではありませんし、タイプと言っても WSH か HTA か ASP
なので、使い方が相当違うのでライブラリ側を完全の共用する場合にのみ必要
になって来ます。

Msxml2.ServerXMLHTTP の作成として CreateObject を使っていますが、単純な
スクリプトの場合の場合は必ず最初にこの関数だけはクライアントに必要なので
スクリプトのタイプは無視してどれでも一応実行可能な CreateObject で作成し
ています。
( 本来は、WSH は、WScript.CreateObject で、ASP は、Server.CreateObject )
' 関数のソースコードを読みだして、関数として定義
strResult = HTTPGet( "http://toolbox.winofsql.jp/vbs/createobject.php" )
if not IsEmpty( strResult ) and Left( strResult, 3 ) = "REM" then
	' 関数定義の実行
	ExecuteGlobal strResult
else
	if IsEmpty( strResult ) then
		MsgBox(Err.Description)
	else
		MsgBox(strResult)
	end if
	Wscript.Quit
end if

' 実行中のスクリプトのタイプ
MsgBox( ScriptType() )

Function HTTPGet( strUrl )

	Dim http

	Set http = CreateObject( "Msxml2.ServerXMLHTTP" )

	on error resume next
	Call http.Open("GET", strUrl, False )
	if Err.Number <> 0 then
		HTTPGet = Empty
		Exit Function
	end if
	on error goto 0

	Call http.Send()

	HTTPGet = http.responseText

End Function

以下は、php でホスティングしている VBScript の関数です
<?
header( "Content-Type: text/plain; Charset=shift_jis" );
header( "pragma: no-cache" );
header( "Expires: Wed, 31 May 2000 14:59:58 GMT" );
header( "Cache-control: no-cache" );
?>
REM **********************************************************
REM 実行中のスクリプトのタイプの取得
REM 1:WSH, 2:HTA, 3:ASP, 0:不明
REM **********************************************************
Function ScriptType( )

	Dim nType

	nType = 0

	if IsObject( Wscript ) then
		nType = 1
	else
		if IsObject( window ) then
			nType = 2
		else
			if IsObject( Server ) then
				nType = 3
			end if
		end if
	end if

	ScriptType = nType

End Function

関連する記事

VBScriptの関数定義をWEB上に置いて、Msxml2.ServerXMLHTTP で読みだして PCで使用する



posted by lightbox at 2011-08-14 17:12 | VBScript | このブログの読者になる | 更新情報をチェックする

2010年01月06日


VBS : FileZilla用誰にでも使える拡張子ランチャー

FileZilla Client 用に作りましたが、どこでも使えると思います。ただ、呼び出し方は wscript.exe の正しい位置をパスで指定して "" で囲う事が重要です

▼ 例
"C:\Windows\System32\wscript.exe" "C:\user\runext.vbs"



FileZilla は、設定したエディタで開くと、その開かれたファイルは監視されて更新されるとアップロードするかどうか聞いてきます。つまり、直接サーバーのファイルを更新するような作業ができます。ただ、エディタを一つしか指定できないので、このようなランチャーを登録してやると、テキストも画像も変更した後にすぐサーバへアップロードできます。また、複数開いても全て監視されるので、更新されたものが対象となります。とても便利です。
Set WshShell = WScript.CreateObject("WScript.Shell")

Dim aData,strExt,strExe
strExt = ""
aData = Split( Wscript.Arguments(0), "." )
if Ubound( aData ) > 0 then
	strExt = UCase( aData( Ubound( aData ) ) )
end if

' 拡張子別エディタ
if strExt = "JPG" then
	strExe = "MSPAINT.EXE"
	RunExt( strExe )
	Wscript.Quit
end if
if strExt = "JPEG" then
	strExe = "MSPAINT.EXE"
	RunExt( strExe )
	Wscript.Quit
end if
if strExt = "PNG" then
	strExe = "MSPAINT.EXE"
	RunExt( strExe )
	Wscript.Quit
end if
if strExt = "GIF" then
	strExe = "MSPAINT.EXE"
	RunExt( strExe )
	Wscript.Quit
end if

' デフォルトのエディタ
strExe = "C:\Program Files\tpad093\TeraPad.exe"
RunExt( strExe )

Function RunExt( path )

	WshShell.Run( """" & path & """" & " " _
		& """" & Wscript.Arguments(0) & """" )

End Function

関連する記事

FileZilla Client ( SFTPの利用 )




posted by lightbox at 2010-01-06 19:35 | VBScript | このブログの読者になる | 更新情報をチェックする

2009年10月07日


VBS : コマンドプロンプト用、PATH 環境変数をフォルダ毎に表示

Pl
( 前半はシステム環境変数、後半はユーザ環境変数 )

pl.bat
呼び出し用のバッチファイルです
@echo off
cscript.exe //NOLOGO %~dp0pathlist.vbs
pathlist.vbs
処理本体です。
直接動かすと、Wscript.exe が呼び出されるので、
メッセージボックスが表示されます

直接呼び出し1 : エクスプローラからダブルクリック等
直接呼び出し2 : コマンドプロンプトで pathlist と入力

Pl
Set WshShell = WScript.CreateObject("WScript.Shell")
Set WshSysEnv1 = WshShell.Environment("SYSTEM")
Set WshSysEnv2 = WshShell.Environment("USER")
strOut = ""
strPath = WshSysEnv1("PATH")
aData = Split(strPath,";")
For I = 0 To Ubound(aData)
	if Trim(aData(I)) <> "" then
		if strOut <> "" then
			strOut = strOut & vbCrLf
		end if
		strOut = strOut & aData(I)
	end if
Next
strPath = WshSysEnv2("PATH")
if Trim( strPath ) <> "" then
	strOut = strOut & vbCrLf
	aData = Split(strPath,";")
	For I = 0 To Ubound(aData)
		if Trim(aData(I)) <> "" then
			if strOut <> "" then
				strOut = strOut & vbCrLf
			end if
			strOut = strOut & aData(I)
		end if
	Next
end if

WScript.Echo strOut

関連する記事
laylaClass バッチ処理支援パッケージ ( バッチ処理 )


posted by lightbox at 2009-10-07 15:09 | VBScript | このブログの読者になる | 更新情報をチェックする

2009年05月29日


VBScript : フォルダの中にある複数テキストファイルの指定した文字列を一括置換

フォルダ内に変換したい対象のテキストファイルをコピーして実行します。

スクリプトは、直接更新を行わず、オリジナルの内容を _org をフォルダ名の後に付けて保存した上で、一括変換します。
Set Fso = CreateObject( "Scripting.FileSystemObject" )

' カレントディレクトリにある対象ディレクトリ
strTarget = "res"

Set objFolder = Fso.GetFolder( strTarget )
objFolder.Name = objFolder.Name & "_org"

on error resume next
Call Fso.CreateFolder(strTarget)
on error goto 0

Set objFiles = objFolder.Files

For each objFile in objFiles
	' フルパス
	strFullPath = Fso.GetAbsolutePathName( strTarget & "_org\" & objFile.Name )
	strFullPath2 = Fso.GetAbsolutePathName( strTarget & "\" & objFile.Name )

	Set InObj = Fso.OpenTextFile( strFullPath, 1 )
	Set OutObj = Fso.OpenTextFile( strFullPath2, 2, True )
	Buffer = InObj.ReadAll
	Buffer = Replace(Buffer,"charset=UTF-8"">","charset=SHIFT_JIS"">")
	OutObj.Write Buffer
	OutObj.Close
	InObj.Close

Next





タグ:VBScript
posted by lightbox at 2009-05-29 13:38 | VBScript | このブログの読者になる | 更新情報をチェックする
Seesaa の各ページの表示について
Seesaa の 記事がたまに全く表示されない場合があります。その場合は、設定> 詳細設定> ブログ設定 で 最新の情報に更新の『実行ボタン』で記事やアーカイブが最新にビルドされます。

Seesaa のページで、アーカイブとタグページは要注意です。タグページはコンテンツが全く無い状態になりますし、アーカイブページも歯抜けページはコンテンツが存在しないのにページが表示されてしまいます。

また、カテゴリページもそういう意味では完全ではありません。『カテゴリID-番号』というフォーマットで表示されるページですが、実際存在するより大きな番号でも表示されてしまいます。

※ インデックスページのみ、実際の記事数を超えたページを指定しても最後のページが表示されるようです

対処としては、このようなヘルプ的な情報を固定でページの最後に表示するようにするといいでしょう。具体的には、メインの記事コンテンツの下に『自由形式』を追加し、アーカイブとカテゴリページでのみ表示するように設定し、コンテンツを用意するといいと思います。


※ エキスパートモードで表示しています

アーカイブとカテゴリページはこのように簡単に設定できますが、タグページは HTML 設定を直接変更して、以下の『タグページでのみ表示される内容』の記述方法で設定する必要があります

<% if:page_name eq 'archive' -%>
アーカイブページでのみ表示される内容
<% /if %>

<% if:page_name eq 'category' -%>
カテゴリページでのみ表示される内容
<% /if %>

<% if:page_name eq 'tag' -%>
タグページでのみ表示される内容
<% /if %>
この記述は、以下の場所で使用します
container 終わり

フリーフォントで簡単ロゴ作成
フリーフォントでボタン素材作成
フリーフォントで吹き出し画像作成
フリーフォントではんこ画像作成
ほぼ自由に利用できるフリーフォント
フリーフォントの書体見本とサンプル
画像を大きく見る為のウインドウを開くボタンの作成

CSS ドロップシャドウの参考デモ
BUTTONS (CSS でボタン)
イラストAC
ぱくたそ
写真素材 足成
フリーフォント一覧
utf8 文字ツール
右サイド 終わり
base 終わり