[AccessD] Access-D Desktop

Max Wanadoo max.wanadoo at gmail.com
Sun Aug 2 08:02:35 CDT 2009


Hi List:
I had many frustrating times when I was trying to figure out which of you
were awake and which asleep
Anyway, here is a .hta text file to keep open on your desktop.  If your
interested, just copy everything below my name to a text file called
MyDeskop.hta and put in somewhere.  Then d/click it.

Some other PC info as well.  Bit of a hack.

Max

<head>
<title>Access-D Dashboard.      max.wanadoo at gmail.com</title>
<!-- Author Max Sherman 2nd August 2009 - Free to all. -->

<!-- Runs on Vista Machines.
Some code may run on other platforms but not tested.
No guarantees and definitely NO support.
This is a big  hack from the help files.  Once I understand
what I am actually doing, I may be able to improve on it !!
Please report bugs or suggestions to:
max.wanadoo at gmail.com
Many thanks.
Hope you find it useful.
Max -->

<!-- The clocks come from /www.worldtimeserver.com and reflect six time 
zones I am interested in across the World to see when my colleagues 
on Access-D might be available to help with MS Access problems.

It start on the West coast of N.America across the the E.Coast, then London,

Moscow and ending up in the two sides of Oz.

Add, delete as you wish.

There are 24 hour (military) style clocks - which I prefer - and 
normal 12 hour clocks with the DAY shown in the centre.
The showing of the day is very useful because frequently my 
colleagues "down-under" are starting a new day when I am ending 
the previous one. -->

<HTA:APPLICATION 
     APPLICATIONNAME="AccessD-Desktop"
     SCROLL="yes"
     SINGLEINSTANCE="yes"
     WINDOWSTATE="normal">
</head>

<body>
<hr>
<br>
<table border="0" cellspacing="0" cellpadding="0">
<tr><td align="left"><font color="#FF0000"><p><span id =
"MyName"></span></font></td></tr>
<tr><td align="left"><b><font color="#0000FF">World Local Times - 24hr
Military (with Day) and 12Hr (with AM/PM)</font></b></td></tr>
</table>

<table>
<tr>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">
objUSCA = new Object;objUSCA.wtsclock = "wtsclock024.swf";objUSCA.color =
"6495ED";objUSCA.wtsid = "US-CA";objUSCA.width = 100;objUSCA.height =
100;objUSCA.wmode = "transparent";showClock(objUSCA);</script>
</td>

<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">
objUSNY = new Object;objUSNY.wtsclock = "wtsclock024.swf";objUSNY.color =
"6495ED";objUSNY.wtsid = "US-NY";objUSNY.width = 100;objUSNY.height =
100;objUSNY.wmode = "transparent";showClock(objUSNY);</script>
</td>

<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">
objGB = new Object;objGB.wtsclock = "wtsclock024.swf";objGB.color =
"6495ED";objGB.wtsid = "GB";objGB.width = 100;objGB.height = 100;objGB.wmode
= "transparent";showClock(objGB);</script>
</td>
<td align="center">
<script type=<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">
objRUMOW = new Object;objRUMOW.wtsclock = "wtsclock024.swf";objRUMOW.color =
"6495ED";objRUMOW.wtsid = "RU-MOW";objRUMOW.width = 100;objRUMOW.height =
100;objRUMOW.wmode = "transparent";showClock(objRUMOW);</script>
</td>

<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">objAUWA = new
Object;objAUWA.wtsclock = "wtsclock024.swf";objAUWA.color =
"6495ED";objAUWA.wtsid = "AU-WA";objAUWA.width = 100;objAUWA.height =
100;objAUWA.wmode = "transparent";showClock(objAUWA);</script>
</td>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">
objAUACT = new Object;objAUACT.wtsclock = "wtsclock024.swf";objAUACT.color =
"6495ED";objAUACT.wtsid = "AU-ACT";objAUACT.width = 100;objAUACT.height =
100;objAUACT.wmode = "transparent";showClock(objAUACT);</script>
</td>
</tr>

<tr>
<td align="center"><h4>California</h4></td>
<td align="center"><h4>New York</h4></td>
<td align="center"><h4>London</h4></td>
<td align="center"><h4>Moscow</h4></td>
<td align="center"><h4>Perth</h4></td>
<td align="center"><h4>Canbera</h4></td>
</tr>

