Lhaplusのバージョンを取得するVBScript

ホーム
Windows関連, VBScript, クライアント管理
Lhaplusのバージョンを取得するVBScript

Windows関連

2017.05.9

Lhaplusのバージョンを取得するVBScript

およそ2年ぶりに圧縮・解凍ソフトの「Lhaplus」がバージョンアップ(v1.74)されました。

下記記事にある通り、主な更新内容は脆弱性対策で、これまで公開されていたv1.73以前のバージョンを使っている場合は、速やかにバージョンアップする必要があります。

Lhaplus 自己解凍書庫における任意の DLL 読み込みの脆弱性
http://www7a.biglobe.ne.jp/~schezo/JVN61424279_JVN76795694.html
定番解凍・圧縮ソフト「Lhaplus」v1.74が公開～3件の脆弱性を修正 – 窓の杜
http://forest.watch.impress.co.jp/docs/news/1058365.html

今回のバージョンアップに際し、PCにインストールされたLhaplusのバージョンを取得するスクリプトを書いてみました。

Lhaplusのバージョンを取得するVBScript

仕組みは単純で、レジストリからLhaplusのインストール先を調べ、「Lhaplus.exe」のプロパティからバージョン情報を取得する、というものです。
(インストール先が取得できない、Lhaplus.exeが見つからない、と言った場合には空の文字列が返ります。)

Private Function GetLhaplusVersion()
'Lhaplusのバージョン取得
  Dim ret
  Dim install_path
  Const ExeName = "Lhaplus.exe"
  Const RegInstallPath = "HKEY_LOCAL_MACHINE\SOFTWARE\HoeHoe\Lhaplus\InstallPath"
  Const RegInstallPathX86 = "HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\HoeHoe\Lhaplus\InstallPath"
  
  ret = "": install_path = "" '初期化
  
  'レジストリからLhaplusのインストールパス取得
  With CreateObject("WScript.Shell")
    On Error Resume Next
    If Isx64() = True Then
      install_path = .RegRead(RegInstallPathX86)
    Else
      install_path = .RegRead(RegInstallPath)
    End If
    On Error GoTo 0
  End With
  
  '[Lhaplus.exe]からファイルバージョン取得
  If Len(Trim(install_path)) > 0 Then
    install_path = AddPathSeparator(install_path) & ExeName
    With CreateObject("Scripting.FileSystemObject")
      If .FileExists(install_path) = True Then
        ret = .GetFileVersion(install_path)
      End If
    End With
  End If
  GetLhaplusVersion = ret
End Function

Private Function Isx64()
'64ビット環境かどうかを判別
  Dim colItems
  Dim itm
  Dim ret
   
  ret = False '初期化
  Set colItems = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_OperatingSystem")
  For Each itm In colItems
    If InStr(itm.OSArchitecture, "64") Then
      ret = True
      Exit For
    End If
  Next
  Isx64 = ret
End Function

Private Function AddPathSeparator(ByVal s)
  If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)
  AddPathSeparator = s
End Function

Lhaplusサイレントインストールスクリプト

上記スクリプトとこの記事で書いているサイレントインストールオプションを利用すれば、“最新バージョンのLhaplusがインストールされていない場合は上書きサイレントインストールするスクリプト”も簡単に書くことができます。

'*************************************************************
' Lhaplusサイレントインストールスクリプト ※要管理者権限
' 
' 2017/5/9 @kinuasa
'*************************************************************

Option Explicit

Dim v, com

'-----------------------------------------------------------
' ※環境に応じて要変更
'-----------------------------------------------------------
Const latest_version = 1740 '最新バージョン(数値に変換)
Const lpls_path = "\\Shared\sw\lpls174.exe" '配布用Lhaplusのパス
'-----------------------------------------------------------

v = GetLhaplusVersion()
If Len(Trim(v)) > 0 Then
  'MsgBox "インストールされたLhaplusのバージョン：" & v '確認用
  
  'バージョン情報を数値に変換して比較
  If CInt(Replace(v, ".", "")) < latest_version Then
    '最新バージョンではない場合、上書きサイレントインストール
    With CreateObject("Scripting.FileSystemObject")
      If .FileExists(lpls_path) = True Then
        com = """" & lpls_path & """" & " /SILENT /NORESTART"
        CreateObject("WScript.Shell").Run com, 1, True
      End If
    End With
  End If
End If

Private Function GetLhaplusVersion()
'Lhaplusのバージョン取得
  Dim ret
  Dim install_path
  Const ExeName = "Lhaplus.exe"
  Const RegInstallPath = "HKEY_LOCAL_MACHINE\SOFTWARE\HoeHoe\Lhaplus\InstallPath"
  Const RegInstallPathX86 = "HKEY_LOCAL_MACHINE\SOFTWARE\Wow6432Node\HoeHoe\Lhaplus\InstallPath"
  
  ret = "": install_path = "" '初期化
  
  'レジストリからLhaplusのインストールパス取得
  With CreateObject("WScript.Shell")
    On Error Resume Next
    If Isx64() = True Then
      install_path = .RegRead(RegInstallPathX86)
    Else
      install_path = .RegRead(RegInstallPath)
    End If
    On Error GoTo 0
  End With
  
  '[Lhaplus.exe]からファイルバージョン取得
  If Len(Trim(install_path)) > 0 Then
    install_path = AddPathSeparator(install_path) & ExeName
    With CreateObject("Scripting.FileSystemObject")
      If .FileExists(install_path) = True Then
        ret = .GetFileVersion(install_path)
      End If
    End With
  End If
  GetLhaplusVersion = ret
End Function

Private Function Isx64()
'64ビット環境かどうかを判別
  Dim colItems
  Dim itm
  Dim ret
   
  ret = False '初期化
  Set colItems = CreateObject("WbemScripting.SWbemLocator").ConnectServer.ExecQuery("Select * From Win32_OperatingSystem")
  For Each itm In colItems
    If InStr(itm.OSArchitecture, "64") Then
      ret = True
      Exit For
    End If
  Next
  Isx64 = ret
End Function

Private Function AddPathSeparator(ByVal s)
  If Right(s, 1) <> ChrW(92) Then s = s & ChrW(92)
  AddPathSeparator = s
End Function

複数台の端末にインストールされたLhaplusをアップデートする必要がある場合は、是非ご活用ください。