2015-08-23

インストーラのないアプリケーションを、Program Files にコピーして、ついでにショートカットも作っちゃうスクリプト。

世の中には、インストーラのないアプリケーションも数多く存在しており、色々とお世話になっています。例えばこのあたり。
# 本題とは関係ないですが、どのアプリケーションも大変オススメなので、是非使ってみてほしいなと。

頻繁に OS の再セットアップをする、私のような人間向けが、毎回インストールする手間を軽減するためのスクリプトとなっています。


スクリプトの解説は面倒なので省略しますが、機能としては、
  • アプリケーションを Program Files にコピー
  • スタートメニューのすべてのプログラムにショートカットを作成
  • デスクトップにショートカットを作成
  • 送る (SendTo) にショートカットを作成
を実装。1番目以外は、無効化が可能。


続いて、準備。

(1) インストールしたいアプリケーションをフォルダで用意する。アプリケーションのフォルダは、スクリプトファイルと同じ場所置くのを推奨。
こんな感じ。
「SuperTagEditor」フォルダが、アプリケーションの入ったフォルダ。
「Install SuperTagEditor.vbs」が下のスクリプト。

(2) スクリプトの「設定」を弄る。それぞれの意味は次の通り。
  • strProgramSrcFolderName: インストールするプログラムフォルダ名 (スクリプトファイルからの相対パス)
  • srtProgramSrcExeFileName: プログラムフォルダ内の実行ファイル名 (拡張子不要)
  • flgProgramArchX86: コピーするプログラムが 32 ビット向けであるか (True/False)
  • flgCreateStartmenuShortcut: 「すべてのプログラム」にショートカットを作成するか (True/False。True 推奨。)
  • flgCreateDesktopShortcut: 「デスクトップ」にショートカットを作成するか (True/False。個人的には False しか使わない。)
  • flgCreateSendToShortcut: 「送る」にショートカットを作成するか (True/False。必要であれば True にすると作成される。)
好き勝手に設定してください。
上の画像のような場合には、strProgramSrcFolderName に "SuperTagEditor" をセットします。
flgProgramArchX86 は、64 ビットアプリケーションを 32 ビット OS にインストールしないようにしたり、インストール先を自動的に "Program Files" か "Program Files (x86)" に切り替えるため。大抵の場合は、True でいいかと。


最後に使い方。

ダブルクリックするだけです。はい。


# easy-installation-script.vbs
' 簡易インストールスクリプト
' Copyright (C) 2015 tag. All rights reserved.
' http://karat5i.blogspot.jp/

Option Explicit

' 管理者権限での実行
runasCheck()

' 各種変数
Dim objWshShell, objFso
Dim strProgramSrcFolderName, srtProgramSrcExeFileName
Dim flgProgramArchX86, flgCreateStartmenuShortcut, flgCreateDesktopShortcut, flgCreateSendToShortcut
Dim strBit
Dim strMessageTmp, valUsrSelect
Dim strCopySrc, strCopyDst
Dim strProgramFilesPath, strShortCutPathTmp, strExeFilePath
Dim strAllUsersProgramsPath, strDesktopPath, strSendToPath

' 各種オブジェクト
Set objWshShell = CreateObject("WScript.Shell")
Set objFso = CreateObject("Scripting.FileSystemObject")

' == 設定 ====================================== '
strProgramSrcFolderName = "ProgramName"    ' インストールするプログラムフォルダ名 (このスクリプトと同じフォルダに配置すること)
srtProgramSrcExeFileName = "ProgramName"    ' プログラムフォルダ内の実行ファイル名 (拡張子不要)
flgProgramArchX86 = True    ' コピーするプログラムが 32 ビット向けであるか
flgCreateStartmenuShortcut = True    ' 「すべてのプログラム」にショートカットを作成するか (基本的には True)
flgCreateDesktopShortcut = True    ' 「デスクトップ」にショートカットを作成するか (個人的には False)
flgCreateSendToShortcut = False    ' 「送る」にショートカットを作成するか (必要であれば True に)
' ============================================== '

' ビット数チェック
strBit = objWshShell.Environment("Process").Item("PROCESSOR_ARCHITECTURE")
If strBit = "x86" Then
  strBit = objWshShell.Environment("Process").Item("PROCESSOR_ARCHITEW6432")
  If strBit = "AMD64" Then
    strBit = "x86-64"
  ElseIf strBit = "IA64" Then
    strBit = "x86-64"
  Else
    strBit = "x86"
  End If
Else
  strBit = "x86-64"
End If
'MsgBox "PC Architecture: " & strBit

' インストール先の Program Files フォルダ
If strBit = "x86" Then
  If flgProgramArchX86 Then
    strProgramFilesPath = objWshShell.ExpandEnvironmentStrings("%ProgramFiles%")
  Else
    MsgBox "このアプリケーションは 64 ビット OS 用のためインストールできません。"
    WScript.Quit 8
  End If
Else
  If flgProgramArchX86 Then
    strProgramFilesPath = objWshShell.ExpandEnvironmentStrings("%ProgramFiles(x86)%")
  Else
    strProgramFilesPath = objWshShell.ExpandEnvironmentStrings("%ProgramFiles%")
  End If
