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]
以下を適当に名前付けて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