【VB.NET】dll を COM として登録して VBScript や PHP から使用

' **********************************************************   
' オブジェクト作成   
' **********************************************************   
Set obj = CreateObject( "night.toolVb" )   
  
' **********************************************************   
' 7-zip32.dll で 7zip 解凍   
' **********************************************************   
ret = obj.z7Melt( "test.zip", "melt" )   
obj.MsgBox( ret )

ブラウザでダウンロード

VBScrip と PHP

どちらも有用なスクリプトですが、Windows のネイティブな処理を行うには、
COM が必要となります。

しかし、VC++ で作成するのは少し敷居が高すぎますし、いろいろ転用する
のには無理があります。

ですから、多少面倒ではありますが、VB.NET で COM を公開します。

ビルド手順

; キーペア作成( この処理で作成されたファイルが GUID を持ちます )
sn -k lightbox.snk

; いったん、レジストリの登録を解除します
; night.dll が登録された場所に存在する場合に有効です
; ※ どうしても削除不能になった場合は readme.txt の最後を参照して下さい
regasm night.dll /u /tlb:nightLib.tlb

;$OPTION が、参照アセンブリの場所より置き換えられます
vbc.exe /target:library $OPTION night.vb

; レジストリに登録して、COM として使用可能にします
regasm night.dll /tlb:nightLib.tlb /codebase 

; レジストリの情報を出力します( unicode では無いので注意 )
; ※ これで出力される場所以外にタイプライブラリにも登録されます
regasm night.dll /regfile:night.reg

サンプルコード

通常の Framework の実装は容易です。

7-zip32.dll を使用した解凍処理を内部クラスとして実装して実現しています

Imports System
Imports System.Reflection
Imports System.Windows.Forms
Imports System.Runtime.InteropServices
Imports System.Text

