Option Explicit
'-------------------------------------------------------------------------
' CheckDuplicateExternalSIDType.vbs
'
' Beschreibung
' List alle deaktivierten Konto im GC ein und prüft auf doppelte Einträge in MSexchangeMaster
'
' Achtung: einige änderungen müssen in "zwei schritten" erfolgen
'
' Das Skript wird mit den Berechtigungen des angemeldeten Benutzers
' ausgeführt. Die entsprechenden Berechtigungen sind sicher zu stellen
'
' (c)2006 Net at Work Netzwerksysteme GmbH
'
' Version 1.0 (17. Mai 2006) Frank Carius
'	Initial Release
' Version 1.1 (17. Mai 2006) Frank Carius
'	Umbau. Aufnehmen aller ExternalSIDs in ein Dictionary und ausgabe
'	Damit werden nun alle und nur die doppelten Objekte korrekt ausgegeben
'
' http://blogs.msdn.com/oldnewthing/archive/2004/03/15/89753.aspx   How do I convert a SID between binary and string forms?
'
' Hinweise
' Das Feld sollte NUR gefüllt sein, wenn msExchUserAccountControl = 2 ist (deaktivierter User)
' Ansonsten sollte das Feld "leer" sein
'  (&(objectCategory=User)(msExchUserAccountControl=0)(msExchMasterAccountSid=*))
'	-> Fehler   msExchMasterAccountSid ,muss leer sein
' (&(objectCategory=User)(msExchUserAccountControl=2)(!(msExchMasterAccountSid=*)))
'	-> fehler da disabled und kein msExchMasterAccountSid 
'
' Die SID im msExchMasterAccountSID entspricht normal genau einem externen Konto (1 User = 1 Postfach)
' Wird eine SID mehrfach referenziert, dann ist das für Postfächer meist nicht erwünscht
' ABER es gibt Objekte, bei denen die msExchMasterAccountSID gleich ist z.B:
' - MOM nutzt deaktive Monitorpostfächer mit Dienstkonto als externes Konto
' - Exchange Systemmailboxen (eine je Store) nutzen die SID des Serverkonto
' - SELF kann mehrfach sein.
'-------------------------------------------------------------------------

Dim total, totaldup, strGCPath
Dim oConnection, oCommand, oRecordset
Dim strResult, strQuery, strOutFilePrefix
Dim objDebug, xmlwriter
dim dictExternalSID, strSID
dim arrTemp

strOutFilePrefix = makefilename("CheckDuplicateExternalSIDType-" & Date() & "-" & Time())  ' common name of the output files without extension
set objdebug = new DebugWriter 
objDebug.target = "file:6 console:5" ' errorlogging  0=only output, 1=Error 2=Warning 3=information  5++ =debug
objDebug.outFile = strOutFilePrefix &".log"
objDebug.start

call ForceCScript  ' must be rund with CSCRIPT
objDebug.writeln "CheckDuplicateExternalSIDType: gestartet", 0

set xmlWriter = new XmlTextWriter
xmlWriter.filename = strOutFilePrefix & ".xml"
xmlWriter.Indentation = 4
call xmlWriter.WriteStylesheet("CheckDuplicateExternalSIDType.xsl")
call writexslt("CheckDuplicateExternalSIDType.xsl")
call xmlWriter.WriteStartElement("CheckDuplicateExternalSIDType")
call xmlWriter.WriteElementString("starttime1", now())

objDebug.write "Looking für GC"
dim oCont, oGC
Set oCont = GetObject("GC:")
For Each oGC In oCont
    strGCPath = oGC.ADsPath
Next
objDebug.writeln "strGCPath=" & strGCPath, 3

' Walk though all groups 

objDebug.writeln "Querying AD für Objects at " & strGCPath,4
Set oConnection = CreateObject("ADODB.Connection")
Set oRecordset = CreateObject("ADODB.Recordset")
Set oCommand = CreateObject("ADODB.Command")
oConnection.Provider = "ADsDSOObject"
oConnection.Open "ADs Provider"
oCommand.ActiveConnection = oConnection
oCommand.Properties("Page Size") = 100
oCommand.CommandText = "<" & strGCPath & ">;(&(objectCategory=User)(msExchUserAccountControl=2)(msExchMasterAccountSid=*));distinguishedName,name,msExchMasterAccountSid,mail;subtree"
Set oRecordset = oCommand.Execute
objDebug.writeln "Done Total Records found:" & oRecordset.recordcount, 0
call xmlWriter.WriteElementString("total1", oRecordset.recordcount)

