Horizon Clientをユーザフレンドリーにしたい

VDI環境で朝一番で発生する3大トラブル?といえば
1.共有プールユーザがIDとパスワード入力後にVDIに接続できない
  ①VDIが足りない
  ②VDIの待機数が足りない
  ③ADの調子が悪く、せっかく起動したVDIを他の人にとられてしまう(理由は不明)

2.Capsロックを押してしまってパスワードが通らない ※帰れ!と言いたくなる
3.シンクラのスタートアップに登録してあるHorizon ClientがDHCPサーバから
  IP払い出し前に起動してしまってエラーになる。

特にノート型シンクライアントを利用しているとLANケーブルが抜けてるだの
無線LANの電波が取れないだの事務所の環境が悪い(悪いんですよ!)と
よく発生します。で、ITリテラシーの低い年配の方にノート型を提供すると
つながらないだけで連絡してきてしまって、シス管には非常に無駄な工数を
払わさせられてイライラが募ると思います。

そこで今回はHorizon Clientのアイコンのリンク先をEXEからVBSに変えて
起動前にConnection Serverのhttps(TCP443)への接続確認をおこない
つながらない間の60秒間のうち前半30秒は接続確認中というメッセージを
後半30秒はLANケーブルか無線LANの電波の届くところへ移動するよう
促すメッセージを出して問い合わせする前に自己解決させるようなスクリプト
組んでみました。

組んだあとにレジストリのRUNに設定しているbginfoも一緒に処理するように
すれば良かったと思いつつ、めんどくさくなってやめました。

 


動作保障はしませんのでノークレームノーリターンでお願いします。

◆動作確認済Horizon Client:4.0.1 build-3698521
◆動作確認済OS:32bit/64bit Windows 7
◆前提:HorizonのGPOのADM(vdm-client)で接続先を設定している事。
 ※設定がない場合は、処理全部抜けて自動起動します
 [Vmware View Client Configuration]-[Scripting definitions]の[Server URL]

f:id:rujihara:20170918152238j:plain

f:id:rujihara:20170918152323j:plain

 

以下を適当に名前付けてvbsで保存してください。
=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

set shell    = Wscript.CreateObject("Wscript.Shell")
Set oLocator = WScript.CreateObject("WbemScripting.SWbemLocator")
Set oService = oLocator.ConnectServer(, "root\default")
Set oClass   = oService.Get("StdRegProv")
set fso = createObject("Scripting.FileSystemObject")


Const HKEY_LOCAL_MACHINE = &H80000002

'Horizon ClientのEXE名
Const Str_Horizon = "vmware-view.exe"

'Horizon Clientのインストールパス
'STr_ViewExe_Path = """C:\Program Files\VMware\VMware Horizon View Client\vmware-view.exe"""

'GPOで設定したConnection Serverの接続先
oClass.GetStringValue HKEY_LOCAL_MACHINE, _
        "SOFTWARE\Policies\VMware, Inc.\VMware VDM\Client", "ServerURL", Str_CSHostName

'疎通確認方法 以下どちらかのコメントアウントを外す事
'Flg_Connectivity_Method = "PING"
Flg_Connectivity_Method = "HTTPS"

'疎通確認で利用するhttpsポートを指定
Const con_Int_HttpsPort = 443

'CSへの接続タイムアウト値(秒)
Int_CS_TimeOut = 60


'[本処理] =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

'Horizon Client起動チェック。起動時はスクリプトを即終了
call Sub_chk_Horizon_process()

if isnull(Func_Get_Horizon_Dir()) =true  then
 'レジストリからインストパスが取得できない
 shell.popup "接続ソフトに関する情報が取得できませんでした。管理者に連絡してください"
 'エラーで終了
 wscript.quit
else
    STr_ViewExe_Path = chr(34) & Func_Get_Horizon_Dir() & Str_Horizon & chr(34)
    'パスが"""C:\Program Files\VMware\VMware Horizon View Client\vmware-view.exe"""こうなってほしい
end if

if isnull(Str_CSHostName)= true then
 'ポリシーで接続先が設定されていない場合
 '諦めて起動する
 shell.run STr_ViewExe_Path, 1,false

