'Software auslesen
 
	Function GetSWData
   	Dim strSW
   	software = ""
 
   	For Each strSW In GetAllActiveSWInReg
   		'If strSW="microsoft" Then
   	   software = software & getsoftware("") & "</p>"
   	   'End if 
   	Next
   		software = Left(software, Len(software)-1)
 
 
	End Function
 
	Function GetAllActiveSWInReg()
  	Dim arrResult(),i
  	Dim oWMIRegProvider
  	Dim strComputer
  	Dim arrDevice, strDevice
  	Dim arrPnPIds, strPnpID
  	Dim arrTMP, strTMP, strEDID
	Const HKLM =&H80000002
	Const strBaseKey = "Software\Microsoft\Windows\CurrentVersion\Uninstall\"
 
  	strComputer="."
  	i=0
  	ReDim arrResult(i)
  	Set oWMIRegProvider=GetObject("winmgmts:{impersonationLevel=impersonate}!\\" _
    & strComputer & "\root\default:StdRegProv")
  	oWMIRegProvider.EnumKey HKLM, strBaseKey, arrSubKeys
  	For Each strSubkey In arrSubKeys
		intRet = oWMIRegProvider.GetstringValue (HKLM, strBaseKey & strSubKey, _
  "DisplayName", strValue)
			If intRet <> 0 Then
				intRet = oWMIRegProvider.GetstringValue (HKLM, strBaseKey & strSubKey, _
  "QuietDisplayName", strValue)
			End If
			If (strValue <> "") and (intRet = 0) Then
				software = software & strValue &vbcrlf
			End If	
	Next 	
	GetSWData strValue, title
	End Function