Option Explicit
 
Dim oFS, oFolder, aFiles, sPath, objOutFile
Dim oFile, oPC, sLine, sPackage, sDatum
Dim iPCs, iPackages, iPackagesAll, aPackages, iOS
Dim iPCsTmp, iPackagesTmp, iPackagesAllTmp, aPackagesTmp
Dim bOSFound, bPCIsCounted
Dim sDate
Const FOR_APPENDING = 8
 
'Lib einbinden in VBS:
Execute CreateObject("Scripting.FileSystemObject").OpenTextFile("D:\DX-Tools\SoftwareverteilungenProTag\lib.vbs").ReadAll
 

Set oFS=CreateObject("Scripting.FileSystemObject")
 
sDate = USRLz(Day(Date),2) & "." & USRLz(Month(Date),2) & "." & year(Date)
If WScript.Arguments.Count = 1 Then
	sDate = WScript.Arguments.Item(0) '20.02.2013
End If
sPath = "D:\DX-Union\Server\profiles\host\entity"
 
If USRFileExists(USRScriptPath & "\" & "Auswertung.csv") Then
	Set objOutFile = oFS.OpenTextFile(USRScriptPath & "\" & "Auswertung.csv", FOR_APPENDING)
Else
	Set objOutFile = oFS.CreateTextFile(USRScriptPath & "\" & "Auswertung.csv")
	objOutFile.WriteLine "Datum;PCs;OS;Pakete;Pakete alle"
End If
 
Set oFolder = oFS.GetFolder(sPath)
Set aFiles = oFolder.Files
For each oFile In aFiles
	iPCsTmp = 0
	iPackagesTmp = 0
	iPackagesAllTmp = 0 
	aPackagesTmp = ";"
	bOSFound = False
	bPCIsCounted = False
	
	Set oPC = oFS.OpenTextFile(sPath & "\" & oFile.Name)
	Do Until oPC.AtEndOfStream
	     sLine = oPC.ReadLine
	     If InStr(1,sLine,"sw-paket-ist.",vbTextCompare) > 0 _ 
	     And InStr(1,sLine,".time=",vbTextCompare) = 0 _ 
	     And InStr(1,sLine,".version=",vbTextCompare) = 0 _ 
	     Then
	     	'WScript.Echo sLine
	     	sPackage = Split(Split(sLine,".",2)(1),"=")(0)
	     	sDatum = Split(Split(sLine,".",2)(1),"=")(1)
	     	'WScript.Echo sPackage & ";" & sDatum
	     	
	     	If sDatum = sDate Then
	     		WScript.Echo oFile.Name & ";" & sPackage
	     		If Not bPCIsCounted Then
	     			iPCsTmp = iPCsTmp + 1
	     			bPCIsCounted = True 
	     		End If
	     		If InStr(1,aPackages,sPackage,vbTextCompare) = 0 Then
	     			aPackagesTmp = aPackagesTmp & sPackage & ";"
	     			iPackagesTmp = iPackagesTmp + 1
	     		End If
	     		iPackagesAllTmp = iPackagesAllTmp + 1
	     		If UCase(sPackage) = UCase("windows 7") _
	     		Or UCase(sPackage) = UCase("windows 7 x64") _
	     		Or UCase(sPackage) = UCase("windows xp professional incl sp3") _
	     		Then
	     			iOS = iOS + 1
	     			iPCs = iPCs + 1
	     			bOSFound = True
	     			Exit Do
	     		End If
	     	End If
	     End If
	Loop
	oPC.Close
	If bOSFound = False Then
		bOSFound = bOSFound
		iPackages = iPackages + iPackagesTmp
		aPackages = aPackages & aPackagesTmp
		iPackagesAll = iPackagesAll + iPackagesAllTmp 
		If iPCsTmp > 0 Then
			iPCs = iPCs + 1
			bOSFound = bOSFound
		End if
	End If
Next
 
WScript.Echo "Anzahl betankter PCs: " & iPCs
WScript.Echo "Anzahl betankter Pakete: " & iPackages
WScript.Echo "Anzahl betankter Pakete All: " & iPackagesAll
WScript.Echo "Anzahl betankter OS: " & iOS
objOutFile.WriteLine sDate & ";" & iPCs & ";" & iOS & ";" & iPackages & ";" & iPackagesAll
objOutFile.close
 
 

'Lib einbinden in VBS:
'Execute CreateObject("Scripting.FileSystemObject").OpenTextFile("D:\DX-Tools\Tasks\lib.vbs").ReadAll
 

Function USRScriptPath()
	'gibt immer Pfad des ausrufenden Skripts wieder
	'Ohne "\" am ende
	USRScriptPath = CStr(Left(WScript.ScriptFullName, InStrRev(WScript.ScriptFullName, "\")-1))
End Function
Function USRScriptName()
	'gibt immer Name des ausrufenden Skripts wieder
	'Ohne ".vbs" oder was auch immer am Ende
	USRScriptName = CStr(Left(WScript.ScriptName,InStr(wscript.scriptname,".")-1))
End Function
Function USRScriptNameLong()
	USRScriptNameLong = WScript.ScriptName
End Function
 

Function USRFileExists(ByVal file)
	Dim filesys
	Dim exists
	Set filesys = CreateObject("Scripting.FileSystemObject")
	exists = filesys.FileExists(file)
	Set filesys = Nothing
	USRFileExists = exists
End Function 'USRFileExists
 
Function USRGetFile(FileName)
  If FileName<>"" Then
    Dim FileStream, oFS
    
    Set oFS = CreateObject("Scripting.FileSystemObject")
      'on error resume Next
      Set FileStream = oFS.OpenTextFile(FileName)
      USRGetFile = FileStream.ReadAll
  End If
End Function
 
Function USRWriteFile(FileName, Contents)
	Dim OutStream, oFS
	Set oFS = CreateObject("Scripting.FileSystemObject")
  If oFS.FileExists(FileName) then
  	Set OutStream = oFS.OpenTextFile(FileName, 2, True)
  Else
  	Set OutStream = oFS.CreateTextFile(FileName)
  End If
  OutStream.Write Contents
  Outstream.close
End Function
 
Function USRDeleteFileIfExists(sFile)
	Dim oFS
	Set oFS = CreateObject("Scripting.FileSystemObject")
  If oFS.FileExists(sFile) = True Then
		'Deletes that file. Second parameter is force, which means that if this file is readonly it will also be deleted
		oFS.DeleteFile sFile, True
	End If
	Set oFS = Nothing
End Function
 

'Aufruf: sServer = USRGetEnvVar("%computername%")
Function USRGetEnvVar(sVar)
	Dim WshShell, objEnv
	Set WshShell = CreateObject("WScript.Shell")
	USRGetEnvVar = WshShell.ExpandEnvironmentStrings(sVar)
End Function
 
Function USRWebserviceSendMail(sTo, sScript, sServer, sMessage, sSubject)
	sMessage = replace(USRBase64Encode(sMessage),"+","-")
	sSubject = replace(USRBase64Encode(sSubject),"+","-")
	USRWGet("http://oittest.info.med.uni-muenchen.de/intramed/dx_union/sendMailIfError/send.php?to=" & sTO & "&sj=" & sSubject & "&script=" & sScript & "&server=" & sServer & "&message=" & sMessage)
End Function
 

Function USRWGet(sURL)
Dim WshShell, ScriptPath, ScriptName
 
	
	'Parallel zum Skript muss ein Ordner Namens WGET existieren, in dem die WGet.exe liegt 
	Set WshShell = WScript.CreateObject("WScript.Shell")
	WshShell.Run USRScriptPath & "\WGet\wget.exe -O """ & USRScriptPath & "\" & USRScriptName & ".wget.txt"" -o """ & USRScriptPath & "\" & USRScriptName & ".wget.log"" " & sURL , 0, True
	USRWGet = True
End Function
 
Function USRBase64Encode(inData)
  'rfc1521
  '2001 Antonin Foller, Motobit Software, http://Motobit.cz
  Const Base64 = "ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+/"
  Dim cOut, sOut, I
  
  'For each group of 3 bytes
  For I = 1 To Len(inData) Step 3
    Dim nGroup, pOut, sGroup
    
    'Create one long from this 3 bytes.
    nGroup = &H10000 * Asc(Mid(inData, I, 1)) + _
      &H100 * USRMyASC(Mid(inData, I + 1, 1)) + USRMyASC(Mid(inData, I + 2, 1))
    
    'Oct splits the long To 8 groups with 3 bits
    nGroup = Oct(nGroup)
    
    'Add leading zeros
    nGroup = String(8 - Len(nGroup), "0") & nGroup
    
    'Convert To base64
    pOut = Mid(Base64, CLng("&o" & Mid(nGroup, 1, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 3, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 5, 2)) + 1, 1) + _
      Mid(Base64, CLng("&o" & Mid(nGroup, 7, 2)) + 1, 1)
    
    'Add the part To OutPut string
    sOut = sOut + pOut
    
    'Add a new line For Each 76 chars In dest (76*3/4 = 57)
    'If (I + 2) Mod 57 = 0 Then sOut = sOut + vbCrLf
  Next
  Select Case Len(inData) Mod 3
    Case 1: '8 bit final
      sOut = Left(sOut, Len(sOut) - 2) + "=="
    Case 2: '16 bit final
      sOut = Left(sOut, Len(sOut) - 1) + "="
  End Select
  USRBase64Encode = sOut
End Function
 
Function USRMyASC(OneChar)
  If OneChar = "" Then USRMyASC = 0 Else USRMyASC = Asc(OneChar)
End Function
 

Function USRPing(computerName)
	 Dim pings, status, wmi
	 Set wmi = GetObject("winmgmts:\\.\root\cimv2")
	 Set pings = wmi.ExecQuery("Select * From Win32_PingStatus where Address = '" & computerName & "'")
	 For Each status In pings
	 	If status.StatusCode = 0 Then 
	   		USRPing = True
	  	Else
	   		USRPing = False
	  	End If
	 Next
End Function
 
Public Sub USRLogging(sLine)
	oLogFile.WriteLine(USRGermDate() & " " & sLine)
	wscript.echo USRGermDate() & " " & sLine
End Sub
 
Function USRGermDate()
	USRGermDate = USRLz(Day(Now()), 2) & "." & USRLz(Month(Now()), 2) & "." & Year(Now()) & vbtab & USRLz(Hour(Now()), 2) & ":" & USRLz(Minute(Now()), 2) & ":" & USRLz(Second(Now()), 2)
End Function
 
Function USRLz(n, anzahl) 
	If anzahl > Len(n) Then 
		USRLz = String(anzahl - Len(n), "0") & n 
	Else 
		USRLz = n 
	End If 
End Function