Locate the local path for Google Drive, DropBox, SkyDrive in VBscript

When scripting up a storm, I sometimes need to place output into folders that I know will be stored in the cloud. The following script set will return the folder on the local windows drives where the cloud apps will be syncing their files, or an empty string if the script fails due to the cloud application having not been installed or some other issue such as Microsoft moving their registry setting or Google changing the readability of their config file.

WScript.Echo "Dropbox : " & GetDropBoxFolder
WScript.Echo "Google Drive : " & GetGoogleDriveFolder
WScript.Echo "Skydrive : " & GetSkyDriveFolder

Function GetSkyDriveFolder ()
Dim WshShell, f
set WshShell = WScript.CreateObject ("WScript.Shell")
On Error Resume Next
f = WshShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\SkyDrive\UserFolder") ' Windows 7
If Err.Number <> 0 Then
 Err.Clear
 ' Allegedly this is windows 8 key, however this appears not to be the Case
 f = WshShell.RegRead("HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\SkyDrive\UserFolder")
End If
GetSkyDriveFolder = f & ""
On Error GoTo 0
End Function

Function GetAppDataFolder ()
' returns C:\\\AppData\Roaming
' returns empty strong if not found
Dim WshShell, f
set WshShell = WScript.CreateObject ("WScript.Shell")
On Error Resume Next
f = WshShell.ExpandEnvironmentStrings("%APPDATA%") & ""
If Err.Number Then Err.Clear
On Error GoTo 0
GetAppDataFolder = f
End Function

Function GetLocalAppDataFolder ()
' returns C:\\\AppData\Roaming
' returns empty strong if not found
Dim WshShell, f
set WshShell = WScript.CreateObject ("WScript.Shell")
On Error Resume Next
f = WshShell.ExpandEnvironmentStrings("%LOCALAPPDATA%") & ""
If Err.Number Then Err.Clear
On Error GoTo 0
GetLocalAppDataFolder = f
End Function

Function Base64Decode(ByVal base64String)
'rfc1521 1999 Antonin Foller, Motobit Software, http://Motobit.cz
Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
Dim dataLength, sOut, groupBegin
base64String = Replace(base64String, vbCrLf, "")
base64String = Replace(base64String, vbTab, "")
base64String = Replace(base64String, " ", "")
dataLength = Len(base64String)
If dataLength Mod 4 <> 0 Then
  Err.Raise 1, "Base64Decode", "Bad Base64 string."
  Exit Function
End If
Dim numDataBytes, CharCounter, thisChar, thisData, nGroup, pOut
For groupBegin = 1 To dataLength Step 4
  numDataBytes = 3
  nGroup = 0
  For CharCounter = 0 To 3
    thisChar = Mid(base64String, groupBegin + CharCounter, 1)
    If thisChar = "=" Then
      numDataBytes = numDataBytes - 1
      thisData = 0
    Else
      thisData = InStr(1, Base64, thisChar, vbBinaryCompare) - 1
    End If
    If thisData = -1 Then
      Err.Raise 2, "Base64Decode", "Bad character In Base64 string."
      Exit Function
    End If
    nGroup = 64 * nGroup + thisData
  Next
  nGroup = Hex(nGroup)
  nGroup = String(6 - Len(nGroup), "0") & nGroup
  pOut = Chr(CByte("&H" & Mid(nGroup, 1, 2))) +  Chr(CByte("&H" & Mid(nGroup, 3, 2))) +  Chr(CByte("&H" & Mid(nGroup, 5, 2)))
  sOut = sOut & Left(pOut, numDataBytes)
Next
Base64Decode = sOut
End Function

Function GetDropBoxFolder ()
' Returns Empty String If host.db not found and decoded properly
' %APPDATA%\Dropbox\host.db
Dim fso, hostdb, p, f
f = ""
p = GetAppDataFolder
If p <> "" Then
 On Error Resume Next
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set hostdb = fso.OpenTextFile(p & "\Dropbox\host.db", 1, False, -2)
 If Err.Number <> 0 Then
  Err.Clear
 Else
  f = hostdb.ReadLine & "" ' junk line
  If Err.Number <> 0 Then Err.Clear
  f = hostdb.ReadLine & "" ' this line!
  If Err.Number <> 0 Then Err.Clear
  hostdb.Close
  If Err.Number <> 0 Then Err.Clear
  If f <> "" Then f = Base64Decode(f) & ""
  If Err.Number <> 0 Then Err.Clear
 End If
 On Error GoTo 0
