ドラッグされたマネージドDLLをRegAsmで登録するスクリプト

ドラッグされたマネージドDLLをRegAsmで登録するスクリプト | 初心者備忘録

消えると困るのでコピペ

これは32bitのマネージドDLLを登録するスクリプトです。
64bitの場合は

FrameworkFolderPath = WindowsFolderPath & "Microsoft.NET\Framework64\"

とする必要があります。

'*********************************************************
' ドラッグされたマネージドDLLをRegAsmで登録するスクリプト
' 
' 2011/04/05 kinuasa
'*********************************************************

Option Explicit

Dim Args
Dim FSO
Dim f
Dim DllFilePath
Dim WindowsFolderPath
Dim FrameworkFolderPath
Dim SubFrameworkFolderPath
Dim RegAsmFilePath
Dim ArgStr
Const Opt = " /tlb /codebase" 'RegAsmに渡すオプション
Const MsgTitle = "RegAsm実行"

RegAsmFilePath = "" '初期化

Set Args = WScript.Arguments
If Args.Count < 1 Then
  MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
  WScript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Select Case LCase(FSO.GetExtensionName(Args(0)))
  Case "dll"
    DllFilePath = Args(0)
  Case Else
    MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
    WScript.Quit
End Select
Set Args = Nothing

'.NET Frameworkフォルダのパス取得
WindowsFolderPath = FSO.GetSpecialFolder(0).Path
If Right(WindowsFolderPath, 1) <> "\" Then WindowsFolderPath = WindowsFolderPath & "\"
FrameworkFolderPath = WindowsFolderPath & "Microsoft.NET\Framework\"
If FSO.FolderExists(FrameworkFolderPath) <> True Then
  MsgBox ".NET Frameworkフォルダが見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If
'RegAsm.exeのパス取得
With CreateObject("ADODB.Recordset")
  .Fields.Append "Path", 200, 255
  .Open
  For Each f In FSO.GetFolder(FrameworkFolderPath).SubFolders
    .AddNew
    .Fields("Path").Value = f.Path
    .Update
  Next
  .Sort = "Path DESC" 'Framework各バージョンフォルダ名を降順ソート
  .MoveFirst
  Do Until .EOF
    SubFrameworkFolderPath = .Fields(0)
    If Right(SubFrameworkFolderPath, 1) <> "\" Then SubFrameworkFolderPath = SubFrameworkFolderPath & "\"
    If FSO.FileExists(SubFrameworkFolderPath & "RegAsm.exe") Then
      If MsgBox("[" & SubFrameworkFolderPath & "RegAsm.exe]で登録しますか?", vbYesNo, MsgTitle) = vbYes Then
        RegAsmFilePath = SubFrameworkFolderPath & "RegAsm.exe"
        Exit Do
      End If
    End If
    .MoveNext
  Loop
  .Close
End With
Set FSO = Nothing
If Len(RegAsmFilePath) < 1 Then
  MsgBox "[RegAsm.exe]が見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If

ArgStr = """" & DllFilePath & """" & Opt
CreateObject("Shell.Application").ShellExecute RegAsmFilePath, ArgStr, "", "runas" 'runas付きで実行
'*************************************************************
' ドラッグされたマネージドDLLをRegAsmで登録解除するスクリプト
' 
' 2011/04/05 kinuasa
'*************************************************************

Option Explicit

Dim Args
Dim FSO
Dim f
Dim DllFilePath
Dim WindowsFolderPath
Dim FrameworkFolderPath
Dim SubFrameworkFolderPath
Dim RegAsmFilePath
Dim ArgStr
Const Opt = " /tlb /u" 'RegAsmに渡すオプション
Const MsgTitle = "RegAsm実行"

RegAsmFilePath = "" '初期化

Set Args = WScript.Arguments
If Args.Count < 1 Then
  MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
  WScript.Quit
End If
Set FSO = CreateObject("Scripting.FileSystemObject")
Select Case LCase(FSO.GetExtensionName(Args(0)))
  Case "dll"
    DllFilePath = Args(0)
  Case Else
    MsgBox "DLLを当スクリプトファイルにドラッグ&ドロップして処理を実行してください。", 16, MsgTitle
    WScript.Quit
End Select
Set Args = Nothing

'.NET Frameworkフォルダのパス取得
WindowsFolderPath = FSO.GetSpecialFolder(0).Path
If Right(WindowsFolderPath, 1) <> "\" Then WindowsFolderPath = WindowsFolderPath & "\"
FrameworkFolderPath = WindowsFolderPath & "Microsoft.NET\Framework\"
If FSO.FolderExists(FrameworkFolderPath) <> True Then
  MsgBox ".NET Frameworkフォルダが見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If
'RegAsm.exeのパス取得
With CreateObject("ADODB.Recordset")
  .Fields.Append "Path", 200, 255
  .Open
  For Each f In FSO.GetFolder(FrameworkFolderPath).SubFolders
    .AddNew
    .Fields("Path").Value = f.Path
    .Update
  Next
  .Sort = "Path DESC" 'Framework各バージョンフォルダ名を降順ソート
  .MoveFirst
  Do Until .EOF
    SubFrameworkFolderPath = .Fields(0)
    If Right(SubFrameworkFolderPath, 1) <> "\" Then SubFrameworkFolderPath = SubFrameworkFolderPath & "\"
    If FSO.FileExists(SubFrameworkFolderPath & "RegAsm.exe") Then
      If MsgBox("[" & SubFrameworkFolderPath & "RegAsm.exe]で登録解除しますか?", vbYesNo, MsgTitle) = vbYes Then
        RegAsmFilePath = SubFrameworkFolderPath & "RegAsm.exe"
        Exit Do
      End If
    End If
    .MoveNext
  Loop
  .Close
End With
Set FSO = Nothing
If Len(RegAsmFilePath) < 1 Then
  MsgBox "[RegAsm.exe]が見つかりませんでした。" & vbCrLf & _
         "処理を中止します。", 16, MsgTitle
  WScript.Quit
End If

ArgStr = """" & DllFilePath & """" & Opt
CreateObject("Shell.Application").ShellExecute RegAsmFilePath, ArgStr, "", "runas" 'runas付きで実行