Matthias Hoffmann - Tcl-Code-Snippets - tcom & wmi - Examples


Querying Citrix-Terminal-Servers

 # 18.01.2007 MHo

 proc getCitrixServer {} {

      package require tcom;

      set wbemFlagReturnImmediately [scan \x10 %c]
      set wbemFlagForwardOnly       [scan \x20 %c]
      set ctxServer                 "."

      set objWMIService [::tcom::ref getobject "winmgmts:\\\\${ctxServer}\\root\\Citrix"]

      set colItems [$objWMIService ExecQuery {SELECT * FROM Citrix_Server} WQL \
          [expr {$wbemFlagReturnImmediately + $wbemFlagForwardOnly}]]

      ::tcom::foreach objItem $colItems {
         # Umweg notwendig...
         set propSet [$objItem Properties_]
         # Domain scheint es nicht zu geben...
         set Server [[$propSet Item ServerName] Value]
         lappend Servers $Server
         foreach item {Domain FarmName IPAddress LoginsEnabled ZoneName ZoneRanking} {
            catch {lappend Result $Server,$item [[$propSet Item $item] Value]}
         }
         lappend Result Servers $Servers
      }
      return $Result
 }

 array set Srv [getCitrixServer]
 parray Srv

The code was adapted from the following VBScript (found on the internet):

 On Error Resume Next

 Const wbemFlagReturnImmediately = &h10
 Const wbemFlagForwardOnly = &h20

 ctxServer = "."

 Set objWMIService = GetObject("winmgmts:\\" & ctxServer & "\root\Citrix")
 Set colItems = objWMIService.ExecQuery("SELECT * FROM Citrix_Server", "WQL", _
                wbemFlagReturnImmediately + wbemFlagForwardOnly)

 Set objFSO = CreateObject("Scripting.FileSystemObject")

 If objFSO.FileExists("FarmServers.txt") Then
    objFSO.DeleteFile "FarmServers.txt"
 End If

 Set objOutput = objFSO.CreateTextFile("FarmServers.txt")


 For Each objItem In colItems
    objOutput.WriteBlankLines
    objOutput.WriteLine "=========================================="
    objOutput.WriteLine "Server Name: " & objItem.ServerName
    objOutput.WriteLine "=========================================="
    objOutput.WriteLine "Domain: " & objItem.Domain
    objOutput.WriteLine "Farm Name: " & objItem.FarmName
    objOutput.WriteLine "IP Address: " & objItem.IPAddress
    objOutput.WriteLine "Logins Enabled: " & objItem.LoginsEnabled
    objOutput.WriteLine "Zone Name: " & objItem.ZoneName
    objOutput.WriteLine "Zone Ranking: " & objItem.ZoneRanking
    objOutput.WriteBlankLines(2)
 Next

 objOutput.Save
 objOutput.Close
 Set objShell = CreateObject("WScript.Shell")
 objShell.Run "notepad.exe FarmServers.txt"

readPopUps: reading all the network-popup messages which have been received on the local machine out of the eventlog using tcom and WMI:

 package require tcom
 proc readPopUps {{cb ""}} {
      set res {}
      if [catch {::tcom::ref getobject "winmgmts:root/CIMV2"} wmi] then {
         return -code error $wmi; # minimal errorhandling
      }
      set wql {select * from Win32_NTLogEvent where LogFile='System' and \
                                                    EventType='3'    and \
                                                    SourceName='Application Popup'}
      if [catch {$wmi ExecQuery $wql} tmp] then {
         return -code error $tmp; # minimal errorhandling
      }
      # enumerating all 'records'
      ::tcom::foreach instance $tmp {
                      set propSet [$instance Properties_]
                      # only the property (object) 'Message' is of interest here
                      set msgVal [[$propSet Item Message] Value]
                      if {[string equal $cb ""]} {
                         lappend res $msgVal
                      } else {
                         uplevel [list $cb $msgVal]
                      }
      }
      return $res
      # Returns list
 }

A view tests/demos:

returning entries as a list, print them one by one in a loop afterwords:

 foreach rec [readPopUps] {
         puts $rec;
 }

retrieving the entries via a directly coded callback:

 readPopUps {puts}

retrieving the entries via a callback proc:

 proc callBack {args} {
      puts $args
 }

 readPopUps callBack

More technical infos can be found at http://msdn.microsoft.com/library/default.asp?url=/library/en-us/dnanchor/html/anch_wmi.asp .


Fragment: Creating Desktop-Shortcuts (Links) using WSH

 package require tcom
 set wsh [::tcom::ref createobject "WScript.Shell"]
 set fld [$wsh SpecialFolders]
 set dsk [$fld Item Desktop]
 set lnk [file join $dsk ThisIsAProgrammaticallyCreatedLink.lnk]
 set lno [$wsh CreateShortcut $lnk]
 $lno TargetPath {"notepad.exe"}
 $lno Save

Of course, this must be encapsulated and taken to a much higher abstraction level (something like wshGetSpecialFolder [folderName] and wshCreateLink args...)


NJG August 8, 2004 See also (as of now) last item in Windows shell links


A simple ADSI-Example using tcom:

 proc logEvent {evtType args} {
    # ohne Fehlernachricht
    catch {
       set wsh [::tcom::ref createobject "WScript.Shell"]
       $wsh LogEvent $evtType "[regsub -all {\n} $args { - }]"
    }
 }

One more complicated example: return the available Windows-NT- and ADS-Domains and Workgroups as a list:

 proc GetDomains {} {
      set ret {}
      if [catch {::tcom::ref getobject "WinNT:"} d] then {
         return -code error "<getobject 'WinNT:'> failed: $d"
      } else {
         ::tcom::foreach domain $d {
                         if ![catch {::tcom::ref getobject [$domain ADsPath],domain}] {
                            set ct (Domain)
                         } else {
                            set ct (Workgroup)
                         }
                         lappend ret [list [$domain Name] $ct]
         }
      }
      return $ret
 }

And another one: get the groups of a given container (that is, a Domain or Workgroup):

 proc GetGroups {container {contype domain}} {
      set ret {}
      # get Domain-/Computerobject
      if [catch {::tcom::ref getobject "WinNT://$container,$contype"} g] then {
         return -code error "<getobject 'WinNT://$container,$contype'> failed: $g"
      }
      ::tcom::foreach m $g {
                      # instead of IF one can use a -filter here...
                      if {[$m Class] == "Group"} {
                         lappend ret [$m Name]
                      }
      }
      return $ret
 }

(contype can be domain or computer)

And finally get the users within such a group:

 (...to be done...)

How to authenticate a Windows user.

set user_id "joe_user"
set passwd "Iliketcl"
set user_obj [::tcom::ref getobject "LDAP:"]
# Call the OpenDSObject method with ADS_SECURE_AUTHENTICATION (0x01)
if {[catch {$user_obj OpenDSObject "LDAP://dc=your,dc=activedirdomain,dc=com" $user_id $passwd [expr {1}]}]} {
   puts "user authentication failed."
   exit 1
} else {
   puts "user passed authentication."
}