else
 'ポリシーで接続先が設定されている場合
 'CSへのPINGが通るか確認中
 For x= 1 to Int_CS_TimeOut
  if Func_Chk_Connectivity() = 0 then
                 shell.run STr_ViewExe_Path, 1,false
   exit for
  else
   if Int_CS_TimeOut /x > 2 then
    shell.popup "仮想PCのシステムとの接続確認中"& vbcrlf & vbcrlf _
      &   "接続先:" & Str_CSHostName  & vbcrlf _
      &   "残り:" & Int_CS_TimeOut - x & "秒 確認方法:(" & Flg_Connectivity_Method & ")" ,1, "仮想PCシステムへの接続チェック中 "
   else
    shell.popup "仮想PCのシステムとの接続確認中" & vbcrlf _
      &   "接続先:" & Str_CSHostName & vbcrlf _
      &   "LANケーブルが抜けているか無線LANの電波が入らない場所の可能性があります" & vbcrlf & vbcrlf  _
      &   "残り:" & Int_CS_TimeOut - x & "秒 確認方法:(" & Flg_Connectivity_Method & ")",1, "仮想PCシステムへの接続チェック中 "
   end if
  end if
 next
 if Func_Chk_Connectivity() <> 0 then
  shell.popup "仮想PCのシステムとの接続が確認できませんでした。" & vbcrlf _
            & "LANケーブルを刺すか無線LANの電波の届く場所へ移動してください"  ,60, "仮想PCシステムへの接続チェック"
 end if
end if

'[各機能] =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-

sub Sub_chk_Horizon_process()
 'Horizon Clientが起動している場合はスクリプトを終了する
 Set oService = oLocator.ConnectServer
 Set oClassSet = oService.ExecQuery("Select * From Win32_Process where Name like '%" & Str_Horizon & "%'")

 For Each oClass In oClassSet
  Int_Horizon_ProcessId = oClass.ProcessId
 Next

 if Int_Horizon_ProcessId >0   then wscript.quit

end sub

Sub Sub_Chk_Script_DeDupe()
'スクリプトの多重起動防止
strQuery = "Select * FROM Win32_Process WHERE (Caption = 'wscript.exe' OR " & _
     "Caption = 'cscript.exe') AND CommandLine LIKE '%" & WScript.ScriptName & "%'"
Set wmiLocator = CreateObject("WbemScripting.SWbemLocator")
Set wmiService = wmiLocator.ConnectServer
Set objEnumerator = wmiService.ExecQuery(strQuery)

If objEnumerator.Count > 1 Then
 '多重起動時は終了
 wscript.quit
End If

end sub

Function Func_Get_Horizon_Dir()
'インストールフォルダを取得

 strHost = "."
 Const HKLM = &H80000002
 Const strBaseKey = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"

 Set objReg = GetObject("winmgmts://" & strHost & "/root/default:StdRegProv")
 objReg.EnumKey HKLM, strBaseKey, arrSubKeys

 For Each strSubKey In arrSubKeys
  '"DisplayName"="VMware Horizon Client"
  '"InstallLocation"="C:\\Program Files (x86)\\VMware\\VMware Horizon View Client\\"

     intRet = objReg.GetStringValue(HKLM, strBaseKey & strSubKey, "DisplayName", strValue)
     If intRet = 0  and strValue = "VMware Horizon Client" Then
   intRet2 = objReg.GetStringValue(HKLM, strBaseKey & strSubKey, "InstallLocation", strPath)
   if intRet2 = 0 then  Func_Get_Horizon_Dir = strPath
   exit for
  end if
 next

End Function

Function Func_Chk_Connectivity()
'PINGかポートスキャンから選べるようにしたので

 Select case Flg_Connectivity_Method
 case "PING"
 Func_Chk_Connectivity = Func_Chk_PING_Connectivity()
 Case "HTTPS"
 Func_Chk_Connectivity = Func_Chk_HTTPS_Connectivity()
 end select

End Function

Function Func_Chk_HTTPS_Connectivity()
 'ポートスキャン
 Set objXML = WScript.CreateObject("MSXML2.ServerXMLHTTP")
 objXML.SetTimeouts 10000,10000,10000,10000
 intRet = "0"
 
 On Error Resume Next
 objXML.open "GET", "http://" & Str_CSHostName & ":" & con_Int_HttpsPort, False
 objXML.send
 intRet = Err.Number
 
 Select Case intRet
    Case 0,  -2147012744, -2147024891
       'TCP Connect success , no HTTP responce, 401 auth failure
       Func_Chk_HTTPS_Connectivity = 0
    Case Else
       'Unknown error
       Func_Chk_HTTPS_Connectivity = 1
 End Select
 
 On Error Goto 0
 Set objXML = Nothing

End function

Function Func_Chk_PING_Connectivity()
'PING実行部
 Set oLocator = WScript.CreateObject("WbemScripting.SWbemLocator")
 Set oService = oLocator.ConnectServer
 Set oClassSet = oService.ExecQuery("Select * From Win32_PingStatus Where Address = '" & Str_CSHostName & "'")

 For Each oClass In oClassSet
  Select Case oClass.StatusCode
   Case 0
    Func_Chk_PING_Connectivity = 0
   Case Else
    Func_Chk_PING_Connectivity = 1
  End Select
  Next
End Function