Windows Script Compornents(SCRIPT COM)の雛型作成スクリプト

ダウンロードして、エクスプローラからダブルクリック

コマンドプロンプトが表示されて、pause 状態なりますが
コマンドプロンプトは閉じて下さい。

上記画像のような状態になりますが、WSC のインストールはされていません。
script_com_年月日時間.wsc が本体なので、このファイルを変更して
自分専用の WSC を作成してインストールします。

ただ、既に動くようになっていますので、そのままインストールしても
動作しますし、インストールしてから変更しても、「スクリプト」なんで
全然問題ありません

一つだけ注意するのが、登録される「プログラムID」に、このままでは
年月日時間 が付加されたままだという事です

必要ならば、まず「プログラムID」の変更を行う

以下のソースコードが、WSC の先頭の内容ですが、先頭部分の registration にある
progid="Lbox.COM20081108173655" が「プログラムID」で、年月日時間
が付加されてしまっています。

これは、システム上1つしか無いものにしなければならないので、
そのままでも使えるようにこうしてあります。
自由に変更して、自分用の「プログラムID」にする事ができます。

例えば Lbox.COM20081108173655 => MyCOM.tool 
と変更する事を前提に話をすすめて行きます

<?xml version="1.0" encoding="shift_jis" ?>
<component>
 
<registration
    description="WSC Skeleton"
    progid="Lbox.COM20081108173655"
    version="1.00"
    classid="{704E3422-E729-43EA-B133-A7682355DFFA}"
>
</registration>

↓以下のように変更

<?xml version="1.0" encoding="shift_jis" ?>
<component>
 
<registration
    description="WSC Skeleton"
    progid="MyCOM.tool"
    version="1.00"
    classid="{704E3422-E729-43EA-B133-A7682355DFFA}"
>
</registration>

classid は、元々ユニークになるように作成されています。
これは、雛型を作成するたびに変わりますが、変更しないで下さい

インストール方法

インストーラも作成されていますが、「プログラムID」を変更したので
そのままでは使えません。以前のプログラム ID を変更して実行する必要
がありますが、これは運用上必要になった場合のサンプルで、
今インストールする場合はもっと簡単な方法があります

見たままですが、登録と登録解除ができるようになっています。
これは、regsvr32.exe で登録(登録解除)するのと同じ効果があります

ソースの中の「プログラムID」できちんと登録してくれますし、
簡単に登録解除可能なので、登録して下さい

↑のようなメッセージボックスが出て登録されます
( 結局 regsvr32.exe のメッセージですが )

実行テスト

test_com_年月日時間.vbs をエディタで変更してテストします。
( プログラムID の変更 )

Set obj = CreateObject( "Lbox.COM20081108173655" )
obj.ScriptDir = WScript.ScriptFullName
obj.SelectDir( "選択" )

↓以下のように変更

Set obj = CreateObject( "MyCOM.tool" )
obj.ScriptDir = WScript.ScriptFullName
obj.SelectDir( "選択" )

test_com_年月日時間.vbs をエクスプローラからダブルクリックすると、
以下のようなウインドウが表示されるはずです

※ 動かない場合は、script_com_年月日時間.wsc の内容が正しく変更されているか確認

システムの登録場所は、厳密には2箇所ですが、プログラムIDは
レジストリエディタで確認できます

( もう一つは CLSID )

インストーラとアンインストーラの変更

インストーラは、プログラムID とソース名を変更する必要があります
( 以前のプログラムIDの削除と再登録を行っています )

アンインストーラはプログラムID の変更が必要です

インストーラのソースコード

<JOB>
<SCRIPT
    language="VBScript"
    src="http://homepage2.nifty.com/lightbox/laylaClass.vbs">
</SCRIPT>
 
<SCRIPT language=VBScript>
' ***********************************************************
' 処理開始
' ***********************************************************
Call laylaFunctionTarget( "http://homepage2.nifty.com/lightbox/" )
Call laylaLoadFunction( "baseFunction.vbs" )
 
Crun
GetWshShell
 