' CreateObject( "night.toolVb ) で使用します 
<Assembly: AssemblyKeyFile("lightbox.snk")>
Namespace night

	' "night.toolVb"
	Public Class toolVb

		' ********************************************************
		' 簡単なメソッドのテスト
		' ********************************************************
		Public Sub MsgBox( str As String, Optional title As String = "" )

			if title = "" then
				MessageBox.Show( str )
			else
				MessageBox.Show( str, title )
			end if

		End Sub

		' ********************************************************
		' プロパティ
		' ********************************************************
		Public Property Clipboard() As String
			Get
				Return System.Windows.Forms.Clipboard.GetText()
			End Get
			Set(ByVal value As String)
				System.Windows.Forms.Clipboard.SetText(value)
			End Set
		End Property

		' ********************************************************
		' 7-zip32.dll で 7zip 解凍
		' ********************************************************
		Public Function Z7Melt( zip As String, target as String ) As String

			Dim zip7 As New SevenZip()
			Dim szOutput As New System.Text.StringBuilder(500)

			If Not zip7.Load() Then
				Return "DLLをロードできません"
			End If

			Dim szCommand As String = "x " + zip + " -o" + target
			zip7.DoSevenZip(Nothing, szCommand, szOutput, szOutput.Capacity)

			' 廃棄
			zip7.Dispose()

			return szOutput.toString()

		End Function

		Private Class SevenZip
		
			' ********************************************************
			' * DLL 内 関数宣言
			' ********************************************************
			<DllImport("Kernel32.dll", CharSet:=CharSet.Ansi)> _
			 Private Shared Function LoadLibrary( _
			  ByVal lpDllName As String) As IntPtr
			End Function
		
			<DllImport("Kernel32.dll", CharSet:=CharSet.Auto)> _
			Private Shared Function FreeLibrary( _
			 ByVal hModule As IntPtr) As Integer
			End Function
		
			<DllImport("Kernel32.dll", CharSet:=CharSet.Ansi)> _
			 Private Shared Function GetProcAddress( _
			  ByVal hModule As IntPtr, _
			  ByVal lpProcName As String) As IntPtr
			End Function
		
			<DllImport("Kernel32.dll", CharSet:=CharSet.Ansi)> _
			 Private Shared Function DosDateTimeToFileTime( _
			  ByVal wFatDate As Short, _
			  ByVal wFatTime As Short, _
			  <[In](), Out()> ByVal lpFileTime As FILETIME) As Boolean
			End Function
		
			<DllImport("Kernel32.dll", CharSet:=CharSet.Ansi)> _
			 Private Shared Function FileTimeToSystemTime( _
			   <[In](), Out()> ByVal lpFileTime As FILETIME, _
			   <[In](), Out()> ByVal lpSystemTime As SYSTEMTIME) As Boolean
			End Function
		
			' ********************************************************
			' * 構造体定義
			' ********************************************************
			<StructLayout(LayoutKind.Sequential, CharSet:=CharSet.Ansi)> _
			  Public Class INDIVIDUALINFO
				Public dwOriginalSize As Integer = 0
				Public dwCompressedSize As Integer = 0
				Public dwCRC As Integer = 0
				Public uFlag As Integer = 0
				Public uOSType As Integer = 0
				Public wRatio As Short = 0
				Public wDate As Short = 0
				Public wTime As Short = 0
				<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=513)> _
				Public szFileName As String = Nothing
				<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=3)> _
				  Public dummy1 As String = Nothing
				<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=8)> _
				 Public szAttribute As String = Nothing
				<MarshalAs(UnmanagedType.ByValTStr, SizeConst:=8)> _
				 Public szMode As String = Nothing
			End Class
		
			<StructLayout(LayoutKind.Sequential)> _
			  Public Class FILETIME
				Public dwLowDateTime As Integer = 0
				Public dwHighDateTime As Integer = 0
			End Class
		
			<StructLayout(LayoutKind.Sequential)> _
			Public Class SYSTEMTIME
				Public wYear As Short = 0
				Public wMonth As Short = 0
				Public wDayOfWeek As Short = 0
				Public wDay As Short = 0
				Public wHour As Short = 0
				Public wMinute As Short = 0
				Public wSecond As Short = 0
				Public wMilliseconds As Short = 0
			End Class
		
			' ********************************************************
			'引数
			'    _hwnd       7-zip32.dll を呼び出すアプリのウィンドウハンドル。
			'    _szFileName 書庫ファイル名。
			'    _dwMode     現時点では無視。0 を指定。
		
			'戻り値
			'    指定の書庫ファイルに対応したハンドル。エラー時は NULL
			' ********************************************************
			Public Delegate Function SevenZipOpenArchive( _
			 ByVal hwnd As IntPtr, _
			 <[In](), MarshalAs(UnmanagedType.LPStr)> ByVal szFileName As String, _
			 ByVal dwMode As Integer) As IntPtr
		
			' ********************************************************
			'戻り値
			'    正常終了時に 0 、異常時には -1 が返ります。
			' ********************************************************
			Public Delegate Function SevenZipCloseArchive( _
			ByVal harc As IntPtr) As Integer
		
			' ********************************************************
			'引数
			'    _harc       SevenZipOpenArchive() で返されたハンドル。
			'    _szWildName 検索するファイル名の指定。
			'                ワイルドカード指定が可能。
			'                ファイル名はスペース区切りで複数指定が可能。
			'    _lpSubInfo  結果を返すための INDIVIDUALINFO 構造体へのポインタ。
			'                結果を必要としない場合は NULL を指定できます。
		
			'戻り値
			'    0           正常終了。
			'    -1          検索終了。
			'    0，-1 以外  エラー終了。エラーコードを返します。
			' ********************************************************
			Public Delegate Function SevenZipFindFirst( _
			  ByVal harc As IntPtr, _
			  <[In](), MarshalAs(UnmanagedType.LPStr)> ByVal szWildName As String, _
			  <[In](), Out()> ByVal lpSubInfo As INDIVIDUALINFO) As Integer
		
			' ********************************************************
			'引数
			'    _harc       SevenZipOpenArchive() で返されたハンドル。
			'    _lpSubInfo  結果を返すための INDIVIDUALINFO 構造体へのポインタ。
			'                結果を必要としない場合は NULL を指定できます。
		
			'戻り値
			'    0           正常終了。
			'    -1          検索終了。
			'    0，-1 以外  エラー終了。エラーコードを返します。
			' ********************************************************
			Public Delegate Function SevenZipFindNext( _
			   ByVal harc As IntPtr, _
			   <[In](), Out()> ByVal lpSubInfo As INDIVIDUALINFO) As Integer
		
			' ********************************************************
			'_hwnd       7-zip32.dll を呼び出すアプリのウィンドウハンドル。
			'            7-zip32.dll は実行時にこのウィンドウに対して
			'            EnableWindow() を実行しウィンドウの動作を抑制します。
			'            ウィンドウが存在しないコンソールアプリの場合や、
			'            指定する必要のない場合は NULL を渡します。
			'_szCmdLine  7-zip32.dll に渡すコマンド文字列。
			'_szOutput   7-zip32.dll が結果を返すためのバッファ。
			'            グローバルメモリー 等の場合はロックされている必要が
			'            あります。
			'_dwSize     バッファのサイズ。
			'            結果が指定サイズを越える場合は、このサイズに
			'            切り詰められます。
			'            サイズが 1 以上であれば、常に最後に NULL 文字が
			'            付加されます。
			' ********************************************************
			Public Delegate Function SevenZip( _
			  ByVal hwnd As IntPtr, _
			  <[In](), MarshalAs(UnmanagedType.LPStr)> ByVal szCmdLine As String, _
			  <[In](), Out(), MarshalAs(UnmanagedType.LPStr)> ByVal szOutput As StringBuilder, _
			  ByVal dwSize As Integer) As Integer
		
			' 実行中のチェック
			Public Delegate Function SevenZipGetRunning() As Boolean
		
		
			Private hModule As IntPtr
			Public OpenArchive As SevenZipOpenArchive
			Public CloseArchive As SevenZipCloseArchive
			Public FindFirst As SevenZipFindFirst
			Public FindNext As SevenZipFindNext
			Public GetRunning As SevenZipGetRunning
			Public DoSevenZip As SevenZip
			Public ft As New FILETIME()
			Public st As New SYSTEMTIME()
		
			' ********************************************************
			' 7-zip32.dll ロード
			' ********************************************************
			Public Function Load() As Boolean
		
				hModule = LoadLibrary("7-zip32.dll")
				If hModule = IntPtr.Zero Then
					Return False
				End If
		
				Dim ptr As IntPtr
		
				ptr = GetProcAddress(hModule, "SevenZipOpenArchive")
				If ptr <> IntPtr.Zero Then
					OpenArchive = _
					 Marshal.GetDelegateForFunctionPointer( _
					  ptr, _
					  GetType(SevenZipOpenArchive) _
					 )
				End If
		
				ptr = GetProcAddress(hModule, "SevenZipCloseArchive")
				If ptr <> IntPtr.Zero Then
					CloseArchive = _
					  Marshal.GetDelegateForFunctionPointer( _
					ptr, _
					GetType(SevenZipCloseArchive) _
					 )
				End If
		
				ptr = GetProcAddress(hModule, "SevenZipFindFirst")
				If ptr <> IntPtr.Zero Then
					FindFirst = _
					  Marshal.GetDelegateForFunctionPointer( _
					ptr, _
					GetType(SevenZipFindFirst) _
					 )
				End If
		
				ptr = GetProcAddress(hModule, "SevenZipFindNext")
				If ptr <> IntPtr.Zero Then
					FindNext = _
					  Marshal.GetDelegateForFunctionPointer( _
					ptr, _
					GetType(SevenZipFindNext) _
					 )
				End If
		
				ptr = GetProcAddress(hModule, "SevenZipGetRunning")
				If ptr <> IntPtr.Zero Then
					GetRunning = _
					Marshal.GetDelegateForFunctionPointer( _
					 ptr, _
					 GetType(SevenZipGetRunning) _
				   )
				End If
		
				ptr = GetProcAddress(hModule, "SevenZip")
				If ptr <> IntPtr.Zero Then
					DoSevenZip = _
					Marshal.GetDelegateForFunctionPointer( _
					 ptr, _
					 GetType(SevenZip) _
				   )
				End If
		
				Return True
		
			End Function
		
			' ********************************************************
			' 日付・時間変換
			' ********************************************************
			Public Sub ConvDateTime(ByVal target As INDIVIDUALINFO)
		
				If hModule <> IntPtr.Zero Then
					DosDateTimeToFileTime(target.wDate, target.wTime, Me.ft)
					FileTimeToSystemTime(Me.ft, Me.st)
				End If
		
			End Sub
		
			' ********************************************************
			' 廃棄
			' ********************************************************
			Public Sub Dispose()
		
				If hModule <> IntPtr.Zero Then
					FreeLibrary(hModule)
				End If
		
			End Sub
		
		End Class

	End Class