call xmlWriter.WriteElementString("starttime2", now())
total = 0

set dictExternalSID = CreateObject("Scripting.dictionary")

objDebug.writeln "----- Processing objects ---------",0
oRecordset.MoveFirst
do until oRecordset.EOF
	total = total + 1
	objDebug.writeln "Object:" & total & "/" & oRecordset.recordcount &":" & left(oRecordset.Fields("distinguishedName"),20) & ".." ,4
	strSID = SID2STRING(oRecordset.Fields("msExchMasterAccountSid"))
	if not dictExternalSID.exists (strSID) then
		objDebug.writeln "Add SID:" & strSID,5
		dictExternalSID.add strSID, "0"  ' initialize
	end if
	' Add current Object
	arrTemp = Split(dictExternalSID.item(strSID),vbtab)
	redim preserve arrTemp(ubound(arrTemp)+1)
	objDebug.writeln "Add Obj:" & oRecordset.Fields("distinguishedName"),5
	arrTemp(0)= cint(arrTemp(0)) + 1
	arrTemp(ubound(arrtemp))= oRecordset.Fields("distinguishedName")
	dictExternalSID.item(strSID) = join(arrTemp,vbtab)
	oRecordset.MoveNext
loop
objDebug.writeln "Total Object processed:" & total,4

' Dump recordset
dim item, intcount
totaldup = 0
objDebug.writeln "----- Dumping Dictionary ---------",0
for each item in dictExternalSID.keys
	arrtemp = split(dictExternalSID.item(item),vbtab)
	objDebug.writeln "Dump SID:" & item ,4
	if arrtemp(0) > 1 then
		totaldup = totaldup + 1
		objDebug.writeln "  Multiple Entries:" & arrtemp(0),4
		call xmlWriter.WriteStartElement("object")   ' of ("CheckDuplicateExternalSIDType")
		call xmlWriter.WriteElementString("count", arrtemp(0))
		call xmlWriter.WriteElementString("sid", item)
		for intcount = 1 to ubound(arrtemp)
			call xmlWriter.WriteElementString("dn", arrtemp(intcount))
		next
		call xmlWriter.WriteEndElement()   ' of ("CheckDuplicateExternalSIDType")
	else
		objDebug.writeln "  unique:",4
	end if 
next
objDebug.writeln "Total Multiple entries:" & totaldup,4

call xmlWriter.WriteElementString("total1", oRecordset.recordcount)
call xmlWriter.WriteElementString("total2", total)
call xmlWriter.WriteElementString("totaldup", totaldup)
call xmlWriter.WriteElementString("endtime", now())
call xmlWriter.WriteEndElement()   ' of ("CheckDuplicateExternalSIDType")
call xmlWriter.Close               ' XML schreiben
WScript.quit(0)