<tr>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">
objUSCA=new
Object;objUSCA.wtsclock="wtsclock001.swf";objUSCA.color="FFFF00";objUSCA.wts
id="US-CA";objUSCA.width=100;objUSCA.height=100;objUSCA.wmode="transparent";
showClock(objUSCA);</script>
</td>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">
objUSNY=new
Object;objUSNY.wtsclock="wtsclock001.swf";objUSNY.color="FFFF00";objUSNY.wts
id="US-NY";objUSNY.width=100;objUSNY.height=100;objUSNY.wmode="transparent";
showClock(objUSNY);</script>
</td>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">objGB=new
Object;objGB.wtsclock="wtsclock001.swf";objGB.color="FFFF00";objGB.wtsid="GB
";objGB.width=100;objGB.height=100;objGB.wmode="transparent";showClock(objGB
);</script>
</td>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">objRUMOW=new
Object;objRUMOW.wtsclock="wtsclock001.swf";objRUMOW.color="FFFF00";objRUMOW.
wtsid="RU-MOW";objRUMOW.width=100;objRUMOW.height=100;objRUMOW.wmode="transp
arent";showClock(objRUMOW);</script>
</td>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">objAUWA=new
Object;objAUWA.wtsclock="wtsclock001.swf";objAUWA.color="FFFF00";objAUWA.wts
id="AU-WA";objAUWA.width=100;objAUWA.height=100;objAUWA.wmode="transparent";
showClock(objAUWA);</script>
</td>
<td align="center">
<script type="text/javascript"
src="http://www.worldtimeserver.com/clocks/embed.js"></script>
<script type="text/javascript" language="JavaScript">objAUACT=new
Object;objAUACT.wtsclock="wtsclock001.swf";objAUACT.color="FFFF00";objAUACT.
wtsid="AU-ACT";objAUACT.width=100;objAUACT.height=100;objAUACT.wmode="transp
arent";showClock(objAUACT);</script>
</td>
</tr>
</table>
<br>

<hr>
<br>
<table>
<tr><td align="left"><b><font color="#0000FF">Outlook
Mail</font></b></td></tr>
<tr><td align="left">Inbox Total Items: </td><td align="left"><p><span id =
"MyInboxCt"></span></td></tr>
<tr><td align="left">Inbox Unread Items: </td><td align="left"><p><span id =
"MyInboxUnreadCt"></span></td></tr>
</table>
<br>

<hr>
<br>
<table>
<tr><td align="left"><b><font color="#0000FF">Operating
System</font></b></td><td align="left"><p><span id =
"OSVersion"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">Service
Pack</font></b></td><td align="left"><p><span id =
"OSServicePack"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">Computer
Type</font></b></td><td align="left"><p><span id =
"MyComputerType"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">Physical No. of
Processors</font></b></td><td align="left"><p><span id =
"MyProcessorsPhysical"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">Logical No. of
Processors</font></b></td><td align="left"><p><span id =
"MyProcessorsLogical"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">Architecture
Type</font></b></td><td align="left"><p><span id =
"MyArchitecture"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">HyperThreading
Architecture</font></b></td><td align="left"><p><span id =
"MyHyperThreading"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">Total Physical
Memory</font></b></td><td align="left"><p><span id =
"MyMemory"></span></td></tr>
<tr><td align="left"><b><font color="#0000FF">System Rating
Scores:-</font></b></td></tr>
<tr><td align="left">Processor</span></td><td align="left"><p><span id =
"MyProcessorScore"></span></td></tr>
<tr><td align="left">Memory</span></td><td align="left"><p><span id =
"MyMemoryScore"></span></td></tr>
<tr><td align="left">Primary Hard Disk</span></td><td align="left"><p><span
id = "MyDiskScore"></span></td></tr>
<tr><td align="left">Graphics</span></td><td align="left"><p><span id =
"MyGraphicsScore"></span></td></tr>
<tr><td align="left">Gaming Graphic</span></td><td align="left"><p><span id
= "MyD3DScore"></span></td></tr>
</table>
<br>

<hr>
<br>
<table>
<tr><td><b><font color="#0000FF">Running Applications:-</font></b></td></tr>
<tr><td align="left"><p><span id = "MyRunningApps"></span></td></tr>
</table>
<br>

<!-- What Processes Are Running-->
<hr>
<br>
<table>
<tr><td><b><font color="#0000FF">Running Processes:-</font></b></td></tr>
<tr><td align="left"><p><span id = "MyRunningProcesses"></span></td></tr>
</table>
<br>