End If
GetDropBoxFolder = f
End Function

Function GetGoogleDriveFolder ()
' Returns Empty String If sync_config.db not found and decoded properly
' %LOCALAPPDATA%\Google\Drive\sync_config.db
' local_sync_root_pathvalue\\?\C:\Users\thsforsy\Google Drive[RS][ETX][EOT]
' 123456789012345678901234567890
Dim fso, datafile, p, alltext, cleantext, f, i
f = ""
p = GetLocalAppDataFolder
If p <> "" Then
 On Error Resume Next
 Set fso = CreateObject("Scripting.FileSystemObject")
 Set datafile = fso.OpenTextFile(p & "\Google\Drive\sync_config.db", 1, False, 0)
 If Err.Number <> 0 Then
  ' No folder, just let the system exit and return empty string
  Err.Clear
 Else
  startpos = 0
  Do While Not datafile.AtEndOfStream And startpos = 0
   alltext = datafile.ReadLine & ""
   If Err.Number <> 0 Then Err.Clear
   cleantext = ""
   For i = 1 To Len(alltext)
    If Asc(Mid(alltext,i,1)) = 30 OR Asc(Mid(alltext,i,1)) >=32 Then cleantext = cleantext & Mid(alltext,i,1)
   Next
   startpos = InStr(1,cleantext,"local_sync_root_pathvalue")
   If startpos > 0 Then
    endpos = startpos + 29
    Do While endpos < Len(cleantext) And Asc(Mid(cleantext,endpos,1)) >= 32
     IF Asc(Mid(cleantext,endpos,1)) <> 0 Then f = f & Mid(cleantext,endpos,1)
     endpos = endpos + 1
    Loop
   End If
  Loop
  datafile.Close
  If Err.Number <> 0 Then Err.Clear
 End If
 On Error GoTo 0
End If
GetGoogleDriveFolder = Trim(f)
End Function

Normal distribution from uniform random in VBscript

Because everyone needs to generate a normally distributed random number set at least once in their life, right? Why not do it in the programming language that comes with nearly every version windows since Microsoft started ripping off Apple.

' * Static *
Dim NormalRandToggle, NormalRandTemp

Function NormalRand(ByVal thisMean, ByVal thisStandardDev)
' Outputs Gaussian/Normal distributed random numbers using Box-Muller algorithm.
' Note the function creates two at a time,
' so global variables are used to store and output the second number on demand
If NormalRandToggle = 1 Then
 NormalRandToggle = 0
 NormalRand = NormalRandTemp
Else
 NormalRandToggle = 1
 Dim R1, R2, rad, t
 Do Until rad > 0.0 AND rad < 1.0
  R1 = (2.0 * Rnd()) - 1.0
  R2 = (2.0 * Rnd()) - 1.0
  rad = R1^ 2 + R2^2
 Loop
 t = Sqr(-2.0 * Log(rad) / rad)
 NormalRandTemp = t * R2 * thisStandardDev + thisMean
 NormalRand = t * R1 * thisStandardDev + thisMean
End If
End Function



' *** TEST ***

Randomize
Dim i, R, N, S, SS, M, V, SD
N = 0
S = 0
SS = 0
For i = 1 To 1000000
 N = N + 1
 R = NormalRand (100, 33)
 S = S + R
 SS = SS + R^2
Next
M = S / N
V = SS / N - M ^ 2
SD = Sqr(V)
WScript.Echo "Mean = " & M & " Var = " & V & " StdDev = " & SD

Thanks to Zaza for example VB code and Peter Kankowski for the one pass variance/standard deviation calculation in the test.

Windows 64bit scripting host forced into 32bit

Error: [Microsoft][ODBC Driver Manager] Data source name not found and no default driver specified
Code: 80004005

Using Windows Script Host (WSH, CScript, VBS) to access Microsoft Access database files will bring this error up in 64 bit Windows. You need to force your script to run in 32 bit mode. The following code attached to the top of your script should detect if you are in a 64 bit Windows OS and will attempt to run the 32 bit cscript.
(Update 2014-02-28: Aborts when there are spaces in the path, added quotes to fix this) (Update 2016-01-28: fix for 64bit office vs 32bit office)

' ***************
' *** 64bit check
' ***************
' check to see if we are on 64bit Windows OS with 32bit MS Office -> re-run this script forcing 32bit mode cscript