sub writexslt(strfilename)
	dim txtxsl
	txtxsl = _
		"<?xml version=""1.0"" encoding=""utf-8"" ?> " & vbcrlf & _
		"<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & vbcrlf & _
		"<xsl:template match=""/"">" & vbcrlf & _
		"<html>" & vbcrlf & _
		"<head><title>CheckDuplicateExternalSIDType Status</title></head>" & vbcrlf & _
		"<body>" & vbcrlf & _
		"<h1>CheckDuplicateExternalSIDType Status</h1> " & vbcrlf & _
		"<h2>Summary</h2> " & vbcrlf & _
		"<xsl:for-each select=""CheckDuplicateExternalSIDType""> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"	<tr><th>Starttime</th><td><xsl:value-of select=""starttime1"" /></td></tr>" & vbcrlf & _
		"	<tr><th>LDAP Query finished</th><td><xsl:value-of select=""starttime2"" /></td></tr>" & vbcrlf & _
		"	<tr><th>EndTime</th> <td><xsl:value-of select=""endtime"" /></td></tr>" & vbcrlf & _
		"	<tr><th># Objects found</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""total1""/></td></tr>" & vbcrlf & _
		"	<tr><th># Objects processed</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""total2""/></td></tr>" & vbcrlf & _
		"	<tr><th># Objects with duplicates</th><td bgcolor=""#FFFFFF""><xsl:value-of select=""totaldup""/></td></tr>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"<h2>Details</h2> " & vbcrlf & _
		"<table border=""1"" width=""100%"">" & vbcrlf & _
		"  <tr bgcolor=""#808080"">" & vbcrlf & _
		"	<th>msExchMasterAccountSid</th> " & vbcrlf & _
		"	<th>Count:</th> " & vbcrlf & _
		"	<th>dn:</th> " & vbcrlf & _
		"  </tr>" & vbcrlf & _
		"<xsl:for-each select=""CheckDuplicateExternalSIDType/object""> " & vbcrlf & _
		"	<xsl:sort select=""memberrec"" data-type=""number"" order=""descending""/>" & vbcrlf & _
		"	<tr>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""sid"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"		<xsl:value-of select=""count"" /> " & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	<td>" & vbcrlf & _
		"       <xsl:for-each select=""dn""> " & vbcrlf & _
		"		     <xsl:value-of select=""."" /><br/> " & vbcrlf & _
		"       </xsl:for-each>" & vbcrlf & _
		"	</td>" & vbcrlf & _
		"	</tr>" & vbcrlf & _
		"</xsl:for-each>" & vbcrlf & _
		"</table>" & vbcrlf & _
		"</body>" & vbcrlf & _
		"</html>" & vbcrlf & _
		"</xsl:template>" & vbcrlf & _
		"</xsl:stylesheet>"

	Const ForWriting = 2
	dim fs, file
	Set fs = CreateObject("Scripting.FileSystemObject")
	Set file = fs.OpenTextFile(strfilename, ForWriting, True)
	file.writeline Convert2Text(txtxsl)
	file.Close
end sub


' ==================================================  Auxilary procedures and classes ==========================

