Windows関連

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

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

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

今回のバージョンアップに際し、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をアップデートする必要がある場合は、是非ご活用ください。

Microsoft Edgeの場所前のページ

「プログラムと機能」からインストールされているアプリケーションの一覧を取得するVBScript次のページ

関連記事

  1. Windows関連

    プリキュア・プリンセスパーティーってWindowsだったの?

    Office 2016だOffice アドインだと記事を書いておきつつ…

  2. Windows 10

    SeleniumBasic(Selenium VBA)がMicrosoft Edgeに対応しました。…

    言わずと知れたWebブラウザーの自動制御ツール「Selenium」のV…

  3. VBScript

    ファイル選択ダイアログ

    ファイル選択ダイアログを表示するVBScriptをまとめてみま…

  4. VBScript

    Acrobatを使ってPDFファイルを結合するVBScript

    「Acrobat PDF 結合 コマンドライン」といったキーワード検索…

  5. Office関連

    Officeファイルから作成者などのプロパティを取得するVBScript

    下記記事でも書いていますが、xlsxやdocxといった、OOXML形式…

コメント

  • コメント (0)

  • トラックバックは利用できません。

  1. この記事へのコメントはありません。

Time limit is exhausted. Please reload CAPTCHA.

Translate

最近の記事

アーカイブ

PAGE TOP