Microsoft Update カタログから累積更新プログラムをダウンロードするVBScript

ホーム
Windows 10, Windows関連, VBScript
Microsoft Update カタログから累積更新プログラムをダウンロードするVBScript

Windows 10

2019.06.14

Microsoft Update カタログから累積更新プログラムをダウンロードするVBScript

「累積更新プログラム」とは、その名の通りOSを最新の状態に保つための更新プログラムが累積されたものであり、毎月1回以上配信されます。

Windows Updateから更新を適用することもできますが、社内のPC管理をされている方であれば「Microsoft Update カタログ」から必要なファイルだけダウンロードされている方も多いのではないでしょうか。

しかし、このカタログからのダウンロード作業は

“地味に面倒くさい！”

です。
サイト(http://www.catalog.update.microsoft.com/)にアクセスして、KB番号や「累積更新 Windows-10」といったキーワードで検索して、ヒットしたファイルをクリックしてダウンロードして・・・。
毎日行う作業ではないですが、ホント地味ーーーに手間が掛かる作業です。

そこで今回は、自分が楽するために、Microsoft Update カタログから自動的に累積更新プログラムをダウンロードするスクリプトを作成してみました。

Microsoft Updateカタログの仕様を調べる

ダウンロードする方法として、まずブラウザーの操作が考えられますが、動作が重くなるのであまり使いたくはありません。

できれば更新プログラム(msu)のURLを調べて、ブラウザーを介さずにファイルをダウンロードしたいものです。

そこで、まずは手動でダウンロードする際のMicrosoft Updateカタログの仕様を調べてみることにしました。

「ダウンロード」ボタンを押したときの挙動

Updateカタログの検索結果から「ダウンロード」ボタンをクリックすると、ファイルのダウンロードURLが記載された「DownloadDialog.aspx」ページが開きます。

このときの挙動を「Fiddler」で追ってみました(下記は必要なところだけ抜粋)。

POST http://www.catalog.update.microsoft.com/DownloadDialog.aspx HTTP/1.1
Content-Type: application/x-www-form-urlencoded

updateIDs=%5B%7B%22size%22%3A0%2C%22languages%22%3A%22%22%2C%22uidInfo%22%3A%22c51e9c8d-8757-49bd-a65f-c1fa9ebc2c6e%22%2C%22updateID%22%3A%22c51e9c8d-8757-49bd-a65f-c1fa9ebc2c6e%22%7D%5D&updateIDsBlockedForImport=&wsusApiPresent=&contentImport=&sku=&serverName=&ssl=&portNumber=&version=

POSTされたデータをデコードすると下記のようになります。

updateIDs=[{"size":0,"languages":"","uidInfo":"c51e9c8d-8757-49bd-a65f-c1fa9ebc2c6e","updateID":"c51e9c8d-8757-49bd-a65f-c1fa9ebc2c6e"}]&updateIDsBlockedForImport=&wsusApiPresent=&contentImport=&sku=&serverName=&ssl=&portNumber=&version=

これを見ると、重要なのは「updateIDs」パラメーターで、「updateID」という、それらしい値をJSON形式で渡しているようです。

[{
    "size": 0,
    "languages": "",
    "uidInfo": "c51e9c8d-8757-49bd-a65f-c1fa9ebc2c6e",
    "updateID": "c51e9c8d-8757-49bd-a65f-c1fa9ebc2c6e"
}]

この「updateID」さえ分かれば何とかなりそうな気がしてきました。

updateIDの取得

ソースを調べると、リンクのonclick属性の値の中にIDが記載されていました。

ただ、Webサイト＝ htmlから値を持ってくるのは面倒くさそうです。

そこで目を付けたのが検索結果の「RSSフィード」、XMLに値が記載されていれば、htmlの解析をするより楽に値を取得できます。

ところが、RSSフィードのリンクをクリックすると、見事にエラー発生！
世の中そう思い通りには動いてくれません・・・。

諦めきれないので、ブラウザーを替えInternet Explorerで開いてみると、

今度は問題なく表示できました。
updateIDもちゃんとguid要素の値として記載されています。

ここまでくれば、下記のような流れで処理できそうです。

Microsoft Updateカタログで「累積更新 Windows-10」キーワード検索した結果のRSSフィードを取得(Internet Explorer)
1.のRSSフィードから、対象となる更新プログラムのupdateIDを取得
ダウンロードページに対してupdateIDを含めたパラメーターをPOST
結果として表示されるWebページからファイルのダウンロードURLを取得

Microsoft Update カタログから累積更新プログラムをダウンロードするVBScript

この流れを実装したのが下記のコードです。
すべての更新プログラムをダウンロードするわけにはいかないので、プラットフォームやOSのバージョン、日付で絞り込むようにしています。
日付はRSSフィードのpubDate要素でざっくりと年月を判断しているだけなので、指定月以外の更新プログラムがダウンロードされる場合がありますが、大まかには上手く動いていると思います。

'*************************************************************************
' Microsoft Update カタログから更新プログラムをダウンロードするスクリプト
' 
' 2019/6/14 @kinuasa
'*************************************************************************

Option Explicit

Call DownloadWindowsUpdatesFromCatalog()
Wscript.Echo "処理が完了しました。"

Private Sub DownloadWindowsUpdatesFromCatalog()
'Microsoft Update カタログから更新プログラムをダウンロード
  Dim fso, fol
  Dim nodes, node
  Dim res
  Dim yyyy, mm
  Dim update_title, update_id, update_url, update_filename
  Dim parent_folderpath, dl_folderpath, dl_filepath
  Dim pub_date, guid
  Dim flg
  Dim v
  Dim i, cnt
  
  '[累積 更新 Windows-10]を検索キーワードとしたフィードURL
  Const url = "http://catalog.update.microsoft.com/v7/site/Rss.aspx?q=%e7%b4%af%e7%a9%8d+%e6%9b%b4%e6%96%b0+Windows-10&lang=ja"
  'title絞り込み用のキーワード(Or条件)
  Const keyword = "1803,1809,1903"
  '対象プラットフォーム
  Const platform = "x64"
  
  'フォルダ設定
  Set fol = CreateObject("Shell.Application") _
            .BrowseForFolder(0, "ダウンロード先フォルダ選択", &H10, 0)
  If fol Is Nothing Then Exit Sub
  parent_folderpath = fol.Self.Path
  Set fso = CreateObject("Scripting.FileSystemObject")
  
  '年月設定
  yyyy = InputBox("対象年を入力してください。", , Year(Now()))
  mm = InputBox("対象月を入力してください。", , Right("0" & Month(Now()), 2))
  
  'RSSフィード取得
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "GET", url, False
    .setRequestHeader "User-Agent", "Mozilla/5.0 (Windows NT 10.0; WOW64; Trident/7.0; rv:11.0) like Gecko"
    .Send
    Select Case .Status
      Case 200
        res = .responseText
      Case Else
        Wscript.Echo "!!RSSフィード取得失敗!! ステータスコード：" & .Status
        Exit Sub
    End Select
  End With
  
  cnt = 0
  v = Split(keyword, ",")
  With CreateObject("MSXML2.DOMDocument")
    .async = False
    If .LoadXML(res) = True Then
      Set nodes = .SelectNodes("//item")
      If nodes.Length > 0 Then
        For Each node In nodes
          flg = False
          update_title = node.SelectSingleNode("title").Text
          pub_date = node.SelectSingleNode("pubDate").Text
          
          '日付(pubDate)とプラットフォーム(title)で絞り込み
          If (InStr(pub_date, yyyy & "-" & mm) > 0) And (InStr(update_title, platform) > 0) Then
            'キーワードによる絞り込み(title)
            For i = LBound(v) To UBound(v)
              If InStr(update_title, v(i)) > 0 Then flg = True: Exit For
            Next
          End If
          
          If flg = True Then
            If cnt > 0 Then WScript.Sleep 10000 '負荷を考えて10秒処理待ち
            guid = node.SelectSingleNode("guid").Text
            update_id = GetUpdateID(guid)
            update_url = GetDownloadUrl(update_id)
            update_filename = GetDownloadFileName(update_url)
            
            'ダウンロード先フォルダ作成
            dl_folderpath = fso.BuildPath(parent_folderpath, update_title)
            If fso.FolderExists(dl_folderpath) = False Then fso.CreateFolder dl_folderpath
            
            'ダウンロード実行
            dl_filepath = fso.BuildPath(dl_folderpath, update_filename)
            Wscript.Echo "[ダウンロード中]" & update_title & ", " & update_url & ", " & dl_filepath
            DownloadFile update_url, dl_filepath
            cnt = cnt + 1
          End If
        Next
        Wscript.Echo "----- " & cnt & "ファイルダウンロード完了 -----"
      End If
    Else
      Wscript.Echo "!!RSSフィード読込失敗!!"
    End If
  End With
End Sub

Private Sub DownloadFile(ByVal url, ByVal save_filepath)
'XMLHTTPRequest + ADODB.Streamでファイルをダウンロード
  Dim req
  Const adTypeBinary = 1
  Const adSaveCreateOverWrite = 2
   
  Set req = CreateObject("Msxml2.XMLHTTP")
  req.Open "GET", url, False
   
  'キャッシュ対策
  'http://vird2002.s8.xrea.com/javascript/XMLHttpRequest.html#XMLHttpRequest_Cache-Control
  'http://www.atmarkit.co.jp/ait/articles/0305/10/news002.html 参考
  req.setRequestHeader "Pragma", "no-cache"
  req.setRequestHeader "Cache-Control", "no-cache"
  req.setRequestHeader "If-Modified-Since", "Thu, 01 Jun 1970 00:00:00 GMT"
   
  req.Send
  Select Case req.Status
    Case 200
      With CreateObject("ADODB.Stream")
        .Type = adTypeBinary
        .Open
        .Write req.responseBody
        .SaveToFile save_filepath, adSaveCreateOverWrite
        .Close
      End With
    Case Else
      Wscript.Echo "!!ダウンロード失敗!! ステータスコード：" & .Status
      Exit Sub
  End Select
End Sub

Private Function GetUpdateID(ByVal guid)
'アップデートID取得
  GetUpdateID = Left(guid, InStr(guid, "#") - 1)
End Function

Private Function GetDownloadUrl(ByVal update_id)
'ダウンロードURL取得
  Dim dat
  Dim html
  Dim matches
  Dim match
  Dim ret
  Const url = "http://www.catalog.update.microsoft.com/DownloadDialog.aspx"
  
  dat = "updateIDs=%5B%7B%22size%22%3A0%2C%22languages%22%3A%22%22%2C%22uidInfo%22%3A%22" & update_id & _
        "%22%2C%22updateID%22%3A%22" & update_id & "%22%7D%5D"
  With CreateObject("WinHttp.WinHttpRequest.5.1")
    .Open "POST", url, False
    .setRequestHeader "Content-Type", "application/x-www-form-urlencoded"
    .Send dat
    Select Case .Status
      Case 200: html = .responseText
    End Select
  End With
  
  '[downloadInformation[0].files[0].url =...]からURL取得
  With CreateObject("VBScript.RegExp")
    .IgnoreCase = True
    .Global = True
    .Pattern = "downloadInformation.*url.*"
    If .Test(html) Then
      Set matches = .Execute(html)
      
      'パターンをシンプルにして後から不要な文字を削除
      match = matches(0).Value
      match = Replace(match, vbCrLf, "")
      match = Replace(match, vbLf, "")
      match = Replace(match, vbCr, "")
      match = Replace(match, ";", "")
      match = Replace(match, ",", "")
      match = Replace(match, "'", "")
      match = Replace(match, " ", "")
      
      ret = Mid(match, InStr(match, "=") + 1)
    End If
  End With
  
  GetDownloadUrl = ret
End Function

Private Function GetDownloadFileName(ByVal update_url)
'ダウンロード対象のファイル名取得
  Dim v
  
  v = Split(update_url, "/")
  GetDownloadFileName = v(UBound(v))
End Function