<hr>
</body>

<script language="VBScript">
    sub window_onLoad
	<!-- Update Outlook mail count every 30 seconds -->
	<!--   GetMemory -->
   <!--    iTimerID = window.setInterval("GetOutlookInBox", 30000) -->
	  getMyName
	  GetRunningApps
	  GetOSVersion
	  GetOSServicePack
	  GetSystem
	  GetProcesses
	  GetComputerType
	  GetProcessors
	  GetArchitecture
      GetOutlookInBox
    end sub

	sub GetSystem
	<!-- Vista Only -->
	strComputer = "."
    Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
    Set colItems = objWMIService.ExecQuery("Select * From Win32_WinSAT")
    
    For Each objItem in colItems
        MyProcessorScore.InnerHTML = objItem.CPUScore
        MyMemoryScore.InnerHTML =  objItem.MemoryScore 
        MyDiskScore.InnerHTML =  objItem.DiskScore
        MyGraphicsScore.InnerHTML=  objItem.GraphicsScore
        MyD3DScore.InnerHTML = objItem.D3DScore
        <!-- strHTML = strHTML &  "Windows System Performance Rating: " &
objItem.WinCRSLevel & "<br>" -->
    Next
	end sub

    Sub GetOSVersion
	       strComputer = "."
           Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
           Set colOperatingSystems = objWMIService.ExecQuery _
               ("Select * from Win32_OperatingSystem")
           For Each objOperatingSystem in colOperatingSystems
            	OSVersion.InnerHTML=objOperatingSystem.Caption & " " &
objOperatingSystem.Version
           Next
    End Sub

    sub GetOSServicePack
	strComputer = "."
	Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
	Set colOperatingSystems = objWMIService.ExecQuery _
	    ("Select * from Win32_OperatingSystem")
	For Each objOperatingSystem in colOperatingSystems
	    OSServicePack.InnerHTML ="(Major.Minor) " &
