VBS inventory Script with ftp function

report = strComputer & " Computer Inventory" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colItems = objWMIService.ExecQuery("Select * from Win32_OperatingSystem",,48)

report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "OS Information" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
For Each objItem in colItems
    report = report &  strComputer  & vbCrLf & "OS Details"& vbCrlf
    report = report &  "Caption: " & objItem.Caption & vbCrLf
    report = report &  "Description: " & objItem.Description & vbCrLf
    report = report &  "EncryptionLevel: " & objItem.EncryptionLevel & vbCrLf
    report = report &  "InstallDate: " & objItem.InstallDate & vbCrLf
    report = report &  "Manufacturer: " & objItem.Manufacturer & vbCrLf
    report = report &  "MaxNumberOfProcesses: " & objItem.MaxNumberOfProcesses & vbCrLf
    report = report &  "Name: " & objItem.Name & vbCrLf
    report = report &  "Organization: " & objItem.Organization & vbCrLf
    report = report &  "OSProductSuite: " & objItem.OSProductSuite & vbCrLf
    report = report &  "RegisteredUser: " & objItem.RegisteredUser & vbCrLf
    report = report &  "SerialNumber: " & objItem.SerialNumber & vbCrLf
    report = report &  "ServicePackMajorVersion: " & objItem.ServicePackMajorVersion & vbCrLf
    report = report &  "ServicePackMinorVersion: " & objItem.ServicePackMinorVersion & vbCrLf
    report = report &  "Version: " & objItem.Version & vbCrLf
    report = report &  "WindowsDirectory: " & objItem.WindowsDirectory & vbCrLf
Next

Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_SystemEnclosure")
report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "Bios Serial information" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
For Each objSMBIOS in colSettings
report = report & objSMBIOS.SerialNumber & "Serienummer" & vbCrLf
report = report & objSMBIOS.SMBIOSAssetTag & "AssetTag" & vbCrLf
Next

Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_ComputerSystem")
report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "Memory and Processor Information" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
For Each objComputer in colSettings
'report = report & objComputer.Name & vbcrlf
report = report & objComputer.TotalPhysicalMemory /1024\1024+1 & "MB Total memory" & vbcrlf
Next
Set colSettings = objWMIService.ExecQuery _
    ("Select * from Win32_Processor")
For Each objProcessor in colSettings
report = report & objProcessor.Description & " Processor" & vbCrLf
Next

report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "Disk Drive Information" & vbCrLf & "******************************************" & vbCrLf & vbCrLf

Set objWMIService = GetObject("winmgmts:")
Set objLogicalDisk = objWMIService.Get("Win32_LogicalDisk.DeviceID='c:'")
report = report & objLogicalDisk.FreeSpace /1024\1024+1 & "MB Free Disk Space" & vbCrLf
report = report & objLogicalDisk.Size /1024\1024+1 & "MB Total Disk Space" & vbCrLf

oReg.EnumKey HKEY_LOCAL_MACHINE, UnInstPath, arrSubKeys
software = vbCrLf & "******************************************" & vbCrLf
software = software & vbCrLf & "Installed Software" & vbCrLf & "******************************************" & vbCrLf & vbCrLf
For Each subkey In arrSubKeys
'MsgBox subkey
If Left (subkey, 1) <> "{" Then
    software = software & subkey & vbCrLf
End If
Next

 

'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
Dim FSO, RegEx, WMI, WSH
Dim B, bn, ch1, chs, Desc, EDID, i, mfdt, wd, x

Set FSO = CreateObject("Scripting.FileSystemObject")
Set WMI = GetObject("winmgmts:" & "\\.\root\cimv2")
Set WSH = CreateObject("WScript.Shell")

fncMonitor

 