on error resume next
strValue = WshShell.RegRead("HKCR\Lbox.COM20081108173655\CLSID\")
if Err.Number = 0 then
    ' 現在の情報でアンインストール
    strValue = "HKCR\CLSID\" & strValue
    strValue = strValue & "\ScriptletURL\"
    strValue = WshShell.RegRead(strValue)
    strValue = "regsvr32.exe scrobj.dll /s /u /n /i:""" & strValue & """"
    Call RunSync( strValue )
end if
on error goto 0
 
' インストール
strValue = "regsvr32.exe scrobj.dll /n /i:file://""" & ScriptDir & "\script_com_20081108173655.wsc" & """"
    Call RunSync( strValue )
 
Wscript.Echo "インストールが終了しました"
 
</SCRIPT>
 
</JOB>

WSC 雛型の内容

プロパティやメソッドの実装サンプルとして以下のような機能があります

1) スクリプトディレクトリの記憶( 内部変数の使用 )

2) クリップボードの読み書き( プロパティ )

3) MDB 作成( メソッド )

4) ファイルを開くダイアログ( Windows2000 でも動きます )
	※ XP 以降だともっといいのがあります

5) ディレクトリ選択( テストスクリプトで実行する内容 )

6) ファイルを表示しながらディレクトリ選択

<?xml version="1.0" encoding="shift_jis" ?>
<component>
 
<registration
    description="WSC Skeleton"
    progid="MyCOM.tool"
    version="1.00"
    classid="{704E3422-E729-43EA-B133-A7682355DFFA}"
>
</registration>
 
<public>
 
<comment>
************************************************************
* プロパティ
************************************************************
</comment>
    <property name="Clipboard">
        <get/>
        <put/>
    </property>
    <property name="ScriptDir">
        <get/>
        <put/>
    </property>
    <property name="LastError">
        <get/>
    </property>
 
<comment>
************************************************************
* メソッド
************************************************************
</comment>
    <method name="CreateMdb">
        <PARAMETER name="Path"/>
        <PARAMETER name="bDelete"/>
    </method>
    <method name="OpenFileName">
    </method>
    <method name="SelectDir">
        <PARAMETER name="strTitle"/>
    </method>
    <method name="SelectDirWidthFile">
        <PARAMETER name="strTitle"/>
    </method>
 
</public>
 
<script language="VBScript">
<![CDATA[
 
Dim ScriptDir
Dim ErrorMessage
 
' ************************************************
' プロパティ処理の実装
' ************************************************
' --------------------------------------
' クリップボード
' --------------------------------------
function get_Clipboard()
 
    Dim objIE
 
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate("about:blank")
    get_Clipboard = objIE.document.parentwindow.clipboardData.GetData("Text")
    objIE.Quit
    Set objIE = Nothing
 
end function
function put_Clipboard(srt)
 
    Dim objIE
 
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate("about:blank")
    objIE.document.parentwindow.clipboardData.SetData "Text", srt
    objIE.Quit
    Set objIE = Nothing
 
end function
' --------------------------------------
' スクリプトディレクトリの保存
' ScriptDir = WScript.ScriptFullName
' を必ず実行してから ScriptDir プロパティ
' を使用する
' --------------------------------------
function get_ScriptDir()
 
    get_ScriptDir = ScriptDir
 
end function
function put_ScriptDir(str)
 
    Dim Fs,obj
 
    Set Fs = CreateObject( "Scripting.FileSystemObject" )
 
    ScriptDir = str
    Set obj = Fs.GetFile( ScriptDir )
    Set obj = obj.ParentFolder
    ScriptDir = obj.Path
 
    Set Fs = Nothing
 
end function
' --------------------------------------
' 直近に発生したエラーメッセージ
' --------------------------------------
function get_LastError()
 
    get_LastError = ErrorMessage
 
end function
 
' ************************************************
' MDB 作成( bDelete が True で事前削除 )
' ************************************************
function CreateMdb( Path, bDelete )
 
    Dim Adox,Fs
 
    Set Adox = CreateObject( "ADOX.Catalog" )
    Set Fs = CreateObject( "Scripting.FileSystemObject" )
 
    if Fs.FileExists( Path ) then
        if bDelete then
            on error resume next
            Call Fs.DeleteFile( Path )
            if Err.Number <> 0 then
                CreateMdb = Err.Description
                Exit Function
            end if
            on error goto 0
        end if
    end if
 
    on error resume next
    Adox.Create "Provider=Microsoft.Jet.OLEDB.4.0;" & _
        "Data Source=" & Path & ";"
    if Err.Number <> 0 then
        CreateMdb = Err.Description
        Exit Function
    end if
    on error goto 0
 
    Set Adox.ActiveConnection = Nothing
    Set Adox = Nothing
    Set Fs = Nothing
 
end function
 
' **********************************************************
' ファイルを開くダイアログ
' **********************************************************
function OpenFileName( )
 
    Dim objIE,WshShell
 
    Set objIE = CreateObject("InternetExplorer.Application")
    objIE.Navigate( "about:blank" )
    objIE.document.getElementsByTagName("BODY")(0).innerHTML = _
        "<INPUT id=FilePath type=file>"
 
    objIE.Visible = True
    Set WshShell = CreateObject( "WScript.Shell" )
    WshShell.AppActivate "about:blank"
    Set WshShell = Nothing
    objIE.Visible = False
 
    objIE.document.getElementById("FilePath").click
    if objIE.document.getElementById("FilePath").value = "" then
        OpenFileName = ""
        objIE.Quit
        Set objIE = Nothing
        Exit Function
    end if
 
    OpenFileName = objIE.document.getElementById("FilePath").value
 
    objIE.Quit
    Set objIE = Nothing
 
End Function
 
' **********************************************************
' フォルダ選択(1)
' **********************************************************
Function SelectDir( strTitle )
 
    Dim Shell,obj
 
    Set Shell = CreateObject( "Shell.Application" )
 
    Set obj = Shell.BrowseForFolder( 0, strTitle, 11 + &h40, 0 )
    if obj is nothing then
        Set Shell = Nothing
        SelectDir = ""
        Exit Function
    end if
    if not obj.Self.IsFileSystem then
        Set Shell = Nothing
        ErrorMessage = "ファイルシステムではありません"
        SelectDir = ""
        Exit Function
    end if
 
    SelectDir = obj.Self.Path
 
    Set Shell = Nothing
 
End Function
 
' **********************************************************
' フォルダ選択(2) : ファイルも表示される
' **********************************************************
Function SelectDirWidthFile( strTitle )
 
    Dim Shell,obj
 
    Set Shell = CreateObject( "Shell.Application" )
 
    on error resume next
    Set obj = Shell.BrowseForFolder( 0, strTitle, 11 + &h4000 + &h40, 0 )
    if Err.Number <> 0 then
        Set Shell = Nothing
        ErrorMessage = "ファイルが選択されました"
        SelectDirAndFile = ""
        Exit Function
    end if
    on error goto 0
    if obj is nothing then
        Set Shell = Nothing
        SelectDirAndFile = ""
        Exit Function
    end if
    if not obj.Self.IsFileSystem then
        Set Shell = Nothing
        ErrorMessage = "ファイルシステムではありません"
        SelectDirAndFile = ""
        Exit Function
    end if
 
    SelectDirAndFile = obj.Self.Path
 
    Set Shell = Nothing
 
End Function
 
]]>
</script>
 
</component>