class XMLTextWriter
'~ usage in VBScript. Please define StyleSheet and filename first and than start writing the data
'~ set xmlWriter = new XmlTextWriter
'~ xmlWriter.filename = "filename.xml"
'~ xmlWriter.Indentation = 4
'~ call xmlWriter.WriteStylesheet("stylesheet.xsl")
'~ call xmlWriter.WriteStartElement("Root")
'~ call xmlWriter.WriteElementString("starttime", now())
'~ call xmlWriter.WriteEndElement
'~ call xmlWriter.close

	dim xmlfilename	'stores the filename
	dim xmldom  	'DOM Object
	dim xmlparent	'currentNode
	dim xmlroot		'RootNode
	dim xmlobject	'PArent of currentNode
	dim intIndentation

	'~ xmlfile.write "<?xml version='1.0' encoding='ISO-8859-1'?>" & vbcrlf

	private Sub Class_Initialize
		dim xmldeclaration
		Set xmlDom = CreateObject("Microsoft.XMLDOM")
		xmlDom.loadxml "<?xml version='1.0'?>"
		set xmlobject = xmlDom
	End Sub

	private Sub Class_Terminate
		xmldom.LoadXML getFormattedXML
		xmldom.save(xmlfilename)
	End Sub
	
	public Property let filename(wert)    
		xmlfilename = wert
	End Property

	public Property get filename
		filename = xmlfilename 
	End Property

	public Property let Indentation(wert)
		' only für Backwards compatibility
	End Property

	public Property let Formatting(wert)
		' writer.Formatting = Formatting.Indented   ' Funktioniert nur mit .nEtg ?
	End Property

	sub Writestylesheet (item)
		dim stylePI 
		Set stylePI = xmlDom.createProcessingInstruction("xml-stylesheet", "type=""text/xsl"" href="""&item & """")
		xmlDom.appendChild(stylePI)
	end sub

	sub WriteStartElement(item)
		dim xmlobject2
		set xmlobject2 = xmlDom.createElement(item)
		xmlobject.appendchild xmlobject2
		set xmlobject = xmlobject2
	end sub


	sub WriteAttributeString(name,value)  ' erg&auml;nzt eine ID zum aktuellen Element
		if isnull(value) then value = ""
		xmlobject.setAttribute name, value
	end sub
	

	sub WriteElementString(item,value)  ' add XML tag and Data
		dim xmldata
		set xmldata = xmlDom.createElement(item)
		if isnull(value) then value = ""
		xmldata.text = value
		xmlobject.appendchild(xmldata)
	end sub
	
	sub WriteEndElement
	' Schliesse den aktuellen Client und gehe ein objekt h&ouml;her
		set xmlobject = xmlobject.parentnode
	end sub

	sub DeleteEndElement
	' Entferne den letzten Client komplett
		dim xmlobject2
		set xmlobject2 = xmlobject
		set xmlobject = xmlobject.parentnode
		xmlobject.removechild(xmlobject2)
	end sub


	function getXML
	' gebe die aktuelle XML-Information unformtiert aus
		getxml = xmldom.xml
	end function

	function LoadXML(strxml)
	' ersetze die Information durch eine neue XML-Information
		xmldom.loadXML(strxml)
	end function

	sub Flush()
	' Schreibe die aktuelle XML-Struktur als Datei heraus
		'~ xmldom.LoadXML getFormattedXML   ' wenn dsa aktiv wird, ist die XML Datei nicht komplett
		xmldom.save(xmlfilename)
	end sub


	function getFormattedXML
	' Gebe die XML-Struktur formatiert und besser lesbar aus
		dim oStylesheet
		set oStylesheet = CreateObject("Microsoft.XMLDOM")
		oStylesheet.async = False
		oStylesheet.loadXML ("<?xml version=""1.0"" encoding=""UTF-8""?>" & vbcrlf & _
						"<xsl:stylesheet version=""1.0"" xmlns:xsl=""http://www.w3.org/1999/XSL/Transform"">" & vbcrlf & _
						"<xsl:output method=""xml"" indent=""yes"" encoding=""UTF-8"" />" & vbcrlf & _
						"<xsl:template match=""@* | node()"">" & vbcrlf & _
						"   <xsl:copy>" & vbcrlf & _
						"        <xsl:apply-templates select=""@* | node()"" />" & vbcrlf & _
						"   </xsl:copy>" & vbcrlf & _
						"</xsl:template>" & vbcrlf & _
						"</xsl:stylesheet>")
		getFormattedXML = xmlDOM.transformNode(oStylesheet)
	end function


	sub close()
		xmldom.LoadXML getFormattedXML
		xmldom.save(xmlfilename)
	end sub
	
end class



class debugwriter
	' Generic Class für writing debugging information and handling runtime errors
	' By default al Level 1 Messaegs are logged to the Console

	private objIE, file, fs, debugfilename, status, strline
	private debuglevelIE , debuglevelfile, debugleveleventlog, debuglevelConsole

	private Sub Class_Initialize
		status = "active" : strline = "" : debugfilename = ""
		debuglevelIE = 0
		debuglevelfile = 0
		debugleveleventlog = 0
		debuglevelConsole = 1
	End Sub

	private Sub Class_Terminate()
		if isobject(OBJIE) then
			objie.document.write "</table></body></html>"
		end if
		if debugfilename <> "" then
			file.Close
		end if
	End Sub

	public sub start : status = "active": end sub
	public sub pause : status = "pause" : end sub

	public property let outfile(wert) 	
		if debugfilename <> "" then    'Close existing debug file
			file.close : file = nothing : fs = nothing 
		end if

		debugfilename = wert    ' open debug file
		Set fs = CreateObject("Scripting.FileSystemObject")
		Set file = fs.OpenTextFile(makefilename(debugfilename), 8, True)
	end property

	public property let setie (wert)  : set objIE = wert  : objie.visible = true  end property

	public property let target (wert)
		dim arrTemp, intcount
		arrTemp = split(wert," ")  ' spit by space
		for intcount = 0 to ubound(arrTemp)
			select case lcase(split(arrtemp(intcount),":")(0))
				case "ie" 		debuglevelIE = cint(right(arrtemp(intcount),1))
				case "file" 	debuglevelfile = cint(right(arrtemp(intcount),1))
				case "eventlog" debugleveleventlog = cint(right(arrtemp(intcount),1))
				case "console" 	debuglevelConsole = cint(right(arrtemp(intcount),1))
			end select
		next
	end property

	sub write(strMessage)  
		strline = strline & strMessage
	end sub

	Sub writeln(strMessage, intseverity)
	'Fügt einen Eintrag in die Log-Datei ein
		dim blnerror
		
		strMessage = strline & strMessage  ' add existing Output Messages
		strline = ""
		
		if err <> 0 then  ' Sonderbehandlung als "ErrorHandler"
			blnerror = true
			strmessage= "RUNTIME ERROR  :" & strMessage & vbcrlf & _
						"ERR.Number     :" & err.number & vbcrlf & _
						"ERR.Description:" & err.Description & vbcrlf & _
						"ERR.Source     :" & err.source & vbcrlf & _
						"ERR.HelpFile   :" & err.HelpFile & vbcrlf & _
						"ERR.HelpContext:" & err.HelpContext & vbcrlf
			err.clear
		else
			blnerror = false
		end if
	
		if ((status = "active")  or blnerror) then 

		if (debuglevelfile > 0) and ((debuglevelfile >= intseverity) or blnerror) and (debugfilename <> "") then
                file.Write(Now & ",")
                Select Case intseverity
                    Case 0  file.Write("Out0")
                    Case 1  file.Write("Err1")
                    Case 2  file.Write("Wrn2")
                    Case 3  file.Write("Inf3")
                    Case Else file.Write("Dbg"&intseverity)
                End Select
                file.WriteLine("," & Convert2Text(strMessage))
		strline = ""
            end if

		if (debugleveleventlog > 0) and ((debugleveleventlog >=intSeverity) or blnerror) then
                dim objWSHShell
		Set objWSHShell = Wscript.CreateObject("Wscript.Shell")
                Select Case intseverity
			Case 0  objWSHShell.LogEvent 0, strMessage '           		Const EVENT_SUCCESS = 0
			Case 1  objWSHShell.LogEvent 1, strMessage '           		const EVENT_ERROR = 1
			Case 2  objWSHShell.LogEvent 2, strMessage '           		Const EVENT_WARNING = 2
			Case else  objWSHShell.LogEvent 4, strMessage '           	Const EVENT_INFO = 4
                End Select
			end if

			if (debuglevelconsole > 0) and ((debuglevelconsole >=intSeverity) or blnerror) then
				Select Case intseverity
					Case 0  wscript.echo now() & ",OUT0:" & strMessage
					Case 1  wscript.echo now() & ",ERR1:" & strMessage
					Case 2  wscript.echo now() & ",WRN2:" & strMessage
					Case 3  wscript.echo now() & ",INF3:" & strMessage
					Case Else wscript.echo now() & ",DBG" & intseverity & ":" & strMessage
				End Select
			end if

           if (debuglevelie > 0) and ((debuglevelie >= intSeverity) or blnerror) then
           		dim strieline
      			if  not isobject(objIE) then
      				Set objIE = CreateObject("InternetExplorer.Application")
           		    objIE.navigate("about:blank")
					objIE.visible = true
					Do While objIE.Busy
				    	WScript.Sleep 50
					Loop
					objIE.document.write "<html><head><title>DebugWriter Output</title></head><body>"
					objIE.document.write "<table  border=""1"" width=""100%""><tr><th>Time</th><th>intseverity</th><th>Description</th></tr>"
				end if
           		strieline = "<tr><td>" & now () & "</td>"
                Select Case intseverity
                    Case 0  strieline = strieLine & "<td bgcolor=""#00FF00"">Out0</td>"
                    Case 1  strieline = strieLine & "<td bgcolor=""#FF0000"">Err1</td>"
                    Case 2  strieline = strieLine & "<td bgcolor=""#FFFF00"">Wrn2</td>"
                    Case 3  strieline = strieLine & "<td>Inf3</td>"
                    Case Else strieline = strieLine & "<td>Dbg"&intseverity&"</td>"
                End Select
                strieline = strieline & "<td>" & strmessage & "</td></tr>"
				objIE.document.write cstr(strieline)
           end if

           '~ if (instr(DebugTarget,"mom") <>0) or blnerror then
				'~ scriptContext.echo now() &","& intseverity &":"& strline & strMessage
           '~ end if

		end if  ' if status = active
		strline = ""
   	End Sub
	
	
	private function makefilename(wert)
		' Converts all invalid characters to valid file names
		wert = replace(wert,"\","-")
		wert = replace(wert,"/","-")
		wert = replace(wert,":","-")
		wert = replace(wert,"*","-")
		wert = replace(wert,"?","-")
		wert = replace(wert,"<","-")
		wert = replace(wert,"|","-")
		wert = replace(wert,"""","-")
		makefilename = wert
	end function
	
	private function Convert2Text(wert) 	' Converts non printable characters to "X" , so that Textfile is working
		dim loopcount, tempwert, inttest
		tempwert=""
		for loopcount = 1 to len(wert)   ' replace all unprintable characters  maybe easier and faster with RegEx
			tempwert = tempwert & chr(ascb(mid(wert,loopcount,1)))	
		next
		Convert2Text = tempwert
	end function
	
end class




sub ForceCScript
    If InStr(1,WScript.FullName,"cscript",vbTextCompare) = 0 Then   ' Prüfung ob mit CSCRIPT gestartet wurde
        wscript.echo "Bitte mit CSCRIPT aufrufen"
        wscript.quit (255)
	end if
end sub

Sub abbruch(info,waittime)
	' usage: call abbruch ("Script abbrechen" ,5)
	dim WshShell, result
	Set WshShell = CreateObject("WScript.Shell")
	result = WshShell.Popup("Continue script at position "& vbcrlf & info & vbcrlf & "Waiting "&waittime&" Seconds", waittime, "Stop Script", 33) 'OKCancel(1) + Question (32)
	If result = 2 Then
        WScript.echo "Abbruch durch Anwender (Exitcode = 255)"
        WScript.Quit(255)
    End If	
End Sub


function Convert2Text(wert)
	' Converts non printable characters to "X" , so that Textfile is working
	dim loopcount, tempwert, inttest
	tempwert=""
	for loopcount = 1 to len(wert)   ' replace all unprintable characters  maybe easier and faster with RegEx
		'~ inttest = ascw(mid(wert,loopcount,1))
		'~ if ((inttest>=32) and (inttest<127)) or (inttest=10) or (inttest=13) or (inttest=9) then
			'~ tempwert = tempwert & chr(inttest)  ' printable Character or CR LF TAB
		'~ else
			'~ tempwert = tempwert & "X"
		'~ end if 
		tempwert = tempwert & chr(ascb(mid(wert,loopcount,1)))	
	next
	Convert2Text = tempwert
end function

function makefilename(wert)
	' Converts all invalid characters to valid file names
	wert = replace(wert,"\","-")
	wert = replace(wert,"/","-")
	wert = replace(wert,":","-")
	wert = replace(wert,"*","-")
	wert = replace(wert,"?","-")
	wert = replace(wert,"<","-")
	wert = replace(wert,"|","-")
	wert = replace(wert,"""","-")
	makefilename = wert
end function


Function SID2STRING(bar)
	' http://support.Microsoft.com/kb/243330 Bekannte Sicherheits-IDs in Windows-Betriebssystemen
	' Converts Binary Array into Human readable SID: S-1-5-21-XXXXX-XXXXX-XXXXX-XXX

	'~ ,01,01,00,00,00,00,00,05,0A,00,00,00
	'~ 1 01 = S1
	'~ 1 01 =  Anzahl der "-" plus 2-> 3 folgende "-"
	'~ 6 000000000005 = 05
	'~ 4 0a000000  = 10
	'~ 4
	'~ 4
	'~ 4

	'~ http://blogs.msdn.com/oldnewthing/archive/2004/03/15/89753.aspx
	'~ How do I convert a SID between binary and string forms?


	'~ S-a-b-c-d-e-f-g-
	'~ a (revision) 
	'~ N (number of dashes minus two) 
	'~ bbbbbb (six bytes of "b" treated as a 48-bit number in big-endian format) 
	'~ cccc (four bytes of "c" treated as a 32-bit number in little-endian format) 
	'~ dddd (four bytes of "d" treated as a 32-bit number in little-endian format) 
	'~ eeee (four bytes of "e" treated as a 32-bit number in little-endian format) 
	'~ ffff (four bytes of "f" treated as a 32-bit number in little-endian format) 	
	
	dim strsid, count, arrSID
	strsid = ""
	for count = 1 to lenb(bar)
		strsid = strsid & right("0" & hex(ascb(midb(bar,count ,1))),2) & ","
	Next
	strsid = left(strsid,len(strsid)-1)  ' cut last separator
	arrSID = Split(strsid,",")
	
	strsid = "S-" & HexToDec(arrSID(0))   ' Revision
	strsid = strsid & "-" & HexToDec(arrSID(1)) ' ANzahl der "-"
	strsid = strsid & "-" & HexToDec(arrSID(2) & arrSID(3) & arrSID(4) & arrSID(5) & arrSID(6) &arrSID(7))
	for count = 2 to cbyte(arrSID(1))  ' weitere 4-byte Little Endian
		strsid  = strsid & "-" & HexToDec(arrSID(count*4+3) & arrSID(count*4+2) & arrSID(count*4+1) & arrSID(count*4))
	next
	SID2STRING = strSID
End Function 

Function HexToDec(ByVal sHex)
HexToDec = "" & CLng("&H" & sHex)
End Function