objOperatingSystem.ServicePackMajorVersion & "." &
objOperatingSystem.ServicePackMinorVersion
	Next
    end sub

	sub GetComputerType
	strComputer = "." 
      Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\CIMV2") 
      Set colItems = objWMIService.ExecQuery("SELECT * FROM
Win32_ComputerSystem") 
      
      Select Case colItems.ItemIndex(0).PCSystemType
          Case 0
              MyComputerType.InnerHTML= "Unspecified"
          Case 1
             MyComputerType.InnerHTML="Desktop"
          Case 2
              MyComputerType.InnerHTML= "Mobile"
          Case 3
              MyComputerType.InnerHTML= "Workstation"
          Case 4
              MyComputerTyp.InnerHTMLe= "Enterprise Server"
          Case 5
              MyComputerType.InnerHTML= "SOHO Server"
          Case 6
              MyComputerType.InnerHTML= "Applicance PC"
          Case 7
              MyComputerType.InnerHTML= "Performance Server"
          Case 8
             MyComputerType.InnerHTML= "Role Maximum"
      End Select
	end sub
	
	sub GetProcessors
  		strComputer = "." 
      Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\CIMV2") 
      Set colItems = objWMIService.ExecQuery("SELECT * FROM
Win32_ComputerSystem") 
      
      intLogical = colItems.ItemIndex(0).NumberOfLogicalProcessors
      intPhysical = colItems.ItemIndex(0).NumberOfProcessors
      
      MyProcessorsLogical.InnerHTML= "Logical: " & intLogical
	  MyProcessorsPhysical.InnerHTML= "Physical: " & intPhysical
      
      If  intLogical > intPhysical Then
          MyHyperThreading.InnerHTML= "This is a hyperthreading
architecture."
      Else
          MyHyperThreading.InnerHTML="This is not a hyperthreading
architecture."
      End If	
	end sub
	
	sub GetArchitecture
		strComputer = "." 
      Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\CIMV2") 
      Set colItems = objWMIService.ExecQuery("SELECT * FROM
Win32_Processor") 
      For Each objItem in colItems 
          MyArchitecture.InnerHTML= "Architecture: " & objItem.Architecture
          Select Case objItem.Architecture
              Case 0
                 MyArchitecture.InnerHTML=MyArchitecture.InnerHTML & "
(x86)"
              Case 1
                 MyArchitecture.InnerHTML=MyArchitecture.InnerHTML &   "
(MIPS)"
              Case 2
                 MyArchitecture.InnerHTML=MyArchitecture.InnerHTML &   "
(Alpha)"
              Case 3
                  MyArchitecture.InnerHTML=MyArchitecture.InnerHTML &   "
(PowerPC)"
              Case 6
                 MyArchitecture.InnerHTML=MyArchitecture.InnerHTML & "
(Intel Itanium Processor Family [IPF])"
              Case 9
                 MyArchitecture.InnerHTML=MyArchitecture.InnerHTML & "
(x64)"
          End Select         
      Next
	end sub
	
	sub GetOutlookInBox
	Const olFolderInbox = 6
		  strComputer = "."
      Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
      Set colItems = objWMIService.ExecQuery _
          ("Select * From Win32_Process Where Name = 'outlook.exe'") 
      If colItems.Count = 0 Then
          Set objOutlook = CreateObject("Outlook.Application")
          Set objNamespace = objOutlook.GetNamespace("MAPI")
          objNamespace.Logon "Default Outlook Profile",, False, True    
          Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
          objFolder.Display
          Set colItems = objFolder.Items
		  MyInboxCt.InnerHTML= colItems.Count
		  MyInboxUnReadCt.InnerHTML=objFolder.UnreadItemCount
      Else
          Set objOutlook = CreateObject("Outlook.Application")
          Set objNamespace = objOutlook.GetNamespace("MAPI")
          Set objFolder = objNamespace.GetDefaultFolder(olFolderInbox)
          Set colItems = objFolder.Items
		  MyInboxCt.InnerHTML= colItems.Count
		  MyInboxUnReadCt.InnerHTML= objFolder.UnreadItemCount
      End If
	end sub

	sub GetRunningApps
	  strHTML = "<table border='1' style='border-collapse: collapse' "
& _
          "bordercolor='#111111' width='100%' id='Table1' >"
	  Set objWord = CreateObject("Word.Application")
      Set colTasks = objWord.Tasks      
      For Each objTask in colTasks
          If objTask.Visible Then
		     strHTML = strHTML & "<tr><td>" & objTask.Name &
"</td></tr>"
          End If
      Next      
      objWord.Quit
      strHTML = strHTML & "</table><br>"
	  MyRunningApps.InnerHTML=strHTML
    end sub
	
    Sub GetProcesses
  	strHTML = "<table border='1' style='border-collapse: collapse' "  &
_
          "bordercolor='#111111' width='100%' id='Table1' >"
	  strHTML=strHTML & "<tr><td>Processes</td><td>Process ID</td></tr>"
       strComputer = "."
       Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
       Set colProcesses = objWMIService.ExecQuery("Select * from
Win32_Process")  
       For Each objProcess in colProcesses
          strHTML = strHTML & "<tr>"
          strHTML = strHTML & "<td width='50%'>" & objProcess.Name & "</td>"
          strHTML = strHTML & "<td width='50%'>" & objProcess.ProcessID & _
              "</td>"
       Next  
      strHTML = strHTML & "</table><br>"
      MyRunningProcesses.InnerHTML = strHTML
    End Sub
	
	sub GetMemory	
  	strComputer = "atl-dc-01" 
      Set wbemServices = GetObject("winmgmts:\\" & strComputer) 
      Set wbemObjectSet =
wbemServices.InstancesOf("Win32_LogicalMemoryConfiguration") 
      For Each wbemObject In wbemObjectSet 
          MyMemory.InnerHTML= wbemObject.TotalPhysicalMemory 
      Next 
	end sub
	
	sub GetMyName
		strHTML=""
      	strComputer = "."
      Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
      Set colComputers = objWMIService.ExecQuery _
          ("Select * from Win32_ComputerSystem")
      For Each objComputer in colComputers
          strHTML=  objComputer.Name
      Next	  
	  strComputer = "."
        Set objWMIService = GetObject("winmgmts:\\" & strComputer &
"\root\cimv2")
        Set IPConfigSet = objWMIService.ExecQuery _
            ("Select IPAddress from Win32_NetworkAdapterConfiguration Where
IPEnabled=TRUE")
        For Each IPConfig in IPConfigSet
            If Not IsNull(IPConfig.IPAddress) Then
                For Each strAddress in IPConfig.IPAddress
                    strHMTL = strHTML & " IP Address: " & strAddress
                Next
            End If
        Next
		MyName.InnerHTML = strHTML
    end sub
</script>





More information about the AccessD mailing list