Dim r32OSbit, r32Officebit
r32OSbit = CPUbitness()
r32Officebit = OfficeBitness()
WScript.Echo "OS mode " & r32OSbit & " with Office " & r32Officebit
If r32OSbit = "AMD64" AND r32Officebit= "x86" Then
 If MatchAnyArg("restart32") = 0 Then RestartWithCScript32 "restart32" Else MsgBox "Cannot find 32bit version of cscript.exe or unknown OS type " & r32OSbit
 WScript.Quit
End If

' Function to determine bitness of the installed Microsoft Office
FUNCTION OfficeBitness ()
' Returns x64 or x86, or "?" if no office found
CONST MaxOfficeVer = 20 ' currently 15 (2015-08-04)
CONST MinOfficeVer = 10
DIM objShell, i, Found, thisNode, regNode
Set objShell = WScript.CreateObject("WScript.Shell")
On Error Resume Next
i = MaxOfficeVer + 1
Found = False
DO
 i = i - 1
 thisNode = "HKLM\Software\Microsoft\Office\" & i & ".0\Outlook\Bitness"
 regNode = objShell.RegRead (thisNode)
 IF Err.Number <> 0 THEN
  Err.Clear
 Else
  Found = True
 End If
LOOP UNTIL i = MinOfficeVer OR Found
IF Found THEN
 OfficeBitness = regnode
 'WScript.Echo regnode & " for office version " & i & ".0"
ELSE
 OfficeBitness = "?"  'No office found in registry range
END IF
END FUNCTION

FUNCTION CPUbitness()
' AMD64 IA64 x86
Dim r32wShell, r32env1
Set r32wShell = WScript.CreateObject("WScript.Shell")
r32env1 = r32wShell.ExpandEnvironmentStrings("%PROCESSOR_ARCHITECTURE%")
CPUbitness = r32env1
Set r32wShell = Nothing
End Function

Function MatchAnyArg(thisArg)
Dim FoundArg, r32i
FoundArg = FALSE
IF WScript.Arguments.Count <> 0 THEN
 r32i = 0
 thisArg = lcase(thisArg)
 DO
  IF lcase(WScript.Arguments(r32i)) = thisArg THEN FoundArg = True
  r32i = r32i + 1
 LOOP Until FoundArg OR r32i >= WScript.Arguments.Count
END IF
MatchAnyArg = FoundArg
End Function