End If
'MsgBox "Program Files Path: " & strProgramFilesPath    ' インストール先の Program Files のパス


' 確認ダイアログ
strMessageTmp = " - " & strProgramSrcFolderName & " のコピー"
If flgCreateStartmenuShortcut = True Then
  strMessageTmp = strMessageTmp & vbCrLf & " - 「すべてのプログラム」へのショートカットの作成"
End If
If flgCreateDesktopShortcut = True Then
  strMessageTmp = strMessageTmp & vbCrLf & " - 「デスクトップ」へのショートカットの作成"
End If
If flgCreateSendToShortcut = True Then
  strMessageTmp = strMessageTmp & vbCrLf & " - 「送る」へのショートカットの作成"
End If

valUsrSelect = MsgBox("下記処理を実行します。よろしいですか？" & vbCrLf & strMessageTmp, vbOKCancel, strProgramSrcFolderName & " のインストール")
If valUsrSelect = vbCancel Then
  MsgBox "インストールはキャンセルされました。"
  WScript.Quit 8
End If

' ファイルのコピー
strCopySrc = objFso.BuildPath(Replace(WScript.ScriptFullName,WScript.ScriptName, ""), strProgramSrcFolderName)
strCopyDst = objFso.BuildPath(strProgramFilesPath, strProgramSrcFolderName)
'MsgBox "Copy " & strCopySrc & " to " & strCopyDst
objFso.CopyFolder strCopySrc, strCopyDst, True

' ショートカットを作成するプログラムファイルのパス
strExeFilePath = objFso.BuildPath(strCopyDst, srtProgramSrcExeFileName & ".exe")
'MsgBox "Exe File Path: " & strExeFilePath

' スタートメニューのプログラムリストにショートカットを作成
If flgCreateStartmenuShortcut = True Then
  strAllUsersProgramsPath = objWshShell.SpecialFolders("AllUsersPrograms")
  Set strShortCutPathTmp = objWshShell.CreateShortcut(objFso.BuildPath(strAllUsersProgramsPath, srtProgramSrcExeFileName + ".lnk"))
  strShortCutPathTmp.TargetPath = strExeFilePath
  strShortCutPathTmp.Save
  'MsgBox "Created shortcut: " & strShortCutPathTmp
End If

' デスクトップにショートカットを作成
If flgCreateStartmenuShortcut = True Then
  strDesktopPath = objWshShell.SpecialFolders("Desktop")
  Set strShortCutPathTmp = objWshShell.CreateShortcut(objFso.BuildPath(strDesktopPath, srtProgramSrcExeFileName + ".lnk"))
  strShortCutPathTmp.TargetPath = strExeFilePath
  strShortCutPathTmp.Save
  'MsgBox "Created shortcut: " & strShortCutPathTmp
End If

' SendTo にショートカットを作成
If flgCreateSendToShortcut = True Then
  strSendToPath = objWshShell.SpecialFolders("SendTo")
  Set strShortCutPathTmp = objWshShell.CreateShortcut(objFso.BuildPath(strSendToPath, srtProgramSrcExeFileName + ".lnk"))
  strShortCutPathTmp.TargetPath = strExeFilePath
  strShortCutPathTmp.Save
  'MsgBox "Created shortcut: " & strShortCutPathTmp
End If


' 終了処理
Set objWshShell = Nothing
Set objFso = Nothing

MsgBox "処理が完了しました。"
WScript.Quit 8


' ソース: VBSを毎回「管理者として実行」する方法 - masahirorの気まま記録簿
'         <http://masahiror.hatenadiary.jp/entry/20111201/vbs_admin_run>
Function runasCheck()
  Dim strScriptPathName

  Dim flgRunasMode
  Dim objWMI, osInfo, flg, objShell, os
  Dim strArgs
  Dim args
 
  Set args = WScript.Arguments

  flgRunasMode = False
  strArgs = ""
 
  ' フラグの取得
  If args.Count > 0 Then
    If UCase(args.item(0)) = "/RUNAS" Then
      flgRunasMode = True
    End If
    strArgs = strArgs & " " & args.item(0)
  End If

  Set objWMI = GetObject("winmgmts:" & "{impersonationLevel=impersonate}!\\.\root\cimv2")
  Set osInfo = objWMI.ExecQuery("SELECT * FROM Win32_OperatingSystem")
  flg = false
  For Each os in osInfo
    If Left(os.Version, 3) >= 6.0 Then
      flg = True
    End If
  Next

  Set objShell = CreateObject("Shell.Application")
  If flgRunasMode = False Then
    If flg = True Then
      objShell.ShellExecute "wscript.exe", """" & WScript.ScriptFullName & """" & " /RUNAS " & strArgs, _
          "", "runas", 1
      Wscript.Quit
    End If
  End If
End Function

何かあれば、コメント欄からどうぞ。

# 参考
written by at
Labels: ,

1 件のコメント :

登録: コメントの投稿 ( Atom )