Set fso = CreateObject("Scripting.FileSystemObject")
Set ts = fso.CreateTextFile ("c:\" & strComputer & ".txt", ForWriting)
ts.write report
ts.write software

FTPUpload "Hostname", "username", "Pass", "c:\" & strcomputer & ".txt", "/"

Function fncMonitor
For Each i in WMI.ExecQuery("SELECT * FROM Win32_DesktopMonitor")
 EDID = False : Desc = ""
 On Error Resume Next
  EDID = WSH.RegRead("HKLM\System\CurrentControlSet\Enum\" &_
   i.PNPDeviceID & "\Device Parameters\EDID")
  Desc = WSH.RegRead("HKLM\System\CurrentControlSet\Enum\" &_
   i.PNPDeviceID & "\DeviceDesc")
 On Error Goto 0
 If TypeName(EDID) = "Variant()" Then Exit For
Next

If Not TypeName(EDID) = "Variant()" Then MsgBox "PnP Match not found!" _
 , , "Quitting..." : WScript.Quit

B = ""

wd = EDID(8) * 256 + EDID(9)

mfdt = MonthName(Month(DateAdd("ww", EDID(16), "1/1/" & 1990 + EDID(17))))

For i = 0 to UBound(EDID)
 B = B & Chr(EDID(i))
Next

Do Until wd < 1
 bn = wd Mod 2 & bn
 wd = wd \ 2
 ch1 = 0
 If Len(bn) = 5 Then
  Do While Len(bn)
   ch1 = ch1 + (Mid(bn, 1, 1) * (2 ^ (Len(bn) - 1)))
   bn = mid(bn, 2)
  Loop
 End If
 If ch1 Then chs = Chr(ch1 + 64) & chs
Loop

Set RegEx = New RegExp

For Each x in Split("ModelName:c,VendorName:e,SerialNumber:f", ",")
 RegEx.Pattern = "\x00{3}[\xf" & Split(x, ":")(1) & "]\x00(.*)\x0a"
 If RegEx.Test(B) Then Execute Split(x, ":")(0) &_
  " = RegEx.Execute(B)(0).SubMatches(0)"
Next

report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "Monitor info"
report = report & vbCrLf & "******************************************" & vbCrLf
report = report & "Model:" & vbTab & ModelName & vbCrLf & "Serial #" &_
 vbTab & SerialNumber & vbCrLf & "Mfg Mth" & vbTab & mfdt
'~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
end function

 

Function FTPUpload(sSite, sUsername, sPassword, sLocalFile, sRemotePath)
 
  Const OpenAsDefault = -2
  Const FailIfNotExist = 0
  Const ForReading = 1
  Const ForWriting = 2
 
  Set oFTPScriptFSO = CreateObject("Scripting.FileSystemObject")
  Set oFTPScriptShell = CreateObject("WScript.Shell")

  sRemotePath = Trim(sRemotePath)
  sLocalFile = Trim(sLocalFile)
 
  '----------Path Checks---------
  'Here we willcheck the path, if it contains
  'spaces then we need to add quotes to ensure
  'it parses correctly.
  If InStr(sRemotePath, " ") > 0 Then
    If Left(sRemotePath, 1) <> """" And Right(sRemotePath, 1) <> """" Then
      sRemotePath = """" & sRemotePath & """"
    End If
  End If
 
  If InStr(sLocalFile, " ") > 0 Then
    If Left(sLocalFile, 1) <> """" And Right(sLocalFile, 1) <> """" Then
      sLocalFile = """" & sLocalFile & """"
    End If
  End If

  'Check to ensure that a remote path was
  'passed. If it's blank then pass a "\"
  If Len(sRemotePath) = 0 Then
    'Please note that no premptive checking of the
    'remote path is done. If it does not exist for some
    'reason. Unexpected results may occur.
    sRemotePath = "\"
  End If
 
  'Check the local path and file to ensure
  'that either the a file that exists was
  'passed or a wildcard was passed.
  If InStr(sLocalFile, "*") Then
    If InStr(sLocalFile, " ") Then
      FTPUpload = "Error: Wildcard uploads do not work if the path contains a " & _
      "space." & vbCRLF
      FTPUpload = FTPUpload & "This is a limitation of the Microsoft FTP client."
      Exit Function
    End If
  ElseIf Len(sLocalFile) = 0 Or Not oFTPScriptFSO.FileExists(sLocalFile) Then
    'nothing to upload
    FTPUpload = "Error: File Not Found."
    Exit Function
  End If
  '--------END Path Checks---------
 
  'build input file for ftp command
  sFTPScript = sFTPScript & "USER " & sUsername & vbCRLF
  sFTPScript = sFTPScript & sPassword & vbCRLF
  sFTPScript = sFTPScript & "cd " & sRemotePath & vbCRLF
  sFTPScript = sFTPScript & "binary" & vbCRLF
  sFTPScript = sFTPScript & "prompt n" & vbCRLF
  sFTPScript = sFTPScript & "put " & sLocalFile & vbCRLF
  sFTPScript = sFTPScript & "quit" & vbCRLF & "quit" & vbCRLF & "quit" & vbCRLF

  sFTPTemp = oFTPScriptShell.ExpandEnvironmentStrings("%TEMP%")
  sFTPTempFile = sFTPTemp & "\" & oFTPScriptFSO.GetTempName
  sFTPResults = sFTPTemp & "\" & oFTPScriptFSO.GetTempName

  'Write the input file for the ftp command
  'to a temporary file.
  Set fFTPScript = oFTPScriptFSO.CreateTextFile(sFTPTempFile, True)
  fFTPScript.WriteLine(sFTPScript)
  fFTPScript.Close
  Set fFTPScript = Nothing 

 

  oFTPScriptShell.Run "%comspec% /c FTP -n -s:" & sFTPTempFile & " " & sSite & _
  " > " & sFTPResults, 0, TRUE
 
  Wscript.Sleep 1000
 
  'Check results of transfer.
  Set fFTPResults = oFTPScriptFSO.OpenTextFile(sFTPResults, ForReading, _
  FailIfNotExist, OpenAsDefault)
  sResults = fFTPResults.ReadAll
  fFTPResults.Close

 
  oFTPScriptFSO.DeleteFile(sFTPTempFile)
  oFTPScriptFSO.DeleteFile (sFTPResults)
 
  If InStr(sResults, "226 Transfer complete.") > 0 Then
    FTPUpload = True
  ElseIf InStr(sResults, "File not found") > 0 Then
    FTPUpload = "Error: File Not Found"
  ElseIf InStr(sResults, "cannot log in.") > 0 Then
    FTPUpload = "Error: Login Failed."
  Else
    FTPUpload = "Error: Unknown."
  End If