End Namespace

実行サンプル

VBScript と PHP ですが、結果は全く同じになります

' **********************************************************
' オブジェクト作成
' **********************************************************
Set obj = CreateObject( "night.toolVb" )

' **********************************************************
' MsgBox のテスト
' **********************************************************
obj.MsgBox( "Optional + 規定値により、タイトルを省略" )
Call obj.MsgBox( "全ての引数を指定しています", "タイトル" )


' **********************************************************
' クリップボードのテスト
' **********************************************************
if obj.Clipboard <> "" then
	Call obj.MsgBox( obj.Clipboard, "クリップボード" )
end if

obj.Clipboard = "クリップボードへ文字列をコピー"

' **********************************************************
' 7-zip32.dll で 7zip 解凍
' **********************************************************
ret = obj.z7Melt( "test.zip", "melt" )
obj.MsgBox( ret )

<?

// **********************************************************
// オブジェクト作成
// **********************************************************
$obj = new COM( "night.toolVb" );

// **********************************************************
// MsgBox のテスト
// **********************************************************
$obj->MsgBox( "Optional + 規定値により、タイトルを省略" );
$obj->MsgBox( "全ての引数を指定しています", "タイトル" );

// **********************************************************
// クリップボードのテスト
// **********************************************************
if ( $obj->Clipboard != "" ) {
	$obj->MsgBox( $obj->Clipboard, "クリップボード" );
}

$obj->Clipboard = "クリップボードへ文字列をコピー";


// **********************************************************
// 7-zip32.dll で 7zip 解凍
// **********************************************************
$ret = $obj->z7Melt( "test.zip", "melt" );
$obj->MsgBox( $ret );


?>

関連ページ 【VB.NET】dll を COM として登録して VBScript や PHP から使用

VBScrip と PHP

サンプルコード

実行サンプル

関連ページ
【VB.NET】dll を COM として登録して VBScript や PHP から使用