Function RestartWithCScript32(extraargs)
Dim strCMD, iCount, r32wShell, r32fso
SET r32fso = CreateObject("Scripting.FileSystemObject")
SET r32wShell = WScript.CreateObject("WScript.Shell")
strCMD = r32wShell.ExpandEnvironmentStrings("%SYSTEMROOT%") & "\SysWOW64\cscript.exe"
If NOT r32fso.FileExists(strCMD) Then strCMD = "cscript.exe"
strCMD = strCMD & Chr(32) & Wscript.ScriptFullName & Chr(32)
If Wscript.Arguments.Count > 0 Then
 For iCount = 0 To WScript.Arguments.Count - 1
  if Instr(Wscript.Arguments(iCount), " ") = 0 Then ' add unspaced args
   strCMD = strCMD & " " & Wscript.Arguments(iCount) & " "
  Else
   If Instr("/-\", Left(Wscript.Arguments(iCount), 1)) > 0 Then ' quote spaced args
    If InStr(WScript.Arguments(iCount),"=") > 0 Then
     strCMD = strCMD & " " & Left(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), "=") ) & """" & Mid(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), "=") + 1) & """ "
    ElseIf Instr(WScript.Arguments(iCount),":") > 0 Then
     strCMD = strCMD & " " & Left(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), ":") ) & """" & Mid(Wscript.Arguments(iCount), Instr(Wscript.Arguments(iCount), ":") + 1) & """ "
    Else
     strCMD = strCMD & " """ & Wscript.Arguments(iCount) & """ "
    End If
   Else
    strCMD = strCMD & " """ & Wscript.Arguments(iCount) & """ "
   End If
  End If
 Next
End If
r32wShell.Run strCMD & " " & extraargs, 0, False
Set r32wShell = Nothing
SET r32fso = Nothing
End Function

' *******************
' *** END 64bit check
' *******************

Australia likes foreigners

Babies are the major increase in the Australian population. These babies are not contributing to the economy! Apparently they get taxpayer money in the form of a "baby bonus" the year they arrive! They are unskilled, have no intention of seeking employment, can't speak the language, ignore our customs and will eventually compete for our jobs! Do you realise how much it will cost to train these guys and the resources they will consume in the meantime? Send them back to where they came from I say!

July 2008 to June 2009 settler arrivals, by country of birth

Country of birth	Nr Imm	%
New Zealand	33034	31.11%
United Kingdom	21567	20.31%
India	16909	15.92%
China (excludes SARs and Taiwan)	14935	14.07%
Philippines	5619	5.29%
Iraq	4008	3.77%
Sri Lanka	3918	3.69%
Malaysia	3261	3.07%
Burma (Myanmar)	2931	2.76%
TOTAL	106182	100.00%

So immigrants are mostly New Zealanders and Poms. And they get employed reasonably quickly (as opposed to those freeloading babies). Certainly better than most locally brewed Australians.

Unemployment rates of immigrants to Australia
http://www.immi.gov.au/media/fact-sheets/14labour.htm

Migrant Categories	Six months after arrival	18 months after arrival
Business skills/ENS/RSMS	3%	1%
Concessional Family/SAL	16%	4%
Former Overseas Student	9%	3%
Independent	11%	2%
Family	20%	6%

Australian unemployment rate: 5.3% 

http://www.abs.gov.au/AUSSTATS/abs@.nsf/mf/6202.0?opendocument#from-banner=LN

Debunking the myths about asylum seekers 

Deporting to danger

"Boat people" immigration is driven by external forces, not actually local policy (Push vs Pull). And the number of arrivals is currently very low, certainly relative to the Howard era - but that was driven by external events. Remember John Howard more than doubled Australia's immigration intake.

Start up Windows software optionally

There are plenty of good software programs that will do this for you, but if you don't want to trust anyone else then you can write it all yourself.

Start NotePad and customise the following script to point at the software you want to load optionally.

' Ask if you want to optionally start a program

RunMyProgram "Pidgin", "C:\Program Files\Pidgin\pidgin.exe"
'RunMyProgram "Skype", "C:\Program Files\Skype\Phone\Skype.exe"

'************************
SUB RunMyProgram (SoftwareName, SoftwarePath)
Dim ClickResult, myShell
ClickResult = MsgBox ("Did you want to run " & SoftwareName & "?", vbYesNo, "Run " & SoftwareName & "?")
If ClickResult = vbYes Then
 SET myShell = WScript.CreateObject("WScript.Shell")
 Set myExec = myShell.Exec(SoftwarePath)
 Set myShell = Nothing
End If
END SUB
'************************

If you don't know the "SoftwarePath" for your program then you can find that out by right clicking on the icon of the software and selecting "Properties", examine the field "Target".

Save the file with a .vbs extension (.wsh should work as well), in this case "Pidgin.vbs". Ideally you would place this in a special tools folder, or even directly in your startup folder.
Windows 7: C:\Users\username\AppData\Roaming\Microsoft\Windows\Start Menu\Programs\Startup
You are going to have to at least place a short cut to the vbs file in this start up folder.

If you want this feature for the startup item for everyone who uses your computer then place the file or shortcut in
Windows 7: C:\ProgramData\Microsoft\Windows\Start Menu\Programs\Startup

What if the software starts automatically by itself? You're going to have to stop this behaviour. Hopefully this happens just from a shortcut in the StartUp program group which you can get to by examining the paths above. You could also run MSCONFIG and disable the software there. A warning though, you can mess up your computer pretty badly if you start disabling items without knowing what you are doing.

SAS - How merge (mal)functions

The normal MERGE statement in SAS simply fouls up on MANY to MANY relationships. You are far better off using SQL but even then there are pitfalls. Check the examples below.

Data sets	SetA	SETA Alpha Beta Desc 1000 1 Ax1 Bx2 2000 2 Ax1 Bx0 4000 3 Ax2 Bx1 4000 4 Ax2 Bx1 5000 5 Ax3 Bx2 5000 6 Ax3 Bx2 5000 7 Ax3 Bx2
	SetB	SETB Alpha Gamma 1000 11 1000 12 3000 13 4000 14 5000 15 5000 16
SAS Merge Does not perform combinatorial on 5000. This is rediculous	DATA SetAB01; MERGE SetA SetB; BY Alpha; RUN;	Alpha Beta Desc Gamma 1000 1 Ax1 Bx2 11 1000 1 Ax1 Bx2 12 2000 2 Ax1 Bx0 3000 13 4000 3 Ax2 Bx1 14 4000 4 Ax2 Bx1 14 5000 5 Ax3 Bx2 15 5000 6 Ax3 Bx2 16 5000 7 Ax3 Bx2 16
SAS SQL Simple Join Does not include unmatched. Where is Alpha=2000,3000?	PROC SQL; CREATE TABLE SetAB02 AS SELECT * FROM SetA, SetB WHERE SetA.Alpha = SetB.Alpha; QUIT;	Alpha Beta Desc Gamma 1000 1 Ax1 Bx2 11 1000 1 Ax1 Bx2 12 4000 3 Ax2 Bx1 14 4000 4 Ax2 Bx1 14 5000 5 Ax3 Bx2 15 5000 6 Ax3 Bx2 15 5000 7 Ax3 Bx2 15 5000 5 Ax3 Bx2 16 5000 6 Ax3 Bx2 16 5000 7 Ax3 Bx2 16
SAS SQL Full Join Drops the Alpha value for unmatched left. Where is Alpha=3000?	PROC SQL; CREATE TABLE SetAB03 AS SELECT * FROM SetA FULL JOIN SetB ON SetA.Alpha = SetB.Alpha; QUIT;	Alpha Beta Desc Gamma 1000 1 Ax1 Bx2 11 1000 1 Ax1 Bx2 12 2000 2 Ax1 Bx0 13 4000 3 Ax2 Bx1 14 4000 4 Ax2 Bx1 14 5000 5 Ax3 Bx2 15 5000 5 Ax3 Bx2 16 5000 6 Ax3 Bx2 15 5000 6 Ax3 Bx2 16 5000 7 Ax3 Bx2 15 5000 7 Ax3 Bx2 16
SAS SQL Full Join Coalesce Works!	PROC SQL; CREATE TABLE SetAB03A AS SELECT COALESCE(SetA.Alpha, SetB.Alpha) AS Alpha, * FROM SetA FULL JOIN SetB ON SetA.Alpha = SetB.Alpha; QUIT;	Alpha Beta Desc Gamma 1000 1 Ax1 Bx2 11 1000 1 Ax1 Bx2 12 2000 2 Ax1 Bx0 3000 13 4000 3 Ax2 Bx1 14 4000 4 Ax2 Bx1 14 5000 5 Ax3 Bx2 15 5000 5 Ax3 Bx2 16 5000 6 Ax3 Bx2 15 5000 6 Ax3 Bx2 16 5000 7 Ax3 Bx2 15 5000 7 Ax3 Bx2 16
SAS SQL Left Join Probably what you want. No left unmatched Where is 3000?	PROC SQL; CREATE TABLE SetAB04 AS SELECT * FROM SetA LEFT JOIN SetB ON SetA.Alpha = SetB.Alpha; QUIT;	Alpha Beta Desc Gamma 1000 1 Ax1 Bx2 11 1000 1 Ax1 Bx2 12 2000 2 Ax1 Bx0 4000 3 Ax2 Bx1 14 4000 4 Ax2 Bx1 14 5000 5 Ax3 Bx2 15 5000 6 Ax3 Bx2 15 5000 7 Ax3 Bx2 15 5000 5 Ax3 Bx2 16 5000 6 Ax3 Bx2 16 5000 7 Ax3 Bx2 16

A nice Venn Diagram display of SQL linking

Audio Books

Audio books are much better than I thought.

I have occasionally listened to radio readings every now and again, they were on at strange times and were usually serialised into timeslots that I could never arrange into consistent listening sessions. I borrowed the star wars trilogy dramatisation on CD from a friend and was blown away by the show in audio.

A number of years ago I spotted some free audio books on iTunes, notably EarthCore by Scott Sigler from PodioBooks or iTunes. The story was great and well told. I consumed the entire novel in a few nights then hunted around for other free audio books. I downloaded a couple from non iTunes sources such as PodioBooks and Cory Doctorow, but never got around to putting them into iTunes.

There were always plenty of podcasts to listen to. Many of these podcasts have Audible as a sponsor. I would listen to the podcaster's book recommendations with interest and always nod and think that I should sign up some day, but I had these other books that I should listen to before I did that.

A couple days ago I just signed up. I picked Audible's $7.50/month for three months deal and selected "Stranger in a Strange Land" by Robert Heinlein for no other reason than I thought I should have read that classic by now. Initially I was very disappointed as the sound quality was metallic (bit rate of 32kbps), however I quickly got used to it and just fell right into the story.

Audio books are awesome! I highly highly recommend seeking out the freely available books, then when you realise that you are hooked, sign up for an audible account and start listening some new and classic books. The major downside is that being Australian we have a small subset of books available due to the restrictive trade practices of the publication industry. It appears that publishers are forcing their customers to misrepresent themselves as a US resident, seek out non mainstream books, resort to piracy or go without.