'::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: ':: :: ':: PCeX Vista - Inventory System 2009 - v.3.0 r.14.01 :: ':: -------------------------------------------------- :: ':: :: ':: Software desenvolvido e aprimorado com o intuito de :: ':: auxiliar o Profissional de TI (Administrador ou :: ':: Helpdesk). :: ':: :: ':: A Licença de uso é gratuíta. A alteração do código :: ':: para outros fins, deve ser comunicada ao mantenedor :: ':: do código no e-mail aragaorj@hotmail.com. Esta é a :: ':: única exigência da licença. :: ':: :: ':: -------------------------------------------------- :: ':: :: ':: Responsável pelo Projeto :: ':: - Artur de Souza Aragão :: ':: :: ':: Desenvolvedores :: ':: - Artur de Souza Aragão :: ':: - Vinicius Canto Xavier :: ':: - Rodrigo Andrade Araujo (FoxMaster) :: ':: - Alexandre Teixeira :: ':: - Flávio Bordignon :: ':: - Gildo Soares :: ':: :: ':: Testadores :: ':: - Leandro Ribeiro da Silva :: ':: - Jamal Ibrahim :: ':: :: ':: -------------------------------------------------- :: ':: 2004-2009 :: ':: :: '::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::: '---[ Variáveis e Constantes do Sistema ]--------------------| Option Explicit '---{ Controle de Linguagem }--------------------------------| Dim LcID LcId = 1046 '-> Linguagem pt-Br '---{ Objetos de Conexão }-----------------------------------| Dim objWMI '-> Conexão WMI Dim objShell '-> Conexão Shell Dim objNet '-> Conexão Network Dim objReg '-> Conexão ao Registro Dim objAv '-> Conexão Antivírus (WMI) Dim objIE '-> Conexão para construção do XHTML Dim strStruc '-> Relacionado a Query WMI '---{ Constantes }-------------------------------------------| Const ForReading = 1 '-> Constante para leitura Const ForWriting = 2 '-> Constante para escrita Const ForAppending = 8 '-> Constante para adição Const wbemCimtypeUint32 = 19 '-> Constante para configuração Wbem Const wbemCimtypeSint64 = 20 '-> Constante para configuração Wbem Const wbemCimtypeUint64 = 21 '-> Constante para configuração Wbem Const wbemFlagReturnImmediately = &h10 '-> Constante para configuração Wbem Const wbemFlagForwardOnly = &h20 '-> Constante para configuração Wbem strStruc = wbemFlagReturnImmediately + wbemFlagForwardOnly Const HKCR = &H80000000 '-> Constante para configuração chave registro HKCR Const HKCU = &H80000001 '-> Constante para configuração chave registro HKCU Const HKLM = &H80000002 '-> Constante para configuração chave registro HKLM Const HKU = &H80000003 '-> Constante para configuração chave registro HKU Const HKCC = &H80000005 '-> Constante para configuração chave registro HKCC Const adSaveCreateNotExist = 1 '-> Constante para criação do MHT Const adSaveCreateOverWrite = 2 '-> Constante para criação do MHT Const adTypeBinary = 1 '-> Constante para criação do MHT Const adTypeText = 2 '-> Constante para criação do MHT Const fColor = "#022E99" '-> Constante para configuração do valor de cor Const adVarChar = 200 '-> Constante para campo Varchar Const MaxCharacters = 255 '-> Constante para máximo de Caracteres Const AppKB = "KB" '-> Constante para checagem de KBs (Updates, Patches e Hot-Fixes) '---{ Banco de dados Virtual / Framework.Net }---------------| Dim Dlst, Dlst1 '---{ Entrada de argumentos/parâmetros }---------------------| Dim objArgs, x, strFmt, strDPlay, sDplay, strRel, strDX, vPCName, Flag, nChar '---{ Classes, propriedades e objetos }----------------------| Dim strPC, strProp, objClass, strQuery, colItems, objItem, objItem1, objItem2, objItem3 '---{ Informações do aplicativo PCeX }-----------------------| Dim vAppName, vAppVer, vAppBuild '---{ Alertas e Mensagens }----------------------------------| Dim vMsg01, vMsg02, vMsg03, vMsg04, vMsg05, vMsg06, vMsg07, vInfoMsg01, vErr01, vErr02, vErr03, vErr04, vErr05, vErr06, vOutMsg01, vOutMsg02, vOutMsg03, vAlertMsg01, vAlertMsg02 '---{ Win32_OperatingSystem }--------------------------------| Dim HostName, OSArch, OSName, OSBuild, OSRel, OSSPVer, OSLang, OSPCType, OSType, OSDesc, OSDate, OSInstDate, OSLDateBoot, OSSuite, OSCrypLevel, OSRegUser, OSRegOrg, OSWin, OSSys, OSSerialNum, OSFreePhys, OsTotalPhys, OSFreePagFil, OSFreeVirtual, OsTotalVirtual, OSSPnVer, AVDEPHard, AVDEP32xApp, AVDEPDrv, AVDEPSup '---{ Registro do Windows }----------------------------------| Dim OSKey, strKey, strValName, strOptName, aValNames, aValTypes, dwVal, strVal Dim DayLTSet, IEVers, MailVers, DXVers, WMPVers, MDACVers, IISWeb, SunVM, DomLogon '---{ Win32_ComputerSystem }---------------------------------| Dim UserLogin, SysType, MBModel, SysMem, PCType, SysDom, nCPU '---{ Win32_NetworkLoginProfile }----------------------------| Dim ProfName, ProfUser, ProfLLogon '---{ Win32_Processor }--------------------------------------| Dim iCPU, CPUID, CPUName, CPURes, CPUFam, CPUCurClock, CPUMaxClock, CPULP1, CPULP2, CPUAval, CPUAddress, CPUVer, CPURev, CPUMaxVal, CPUFab, CPUnCore, CPUnLogic, CPUExtClock, CPUInfo, CPUMCID, CPUStep, CPUPMan, CPUVolt, CPUSocket, CPUCacheID '---{ Win32_AssociatedProcessorMemory }----------------------| Dim AssCacheID '---{ Win32_CacheMemory }------------------------------------| Dim CPUCacheLevel, iCache, CPUCacheSize, CPUL1Cache, CPUL2Cache, CPUL3Cache '---{ Win32_PageFileUsage }----------------------------------| 'Dim OsTotalPage, MemPhys, MemPagFil, MemVM, MemAvailVM, MemPercFreePhys, MemPercFreePagFil, MemPercFreeVM, MemGraphgFreePhys, MemGraphgFreePagFil, MemGraphgFreeVM '---{ Win32_BaseBoard }--------------------------------------| Dim iMainb, MainbProd, MainFab, MBFab, MainSN, MainPN, MainVer, MainOtherInfo '---{ Win32_BIOS }-------------------------------------------| Dim iBios, BiosName, BiosFab, BiosBuild, BiosLang, BiosRelDate, BiosSN, BiosSMBiosVer, BiosVer '---{ Win32_PhysicalMemoryArray }----------------------------| Dim iSMem, SMemUnits, SMemFree '---{ Win32_PhysicalMemory }---------------------------------| Dim iMem, MemBank, MemDevLoc, MemSize, MemBits, MemHotSwap, MemFFactor, MemFab, MemType, MemSN, MemSpeed '---{ Win32_SystemSlot }-------------------------------------| Dim iSlot, SlotID, SlotType, SlotDesign, SlotBitSize, SlotTypeID, SlotStatus '---{ Win32_IDEController }----------------------------------| Dim iIDE, IDEID, IDEFab '---{ Win32_SCSIController }---------------------------------| Dim iSCSI, SCSIID, SCSIFab '---{ Win32_OnBoardDevice }----------------------------------| Dim iOnB, OnBDevID, OnBDevType, OnBDevOn '---{ Win32_USBController, Win32_USBControllerDevice }-------| Dim iUSB, USBName, USBID, iUSBDev, USBDevName, USBDevDesc '---{ Array de propriedades associadas entre classes }-------| Dim strDevName, strQuotes, strDevNames, arrDevNames Dim strDevName1, strDevNames1, arrDevNames1 Dim strDevName2, strDevNames2, arrDevNames2 '---{ Win32_PnPEntity }--------------------------------------| Dim iHnID, HnIDName, HnIDFab, HnIDDesc '---{ Win32_VideoController }--------------------------------| Dim iSVGA, SVGADevID, SVGAName, SVGAGPU, SVGARam, SVGABitPix, SVGAResH, SVGAResV, SVGARes, SVGARefrRCurr, SVGARefrRMin, SVGARefrRMax, SVGARefrRate, SVGADrvVers, SVGADrvDate '---{ Win32_DesktopMonitor }---------------------------------| Dim iMon, MonID, MonName, MonFab '---{ Win32_NetworkAdapterConfiguration }--------------------| Dim LanName, LanMac, LanIP, LanDHCP, LanMasc, LanGateway, LanDHCPSrv, iDNS, LanDNSSrv, LanWINSSrv1, LanWINSSrv2 '---{ AntiVirusProduct }-------------------------------------| Dim AVName, AVVers, AVFab, AVScanRTime, AVProdUpd, AVSup '---{ AntiSpyware }------------------------------------------| Dim WDOn, WDName, WDInst, WDEngine, WDSign, WDRTOn, WDUpdt Dim AppInst, AppVer, AppVend '---{ Windows Update }---------------------------------------| Dim AUOpt, AUSchedInstDay, AUSchedInstTime '---{ Windows Firewall }-------------------------------------| Dim FwOn, FwNAllow, CWinFw '---{ Win32_SoundDevice }------------------------------------| Dim iSound, SoundName, SoundFab '---{ Win32_CDROMDrive }-------------------------------------| Dim iOD, ODName, ODDrive, ODFab, ODMedLoad '---{ Win32_Keyboard }---------------------------------------| Dim iKbDev, KbDevDesc, KbDevType, KbDevNFKeys, KbDevStatus '---{ Win32_PointingDevice }---------------------------------| Dim iMD, MDName, MDIConn, MDFab, MDStatus '---{ Win32_DiskDrive }--------------------------------------| Dim iPhHD, PhHDID, PhHDName, PhHDIface, PhHDSize '---{ Win32_PhysicalMedia }----------------------------------| Dim PhMedSN '---{ Win32_DiskDriveToDiskPartition }-----------------------| Dim HDPartID, HDPartSize '---{ Win32_LogicalDiskToPartition }-------------------------| Dim LogHDID '---{ Win32_LogicalDisk }------------------------------------| Dim iLogHD, LogHDName, LogHDType, LogHDFilSys, LogHDMaxSize, LogHDFreeSize, LogHDPercUsedSize, LogHDPercFreeSize, LogHDGraphSize '---{ Win32_TapeDrive }--------------------------------------| Dim iTape, TapeName, TapeFab ', TapeZip, TapeECC '---{ Win32_NetworkAdapter }---------------------------------| Dim iNic, NicName, NicFab, NicMAC '---{ MSNdis_MediaConnectStatus }----------------------------| Dim NicActive, NicInstName, NicStatus '---{ MSNdis_LinkSpeed }-------------------------------------| Dim NicSpeedMax '---{ MSNdis_MacOptions }------------------------------------| Dim NicMode '---{ Win32_POTSModem }--------------------------------------| Dim iMod, ModName, ModType, ModPort, ModDRVDate, ModStatus '---{ Win32_InfraredDevice }---------------------------------| Dim iIR, IRName, IRFab, IRStatus '---{ Win32_Printer }----------------------------------------| Dim iPrt, PrtName, PrtPort, PrtFab, PrtShareName, PrtDefault '---{ Grupos e Usuários }------------------------------------| Dim iGroup, GroupName, UserAccName, UserAccBlk, UserDef '---{ Compartilhamento }-------------------------------------| Dim iShare, SharePath, ShareFolder, ShareInfo '---{ Drives Mapeados }--------------------------------------| Dim iMap, MapID, MapProv, MapSize '---{ Sessões Remotas }--------------------------------------| Dim iSession, SessionUser, SessionPC '---{ Arquivos Abertos }-------------------------------------| Dim iOFiles, OFilesUser, OFilesPath '---{ Softwares e Atualizações }-----------------------------| Dim arrSubKeys, strSubKey, strAppName, strAppVer, strAppInstDate, strAppInstLoc Dim iApp, AppInstName, AppVersion, AppInstDate, AppLocation '---{ Processos do Sistema }---------------------------------| Dim iProc, ProcId, ProcName, ProcPath '---{ Serviços do Sistema }----------------------------------| Dim iServ, SrvName, SrvStatus, SrvStatMode '---{ Definição de Cores }-----------------------------------| Dim ChkCol '---{ Construção do Relatório }------------------------------| Dim sRel, wHtml, aLin '---{ Contador }---------------------------------------------| Dim i '---{ Controle de Horário e Data }---------------------------| Dim DateTime '------------------------------------------------------------| '---[ Conexões para o Shell e Network ]----------------------| 'Set objShell = WScript.CreateObject("WScript.Shell") Set objNet = CreateObject("WScript.Network") '------------------------------------------------------------| '---[ Variáveis de Alerta e Mensagens ]----------------------| vPCName = LCase(objNet.ComputerName) vAppName = ("PCeX Vista - Inventory System 2009") vAppVer = (" v.3.0") vAppBuild = (" r.14.01") vMsg01 = ("Computador/IP" & vbCrLf &_ "------------------------" & vbCrLf & vbCrLf &_ "Digite o " & Chr(34) & "nome" & Chr(34) & " ou " & Chr(34) & "ip" & Chr(34) & " do Computador a ser inventariado:" & vbCrLf & vbCrLf &_ "Para sair do aplicativo, digite 0 (zero) e confirme.") vMsg02 = ("Formato de saída do relatório" & vbCrLf &_ "----------------------------------------------" & vbCrLf & vbCrLf &_ "Escolha uma das opções abaixo:" & vbCrLf &_ " 0 - Sair do aplicativo." & vbCrLf &_ " 1 - Gera no formato html." & vbCrLf &_ " 2 - Gera no formato mht." & vbCrLf &_ " 3 - Gera no formato xml." & vbCrLf &_ " 4 - Gera no formato txt." & vbCrLf &_ " 5 - Gera no formato csv." & vbCrLf) vMsg03 = ("Visualização do relatório" & vbCrLf &_ "--------------------------------------" & vbCrLf & vbCrLf &_ "Escolha uma das opções abaixo:" & vbCrLf &_ " 0 - Sair do aplicativo." & vbCrLf &_ " 1 - Visualizar (somente html e xml)." & vbCrLf &_ " 2 - Não visualizar." & vbCrLf) vMsg04 = ("Seleção das informações no relatório" & vbCrLf &_ "----------------------------------------------------------" & vbCrLf & vbCrLf &_ "Escolha uma das opções abaixo:" & vbCrLf &_ " 0 - Sair do aplicativo." & vbCrLf &_ " 1 - Consolidado do Sistema." & vbCrLf &_ " 2 - Apenas Sumário e Segurança." & vbCrLf &_ " 3 - Apenas Sumário, Segurança e Usuários." & vbCrLf &_ " 4 - Apenas Sumário, Segurança e Hardware." & vbCrLf &_ " 5 - Apenas Sumário, Segurança e Software." & vbCrLf) vMsg05 = ("Estilo DirectX" & vbCrLf &_ "---------------------" & vbCrLf & vbCrLf &_ "Escolha uma das opções abaixo:" & vbCrLf &_ " 0 - Sair do aplicativo." & vbCrLf &_ " 1 - Sim." & vbCrLf &_ " 2 - Não." & vbCrLf) vMsg06 = ("Não há ítens para serem exibidos.") vMsg07 = ("Somente sistemas operacionais à partir do Windows 2000 com SP3 ou Windows Update Client" & vbCrLf &_ "instalados, possuem suporte ao Windows Update") vErr01 = ("Acesso negado!" & vbCrLf &_ "Verifique seus níveis de permissão neste computador.") vErr02 = ("HEX Error is: 1C3") vErr03 = ("Computador não existe ou não está acessível!" & vbCrLf &_ "Favor digite corretamente o nome do computador e" & vbCrLf &_ "verifique se há um firewall ativo!") vErr04 = ("Servidor RPC indisponível." & vbCrLf &_ "Conexão não é possível.") vErr05 = ("Conexão não é possível.") vErr06 = ("Conexão não é possível.") vOutMsg01 = ("Recurso não instalado ou não suportado pelo sistema.") vOutMsg02 = ("Não há ítens para serem exibidos.") vOutMsg03 = ("Serviço Inativo!") vAlertMsg01 = ("A Central de Segurança está desabilitada.") vAlertMsg02 = ("A Central de Segurança somente é suportada nos Sistemas Operacionais Windows XP SP2, Windows Vista e suas versões em 64bit. Por padrão a Central de Segurança é desabilitada quando o computador está em um domínio. Verifique esta informação!") vInfoMsg01 = (vAppName & vAppVer & vAppBuild & Chr(34) & " & vbCrLf & vbCrLf & " & Chr(34) &_ "Software de inventário escrito em VBScript unicamente com " & Chr(34) & " & vbCrLf & " & Chr(34) &_ "o intuito de facilitar o trabalho de Administradores de rede." & Chr(34) & " & vbCrLf & vbCrlf & " & Chr(34) &_ "Desenvolvedores responsáveis" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "-------------------------------------" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Artur Aragão - aragaorj@hotmail.com" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Gildo Soares - gildosoares@gmail.com" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Vinicius Canto Xavier - scripterbr@gmail.com" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Alexandre Teixeira - ateixeira@coimex.com.br" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Flávio Bordignon - flavio@triangulodosol.com.br" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Rodrigo Andrade Araujo - foxmaster@pop.com.br" & Chr(34) & " & vbCrLf & vbCrLf & " & Chr(34) &_ "Testadores" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "-------------" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Jamal Ibrahim - jamal.ibrahim@ig.com.br" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Leandro Ribeiro da Silva - leandro.silva@aebb.com.br" & Chr(34) & " & vbCrLf & vbCrlf & " & Chr(34) &_ "Versão: " & vAppVer & Chr(34) & " & vbCrLf & " & Chr(34) &_ "Build: " & vAppBuild & Chr(34) & " & vbCrLf & vbCrlf & " & Chr(34) &_ "www.technetbrasil.com.br" & Chr(34) & " & vbCrLf & " & Chr(34) &_ "2004-2007") '------------------------------------------------------------| '---[ Função - Adquirir Argumentos ]-------------------------| Sub GetArgs() strPC = "" strFmt = "" strDPlay = "" strRel = "" strDX = "" Set objArgs = WScript.Arguments For x = 0 To objArgs.Count - 1 nChar = Instr(1, objArgs(x), ":", 1) If (Trim(Ucase(Left(objArgs(x), nChar))) = "/PC:") Then strPC = Mid(objArgs(x), nChar + 1, Len(objArgs(x))) If (Trim(strPC) = "." Or IsEmpty(Trim(strPC))) Then 'On Error Resume Next ''---{ Recupera o nome do PC nos SO Win9x }-------------------------------------| 'strPC = objShell.RegRead("HKLM\System\CurrentControlSet\Services\VxD\VNETSUP\ComputerName") ''---{ Recupera o nome do PC nos SO Win2K, Win2k3, WinXP, WinVista e S.O. 64bit }--| 'strPC = objShell.RegRead("HKLM\System\CurrentControlSet\Control\ComputerName\ComputerName\ComputerName") 'On Error GoTo 0 End If If (Trim(Ucase(Left(objArgs(x), nChar))) = "/FOUT:") Then strFmt = Mid(objArgs(x), nChar + 1, Len(objArgs(x))) If (Trim(Ucase(Left(objArgs(x), nChar))) = "/VREL:") Then strDPlay = Mid(objArgs(x), nChar + 1, Len(objArgs(x))) If (Trim(Ucase(Left(objArgs(x), nChar))) = "/TREL:") Then strRel = Mid(objArgs(x), nChar + 1, Len(objArgs(x))) If (Trim(Ucase(Left(objArgs(x), nChar))) = "/SDX:") Then strDX = Mid(objArgs(x), nChar + 1, Len(objArgs(x))) Next Set objArgs = Nothing If strPC = "" AND strFmt = "" AND strDPlay = "" AND strRel = "" AND strDX = "" Then Do strPC = InputBox(vMsg01, vAppName, vPCName) If strPC = "0" Then WScript.Quit(1) Loop Until strPC <> "" AND strPC <> "." Flag = False Do strFmt = InputBox(vMsg02, vAppName) If strFmt = "0" Then WScript.Quit(1) Else If IsNumeric(strFmt) Then strDPlay = Cint(strFmt) If ((strFmt >= 1) AND (strFmt <= 5)) Then Flag = True End If End If End If Loop Until Flag = True Flag = False Do strDPlay = InputBox(vMsg03, vAppName) If strDPlay = "0" Then WScript.Quit(1) Else If IsNumeric(strDPlay) Then strDPlay = Cint(strDPlay) If ((strDPlay >= 1) AND (strDPlay <= 2)) Then Flag = True If ((strFmt < 3) AND (strDPlay = 1)) Then sDplay = True ElseIf ((strFmt = 1) AND (strDPlay = 2)) Then sDplay = False End If End If End If End If Loop Until Flag = True Flag = False Do strRel = InputBox(vMsg04, vAppName) If strRel = "0" Then WScript.Quit(1) Else If IsNumeric(strRel) Then strRel = Cint(strRel) If ((strRel >= 1) AND (strRel <= 5)) Then Flag = True End If End If End If Loop Until Flag = True Flag = False If (strFmt = 1) OR (strFmt = 2) Then Do strDX = InputBox(vMsg05, vAppName) If strDX = "0" Then WScript.Quit(1) Else If IsNumeric(strDX) Then strDX = Cint(strDX) If ((strDX >= 1) AND (strDX <= 2)) Then Flag = True End If End If End If Loop Until Flag = True Flag = False Select Case strDX Case 1: strDX = 1 Case 2: strDX = 0 End Select End If End If ExecConn() 'Set objShell = Nothing Set objNet = Nothing WScript.Quit End Sub '------------------------------------------------------------| '---[ Execução Escrita e Visualização HTML ]-----------------| Sub StartIE(byVal BodyHTML) Set objIE = WScript.CreateObject("InternetExplorer.Application", "IE_") objIE.Navigate ("about:blank") objIE.ToolBar = False objIE.MenuBar = False objIE.AddressBar = False objIE.StatusBar = True objIE.Resizable = False objIE.Width = 750 objIE.Height = 500 objIE.Left = 100 objIE.Top = 100 objIE.Visible = sDplay Do While (objIE.Busy) WScript.Sleep 100 Loop objIE.Document.Write(BodyHTML) Set objIE = Nothing End Sub '------------------------------------------------------------| '---[ Execução para conexão às informações do PC ]-----------| Sub ExecConn() On Error Resume Next Set objWMI = GetObject("winmgmts:{impersonationLevel=Impersonate, (Restore)}!\\" & strPC & "\root\cimv2") Set objReg = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strPc & "\root\default:StdRegProv") gErr() Set objAV = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & strPC & "\root\SecurityCenter") If (strRel = 1) Then wHtml = sPage() wHtml = wHtml & sSum() wHtml = wHtml & sSec() wHtml = wHtml & sProc() wHtml = wHtml & sMem() wHtml = wHtml & sMain() wHtml = wHtml & sVid() wHtml = wHtml & sMM() wHtml = wHtml & sDIn() wHtml = wHtml & sStor() wHtml = wHtml & sConn() wHtml = wHtml & sPrint() wHtml = wHtml & sGU() wHtml = wHtml & sShared() wHtml = wHtml & sAppInst() wHtml = wHtml & sProcServ() wHtml = wHtml & ePage() Elseif (strRel = 2) Then End If If (strDPlay < 4) Then StartIE(wHtml) CreateArch(wHtml) End If Set objWMI = Nothing Set objReg = Nothing Set objAV = Nothing End Sub '------------------------------------------------------------| '---[ PCeX - Sumário ]---------------------------------------| Function sSum() On Error Resume Next aLin = sWin("1", "Sumário") strProp = "*" objClass = "Win32_OperatingSystem" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems OSName = gOSRem(objItem.Caption) OSRel = objItem.Version OSSPVer = objItem.CSDVersion OSBuild = objItem.BuildNumber OSPCType = gPCType(objItem.ProductType) OSLang = gSOLang(objItem.OSLanguage) HostName = UCase(objItem.CSName) OSArch = objItem.OSArchitecture OSType = objItem.OSType OSDesc = objItem.OtherTypeDescription Select Case OSType Case 16: Select Case OSRel Case "4.00.950": OSName = "Windows 95" Case "4.00.950A": OSName = "Windows 95 SP1/OEM SR1" Case "4.00.950B": OSName = "Windows 95 OEM SR2.0/SR2.1" Case "4.00.950C": OSName = "Windows 95 OEM SR2.5" End Select Case 17: Select Case OSRel Case "4.10.1998": OSName = "Windows 98" Case "4.10.1998A": OSName = "Windows 98 SE" Case "4.10.2222": OSName = "Windows 98 SE" Case "4.10.2222A": OSName = "Windows 98 SE" Case "4.90.3000": OSName = "Windows Millennium" End Select Case 18: Select Case OSRel Case "4.0": OSName = "Microsoft Windows NT" Case "5.0": OSName = "Microsoft Windows 2000" Case "5.1.2600": OSName = OSNAme '-> Windows XP Case "5.2.3790": If InStr(OSDesc, "R2") Then OSName = Replace(OSName, "2003", "2003 R2") '-> Windows Server 2003 R2 Else OSName = OSName '-> Windows Server 2003 End If Case "6.0.6000": OSName = OSName ' Windows Vista End Select Case 36: OSName = "Linux" Case Else OSName = OSName End Select OSDate = fDateTime(objItem.LocalDateTime) OSInstDate = fDateTime(objItem.InstallDate) OSLDateBoot = fDateTime(objItem.LastBootUpTime) OSSuite = gSuite(objItem.OSProductSuite) OSCrypLevel = fBit(objItem.EncryptionLevel) OSRegUser = objItem.RegisteredUser OSRegOrg = objItem.Organization OSWin = objItem.WindowsDirectory OSSys = objItem.SystemDirectory OSSerialNum = objItem.SerialNumber OSFreePhys = objItem.FreePhysicalMemory OsTotalPhys = objItem.TotalVisibleMemorySize OSFreePagFil = objItem.FreeSpaceInPagingFiles OSFreeVirtual = objItem.FreeVirtualMemory OsTotalVirtual = objItem.TotalVirtualMemorySize OSSPnVer = objItem.ServicePackMajorVersion Next strProp = "*" objClass = "Win32_Processor" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iCPU = iCPU + 1 CPUID = iCPU CPUName = objItem.Name CPUMaxVal = fClock(objItem.MaxClockSpeed) CPURes = CPUID & "- " & CPUName & " (" & CPUMaxVal & ")" Next strProp = "Manufacturer" objClass = "Win32_BaseBoard" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems MBFab = objItem.Manufacturer Next strProp = "*" objClass = "Win32_VideoController" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE DeviceID = 'VideoController1'" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems SVGAName = objItem.Name Next If InStr(SVGAName, "logmein") OR InStr(SVGAName, "vnc") Then SVGAName = "" Else SVGAName = SVGAName End If strProp = "UserName, TotalPhysicalMemory, DomainRole, Model, SystemType, Domain, NumberOfProcessors" objClass = "Win32_ComputerSystem" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems UserLogin = LCase(objItem.UserName) SysMem = fMem(objItem.TotalPhysicalMemory) SysType = gDRole(objItem.DomainRole) MBModel = objItem.Model PCType = objItem.SystemType SysDom = objItem.Domain CWinFw = objItem.DomainRole nCPU = objItem.NumberOfProcessors If IsNull(UserLogin) Then UserLogin = "Não há usuário logado." End If Next 'WScript.Echo CWinFw strKey = "Software\Microsoft\Windows NT\CurrentVersion\WinLogon" strValName = "DefaultUserName" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal ProfName = strVal End If strValName = "DefaultDomainName" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal ProfLLogon = strVal ProfUser = ProfLLogon & "\" & ProfName End If Select Case OSType Case 16: strKey = "Software\Microsoft\Windows\CurrentVersion" Case 17: strKey = "Software\Microsoft\Windows\CurrentVersion" Case 18: strKey = "Software\Microsoft\Windows NT\CurrentVersion" Case Else strKey = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion" End Select strValName = "DigitalProductId" If gKReg(strKey, strValName) Then objReg.GetBinaryValue HKLM, strKey, strValName, dwVal OSKey = gKey(dwVal) End If strKey = "System\CurrentControlSet\Control\TimeZoneInformation" strValName = "DisableAutoDaylightTimeSet" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal DayLTSet = dwVal End If DayLTSet = gHVerao(strFmt, gDayLTSet(DayLTSet)) strKey = "Software\Microsoft\Internet Explorer" strValName = "Version" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal IEVers = strVal End If If OSBuild >= 6000 Then strKey = "Software\Microsoft\Windows Mail" strValName = "MediaVer" strOptName = "Windows Mail" Else strKey = "Software\Microsoft\Outlook Express\Version Info" strValName = "Current" strOptName = "Outlook Express" End If If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal MailVers = Replace(strVal, ",", ".") End If strKey = "Software\Microsoft\DirectX" strValName = "Version" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal DXVers = strVal End If DXVers = gDX(DXVers) strKey = "Software\Microsoft\MediaPlayer\PlayerUpgrade" strValName = "PlayerVersion" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal WMPVers = Replace(strVal, ",", ".") End If strKey = "Software\Microsoft\DataAccess" strValName = "Version" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal MDACVers = strVal End If strKey = "Software\Microsoft\InetStp" strValName = "VersionString" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal IISWeb = Replace(strVal, "Version", "") End If Select Case PCType Case "x64-based PC": strKey = "Software\Wow6432Node\JavaSoft\Java Web Start" Case Else strKey = "Software\JavaSoft\Java Web Start" End Select strValName = "CurrentVersion" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal SunVM = Replace(strVal, "_", ".") End If aLin = aLin & aLine0("linestyle0", "", "600", "Usuário logado:", UserLogin, "", "", "") aLin = aLin & aLine0("linestyle1", "", "340", "Edição do Windows:", OSName, "259", "Release:", OSRel) aLin = aLin & aLine0("linestyle1", "", "340", "Service Pack:", OSSPVer, "259", "Build:", OSBuild) aLin = aLin & aLine0("linestyle1", "", "340", "Função:", OSPCType, "259", "Idioma:", OSLang) aLin = aLin & aLine0("linestyle1", "", "340", "Processador:", CPURes, "259", "Nome do PC:", HostName) aLin = aLin & aLine0("linestyle1", "", "340", "Memória:", SysMem, "259", "Fabricante:", MBFab) aLin = aLin & aLine0("linestyle1", "", "340", "Adaptador Gráfico:", SVGAName, "259", "Modelo:", MBModel) aLin = aLin & sLine0("linestyle1", "  ") aLin = aLin & dLine0("divcenter1", "Mais informações do Sistema") aLin = aLin & dLine0("divcenter2", "Configurações do Sistema") aLin = aLin & aLine0("", fColor, "300", "Último Logon:", ProfUser, "299", "Suíte:", OSSuite) aLin = aLin & aLine0("", fColor, "300", "Horário Atual:", OSDate, "299", "Data Instalação:", OSInstDate) aLin = aLin & aLine0("", fColor, "300", "Último Boot:", OSLDateBoot, "299", "Criptografia:", OSCrypLevel) aLin = aLin & aLine0("", fColor, "300", "Usuário Registrado:", OSRegUser, "299", "Organiz. Registrada:", OSRegOrg) aLin = aLin & aLine0("", fColor, "300", "Diretório do Windows:", OSWin, "299", "Diretório de Sistema:", OSSys) aLin = aLin & aLine0("", fColor, "300", "Número Serial:", OSSerialNum, "299", "Chave Digital:", OSKey) aLin = aLin & aLine0("", fColor, "300", "Horário de Verão:", DayLTSet, "299", "Tipo de Computador:", SysType) aLin = aLin & aLine0("", fColor, "300", "Arquitetura do Hardware:", PCType, "299", "Arquitetura do Sistema:", OSArch) aLin = aLin & aLine0("", fColor, "300", "Internet Explorer:", IEVers, "299", strOptName & ":", MailVers) aLin = aLin & aLine0("", fColor, "300", "DirectX:", DXVers, "299", "Windows Media Player:", WMPVers) aLin = aLin & aLine0("", fColor, "300", "MDAC:", MDACVers, "299", "Internet Information Services:", IISWeb) aLin = aLin & aLine0("", fColor, "600", "Sun Java VM:", SunVM, "", "", "") aLin = aLin & sLine0("linestyle2", "  ") aLin = aLin & dLine0("divup2", "Informações de Conectividade") aLin = aLin & dLine0("divcenter2", "Configurações da Rede") strProp = "Description, IPAddress, MACAddress, IPSubnet, DHCPEnabled, DefaultIPGateway, DHCPServer, DNSServerSearchOrder, WINSPrimaryServer, WINSSecondaryServer, ServiceName, IPEnabled" objClass = "Win32_NetworkAdapterConfiguration" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE IPEnabled = 'True' AND ServiceName <> 'AsyncMac' AND ServiceName <> 'VMnetx' AND ServiceName <> 'VMnetadapter' AND ServiceName <> 'Rasl2tp' AND ServiceName <> 'Raspti' AND ServiceName <> 'NdisWan' AND ServiceName <> 'NdisWan4' AND ServiceName <> 'RasPppoe' AND ServiceName <> 'NdisIP' AND ServiceName <> 'vnet' AND ServiceName <> '' AND Description <> 'PPP Adapter.' AND ServiceName <> 'PptpMiniport'" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems LanName = objItem.Description LanIP = Replace(Join(objItem.IPAddress, ","), "0.0.0.0", "") LanMac = objItem.MACAddress LanMasc = Join(objItem.IPSubnet, ",") LanDHCP = gDHCP(strFmt, objItem.DHCPEnabled) LanGateway = objItem.DefaultIPGateway LanDHCPSrv = objItem.DHCPServer LanDNSSrv = objItem.DNSServerSearchOrder LanWINSSrv1 = objItem.WINSPrimaryServer LanWINSSrv2 = objItem.WINSSecondaryServer Next If IsNull(LanName) Then aLin = aLin & vNull(fColor, 2) Else aLin = aLin & aLine0("", fColor, "600", "Dispositivo de Rede (Lan):", LanName, "", "", "") aLin = aLin & aLine0("", fColor, "300", "Endereço IP:", LanIP, "299", "Endereço MAC:", LanMac) aLin = aLin & aLine0("", fColor, "300", "Máscara:", LanMasc, "299", "DHCP:", LanDHCP) aLin = aLin & aLine0("", fColor, "600", "Gateway padrão:", LanGateway, "", "", "") aLin = aLin & aLine0("", fColor, "300", "Nome do domínio:", SysDom, "299", "Servidor DHCP:", LanDHCPSrv) End If For i = 0 To UBound(LanDNSSrv) iDns = iDns + 1 aLin = aLin & aLine0("", fColor, "600", "Servidor DNS " & iDns & ":", LanDNSSrv(i), "", "", "") Next aLin = aLin & aLine0("", fColor, "300", "Servidor WINS Primário:", LanWINSSrv1, "299", "Servidor WINS Secundário:", LanWINSSrv2) aLin = aLin & eWin(1) sSum = aLin End Function '------------------------------------------------------------| '---[ PCeX - Central de Segurança ]--------------------------| Function sSec() On Error Resume Next aLin = sWin("2", "Central de Segurança") aLin = aLin & dLine0("divup1", "Segurança do seu PC") Dim SCDispName, SCStatus strProp = "DisplayName, State" objClass = "Win32_Service" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE DisplayName = 'Security Center'" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems SCDispName = objItem.DisplayName SCStatus = objItem.State Next If (((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild = 3790) AND (OSSPnVer >= 1)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0))) Then If SCStatus = "Stopped" Then aLin = aLin & AlertSys(1) End If aLin = aLin & dLine0("divup2", "Proteção contra Malware") strProp = "DisplayName, VersionNumber, CompanyName, OnAccessScanningEnabled, ProductUptoDate" objClass = "AntiVirusProduct" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objAV.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems AVName = objItem.DisplayName AVVers = objItem.VersionNumber AVFab = objItem.CompanyName AVScanRTime = objItem.OnAccessScanningEnabled AVProdUpd = objItem.ProductUptoDate Next If ((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0)) Then If AVName = "" AND AVVers = "" AND AVFab = "" AND AVScanRTime = False AND AVProdUpd = "" Then AVSup = "Desativado ou não suportado." Else AVSup = "Sim" End If Select Case AVScanRTime Case True: AVScanRTime = "Ativado" Case Else AVScanRTime = "Desativado" End Select Select Case AVProdUpd Case True: AVProdUpd = "OK" Case Else AVProdUpd = "Desatualizadas" End Select Else AVSup = "Não suportado" AVScanRTime = "Não identificável" AVProdUpd = "Não identificável" End If AVSup = gAv(strFmt, AVSup) AVScanRTime = gAv(strFmt, AVScanRTime) AVProdUpd = gAv(strFmt, AVProdUpd) aLin = aLin & dLine0("divcenter2", "Antivírus") If ((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0))Then aLin = aLin & aLine0("", fColor, "300", "Antivírus:", AVName, "299", "Suportado pelo Sistema:", AVSup) aLin = aLin & aLine0("", fColor, "300", "Versão do Antivírus:", AVVers, "299", "Fabricante:", AVFab) aLin = aLin & aLine0("", fColor, "300", "Realtime File Scan:", AVScanRTime, "299", "Definições de Vírus:", AVProdUpd) Else aLin = aLin & vNull(fColor, 1) End If aLin = aLin & dLine0("linestyle2", "  ") aLin = aLin & dLine0("divcenter2", "AntiSpyware") strKey = "Software\Microsoft\Windows Defender" If gPReg(HKLM, strKey) Then Select Case PCType Case "x64-based PC": Case Else strKey = "Software\Microsoft\Windows\CurrentVersion\Uninstall\{A06275F4-324B-4E85-95E6-87B2CD729401}" End Select strValName = "DisplayName" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal AppInst = strVal End If strValName = "DisplayVersion" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal AppVer = strVal End If strValName = "Publisher" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal AppVend = strVal End If WDInst = True WDName = AppInst strKey = "Software\Microsoft\Windows Defender" strValName = "DisableAntiSpyware" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal WDOn = dwVal End If WDOn = gWDOn(strFmt, WDOn) strValName = "ProductUpdateAvailable" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal WDUpdt = dwVal Select Case WDUpdt Case False: WDUpdt = "OK" Case Else WDUpdt = "Desatualizadas" End Select End If WDUpdt = gAv(strFmt, WDUpdt) strKey = "Software\Microsoft\Windows Defender\Signature Updates" strValName = "EngineVersion" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal WDEngine = strVal End If strValName = "ASSignatureVersion" If gKReg(strKey, strValName) Then objReg.GetStringValue HKLM, strKey, strValName, strVal WDSign = strVal End If strKey = "Software\Microsoft\Windows Defender\Real-Time Protection" strValName = "DisableAntiSpywareRealtimeProtection" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal WDRTOn = dwVal End If WDRTOn = gWDOn(strFmt, WDRTOn) End If If AppInst <> "" Then aLin = aLin & aLine0("", fColor, "300", "AntiSpyware:", WDName, "299", "Estatus:", WDOn) aLin = aLin & aLine0("", fColor, "300", "Versão do AntiSpyware:", AppVer, "299", "Fabricante:", AppVend) aLin = aLin & aLine0("", fColor, "300", "Versão da Engine:", WDEngine, "299", "Versão das Definições:", WDSign) aLin = aLin & aLine0("", fColor, "300", "RealTime File Scan:", WDRTOn, "299", "Definições:", WDUpdt) Else aLin = aLin & vNull(fColor, 1) End If aLin = aLin & dLine0("linestyle2", "  ") aLin = aLin & dLine0("divup2", "Atualização Automática") aLin = aLin & dLine0("divcenter2", "Windows Update") strKey = "Software\Policies\Microsoft\Windows\WindowsUpdate\AU" strValName = "AUOptions" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal AUOpt = gAUOpt(strFmt, dwVal) If dwVal = 4 Then strKey = "Software\Policies\Microsoft\Windows\WindowsUpdate\AU" strValName = "ScheduledInstallDay" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal AUSchedInstDay = gAUDay(dwVal) Else AUSchedInstDay = "Não configurado" End If strKey = "Software\Policies\Microsoft\Windows\WindowsUpdate\AU" strValName = "ScheduledInstallTime" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal AUSchedInstTime = dwVal & ":00h" Else AUSchedInstTime = "Não configurado" End If Else AUOpt = AUOpt End If Else strKey = "Software\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update" strValName = "AUOptions" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal AUOpt = gAUOpt(strFmt, dwVal) If dwVal = 4 Then strKey = "Software\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update" strValName = "ScheduledInstallDay" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal AUSchedInstDay = gAUDay(dwVal) Else AUSchedInstDay = "Não configurado" End If strKey = "Software\Microsoft\Windows\CurrentVersion\WindowsUpdate\Auto Update" strValName = "ScheduledInstallTime" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal AUSchedInstTime = dwVal & ":00h" Else AUSchedInstTime = "Não configurado" End If End If Else AUOpt = "Não configurado" End If End If If ((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild = 3790) AND (OSSPnVer >= 1)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0))Then aLin = aLin & aLine0("", fColor, "600", "Serviço:", AUOpt, "", "", "") aLin = aLin & aLine0("", fColor, "300", "Instalação:", AUSchedInstDay, "299", "Horário:", AUSchedInstTime) Else aLin = aLin & vNull(fColor, 1) End If aLin = aLin & dLine0("linestyle2", "  ") aLin = aLin & dLine0("divup2", "Firewall") aLin = aLin & dLine0("divcenter2", "Windows Firewall") If ((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild = 3790) AND (OSSPnVer >= 1)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0)) Then If CWinFw = 0 OR CWinFw = 2 Then strKey = "System\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\StandardProfile" Else strKey = "System\CurrentControlSet\Services\SharedAccess\Parameters\FirewallPolicy\DomainProfile" End If strValName = "EnableFirewall" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal FwOn = dwVal End If FwOn = gWinFw(strFmt, FwOn) strValName = "DoNotAllowExceptions" If gKReg(strKey, strValName) Then objReg.GetDWORDValue HKLM, strKey, strValName, dwVal FwNAllow = dwVal End If FwNAllow = gWinFw(strFmt, FwNAllow) aLin = aLin & aLine0("", fColor, "300", "Windows Firewall:", FwOn, "299", "Sem Exceções:", FwNAllow) Else aLin = aLin & vNull(fColor, 1) End If aLin = aLin & dLine0("linestyle2", "  ") Else aLin = aLin & AlertSys(2) End If aLin = aLin & dLine0("divup2", "Outras Configurações de Segurança") aLin = aLin & dLine0("divcenter2", "Hardware - DEP/NX/EDB") strProp = "DataExecutionPrevention_Available, DataExecutionPrevention_32BitApplications, DataExecutionPrevention_Drivers" objClass = "Win32_OperatingSystem" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems AVDEPHard = objItem.DataExecutionPrevention_Available AVDEP32xApp = objItem.DataExecutionPrevention_32BitApplications AVDEPDrv = objItem.DataExecutionPrevention_Drivers If ((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild = 3790) AND (OSSPnVer >= 1)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0))Then AVDEPSup = "Sim" Else AVDEPSup = "Não" End If Select Case AVDEPHard Case True: AVDEPHard = "Sim" Case Else AVDEPHard = "Não" End Select Select Case AVDEP32xApp Case True: AVDEP32xApp = "Ativa" Case Else AVDEP32xApp = "Desativada" End Select Select Case AVDEPDrv Case True: AVDEPDrv = "Ativa" Case Else AVDEPDrv = "Desativada" End Select AVDEPSup = gAv(strFmt, AVDEPSup) AVDEPHard = gAv(strFmt, AVDEPHard) AVDEP32xApp = gAv(strFmt, AVDEP32xApp) AVDEPDrv = gAv(strFmt, AVDEPDrv) If ((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild = 3790) AND (OSSPnVer >= 1)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0)) Then aLin = aLin & aLine0("", fColor, "300", "Suporte do Sistema Operacional:", AVDEPSup, "299", "Suportado pelo Processador:", AVDEPHard) aLin = aLin & aLine0("", fColor, "300", "Proteção em Aplicativos:", AVDEP32xApp, "299", "Proteção em Drivers:", AVDEPDrv) Else aLin = aLin & vNull(fColor, 1) End If Next aLin = aLin & eWin(1) sSec = aLin End Function '------------------------------------------------------------| '---[ PCeX - Processador ]-----------------------------------| Function sProc() Dim NumOfCores, NumOfLogProc On Error Resume Next aLin = sWin("3", "Processador") aLin = aLin & dLine0("divup1", nCPU & " Processador(es)") aLin = aLin & dLine0("divup2", "Informações gerais sobre o(s) Processador(es)") iCPU = 0 strProp = "*" objClass = "Win32_Processor" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iCPU = iCPU + 1 CPUID = objItem.DeviceID CPUName = objItem.Name CPUFam = gCPUFam(objItem.Family) CPUCurClock = objItem.CurrentClockSpeed CPUMaxClock = objItem.MaxClockSpeed If (CPUMaxClock < 1000) Then CPUCurClock = fClock(objItem.CurrentClockSpeed) CPUMaxClock = fClock(objItem.MaxClockSpeed) Else CPUCurClock = fClock(objItem.CurrentClockSpeed) & " (" & objItem.CurrentClockSpeed & " MHz)" CPUMaxClock = fClock(objItem.MaxClockSpeed) & " (" & objItem.MaxClockSpeed & " MHz)" End If NumOfCores = objItem.NumberOfCores NumOfLogProc = objItem.NumberOfLogicalProcessors CPULP1 = gCPUPerc(objItem.LoadPercentage) CPULP2 = gCPUGraph(strDX, objItem.LoadPercentage) CPUMCID = objItem.ProcessorId CPUAddress = fBit(objItem.AddressWidth) CPUAval = fCPUAval(objItem.Availability) CPUVer = objItem.Version CPURev = objItem.Revision CPUStep = objItem.Stepping CPUPMan = fCPUMan(objItem.PowerManagementSupported) CPUVolt = fCPUVolt(objItem.CurrentVoltage) CPUSocket = objItem.SocketDesignation CPUExtClock = fClock(objItem.ExtClock) CPUFab = fCPUFab(objItem.Manufacturer) CPUInfo = objItem.Description Set colItems = objWMI.ExecQuery("ASSOCIATORS OF {Win32_Processor.DeviceID=""" & CPUID & """} WHERE AssocClass = " & "Win32_AssociatedProcessorMemory") For Each objItem1 in colItems AssCacheID = objItem1.DeviceID strProp = "*" objClass = "Win32_CacheMemory" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE DeviceID = '" & AssCacheID & "'" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem2 in colItems iCache = iCache + 1 CPUCacheLevel = objItem2.Level CPUCacheSize = objItem2.InstalledSize Select Case CPUCacheLevel Case 3: CPUL1Cache = CPUCacheSize & " Kb" Case 4: CPUL2Cache = CPUCacheSize & " Kb" Case 5: CPUL3Cache = CPUCacheSize & " Kb" End Select Next Next aLin = aLin & dLine0("divcenter2", "CPU - " & iCPU & "/" & nCPU) aLin = aLin & aLine0("", fColor, "300", "Processador:", CPUName, "299", "Família da CPU:", CPUFam) aLin = aLin & aLine0("", fColor, "300", "Freq. Atual da CPU:", CPUCurClock, "299", "Freq. Orig. da CPU:", CPUMaxClock) If ((OSBuild = 2600) AND (OSSPnVer >= 2)) OR ((OSBuild = 3790) AND (OSSPnVer >= 1)) OR ((OSBuild >= 6000) AND (OSSPnVer >= 0)) Then aLin = aLin & aLine0("", fColor, "300", "Nº de Cores por Processador:", NumOfCores, "299", "Nº de Processadores Lógicos:", NumOfLogProc) End If aLin = aLin & aLine1("", fColor, "300", "Uso da CPU:", CPULP1, CPULP2, "299", "Id. da CPU:", CPUMCID) aLin = aLin & aLine0("", fColor, "300", "Ender. da CPU:", CPUAddress, "299", "Status da CPU:", CPUAval) aLin = aLin & aLine0("", fColor, "300", "Versão:", CPUVer, "299", "Revisão:", CPURev) aLin = aLin & aLine0("", fColor, "300", "Stepping:", CPUStep, "299", "Power Management:", CPUPMan) aLin = aLin & aLine0("", fColor, "300", "Voltagem da CPU:", CPUVolt, "299", "Socket:", CPUSocket) aLin = aLin & aLine0("", fColor, "300", "Cache L1:", CPUL1Cache, "299", "Cache L2:", CPUL2Cache) aLin = aLin & aLine0("", fColor, "300", "Cache L3:", CPUL3Cache, "299", "Front Side Bus:", CPUExtClock) aLin = aLin & aLine0("", fColor, "300", "Fabricante:", CPUFab, "299", "Descrição da CPU:", CPUInfo) aLin = aLin & dLine0("linestyle2", "  ") Next aLin = aLin & eWin(2) sProc = aLin End Function '------------------------------------------------------------| '---[ PCeX - Memória ]---------------------------------------| Function sMem() On Error Resume Next aLin = sWin("4", "Memória do Sistema") aLin = aLin & dLine0("divup1", "Memórias Física, Paginada e Virtual") aLin = aLin & dLine1("divup2", "107", "Tipo", "200", "Em uso (%)", "153", "Livre", "145", "Total") Dim MemTotalPage, MemUsedPhys, MemUsedPageFile, MemUsedVM, MemFreePhys, MemFreePageFile, MemFreeVM, MemPercUsedPhys, MemPercUsedPageFile, MemPercUsedVM, MemGraphUsedPhys, MemGraphUsedPageFile, MemGraphUsedVM, MemTotalPhys, MemTotalPageFile, MemTotalVM strProp = "AllocatedBaseSize" objClass = "Win32_PageFileUsage" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems MemTotalPage = (objItem.AllocatedBaseSize * 1024) MemUsedPhys = fMemSys((OsTotalPhys - OSFreePhys)) MemUsedPageFile = fMemSys((MemTotalPage - OSFreePagFil)) MemUsedVM = fMemSys((OsTotalVirtual - OSFreeVirtual)) MemFreePhys = fMemSys(OSFreePhys) MemFreePageFile = fMemSys(OSFreePagFil) MemFreeVM = fMemSys(OSFreeVirtual) MemTotalPhys = fMemSys(OsTotalPhys) MemTotalPageFile = fMemSys(MemTotalPage) MemTotalVM = fMemSys(OsTotalVirtual) MemPercUsedPhys = FormatPercent((OsTotalPhys - OSFreePhys) / OsTotalPhys, 0) MemPercUsedPageFile = FormatPercent((MemTotalPage - OSFreePagFil) / MemTotalPage, 0) MemPercUsedVM = FormatPercent((OsTotalVirtual - OSFreeVirtual) / OsTotalVirtual, 0) MemGraphUsedPhys = gMemGraph(strDX, Replace(MemPercUsedPhys, "%", "")) MemGraphUsedPageFile = gMemGraph(strDX, Replace(MemPercUsedPageFile, "%", "")) MemGraphUsedVM = gMemGraph(strDX, Replace(MemPercUsedVM, "%", "")) Next aLin = aLin & aLine2("", fColor, "100", "Memória Física:", "27", MemPercUsedPhys, "157", MemGraphUsedPhys, "145", MemFreePhys, "145", MemTotalPhys) aLin = aLin & aLine2("", fColor, "100", "Memória Paginada:", "27", MemPercUsedPageFile, "157", MemGraphUsedPageFile, "145", MemFreePageFile, "145", MemTotalPageFile) aLin = aLin & aLine2("", fColor, "100", "Memória Virtual:", "27", MemPercUsedVM, "157", MemGraphUsedVM, "145", MemFreeVM, "145", MemTotalVM) aLin = aLin & eWin(1) sMem = aLin End Function '------------------------------------------------------------| '---[ PCeX - Placa-Mãe ]-------------------------------------| Function sMain() On Error Resume Next aLin = sWin("5", "Placa-Mãe") aLin = aLin & dLine0("divup1", "Informações da Placa-Mãe e seus Componentes") aLin = aLin & dLine0("divup2", "Placa-Mãe") strProp = "*" objClass = "Win32_BaseBoard" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iMainb = iMainb + 1 MainbProd = objItem.Product MainFab = objItem.Manufacturer MainSN = objItem.SerialNumber MainPN = objItem.PartNumber MainVer = objItem.Version MainOtherInfo = objItem.OtherIdentifyingInfo Next If Not IsNull(iMainb) Then aLin = aLin & aLine0("", fColor, "300", "Placa-Mãe:", MainbProd, "299", "Modelo:", MBModel) aLin = aLin & aLine0("", fColor, "300", "Fabricante:", MainFab, "299", "Número Serial:", MainSN) aLin = aLin & aLine0("", fColor, "300", "Part Number:", MainPN, "299", "Versão:", MainVer) aLin = aLin & aLine0("", fColor, "600", "Outras informações:", MainOtherInfo, "", "", "") Else aLin = aLin & vNull(fColor, 2) End If aLin = aLin & dLine0("linestyle2", "  ") aLin = aLin & dLine0("divup2", "Bios") strProp = "*" objClass = "Win32_BIOS" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iBios = iBios + 1 BiosName = objItem.Name BiosFab = objItem.Manufacturer BiosBuild = objItem.BuildNumber BiosLang = objItem.CurrentLanguage BiosRelDate = fDateTime(objItem.ReleaseDate) BiosSN = objItem.SerialNumber BiosSMBiosVer = objItem.SMBIOSBIOSVersion BiosVer = objItem.Version If Not IsNull(iBios) Then aLin = aLin & aLine0("", fColor, "300", "Nome do Bios:", BiosName, "299", "Fabricante:", BiosFab) aLin = aLin & aLine0("", fColor, "300", "Bios Build:", BiosBuild, "299", "Idioma do Bios:", BiosLang) aLin = aLin & aLine0("", fColor, "300", "Data do Bios:", BiosRelDate, "299", "Número Serial:", BiosSN) aLin = aLin & aLine0("", fColor, "300", "Versão SMBIOS:", BiosSMBiosVer, "299", "Versão do bios:", BiosVer) Else aLin = aLin & vNull(fColor, 2) End If aLin = aLin & dLine0("linestyle2", "  ") Next aLin = aLin & dLine0("divup2", "Slots - Memória Ram") strProp = "*" objClass = "Win32_PhysicalMemory" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE MemoryType <> 0 AND MemoryType <> 1 AND MemoryType <> 10 AND MemoryType <> 11 AND FormFactor = 0 OR FormFactor = 6 OR FormFactor = 7 OR FormFactor = 8 OR FormFactor = 11 OR FormFactor = 12 OR FormFactor = 13" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iMem = iMem + 1 Next strProp = "*" objClass = "Win32_PhysicalMemoryArray" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iSMem = iSMem + 1 SMemUnits = objItem.MemoryDevices Exit For Next SMemFree = SMemUnits - iMem If SMemUnits <> SMemFree Then aLin = aLin & aLine0("linestyle3", "fColor", "300", "Nº de Slots de Memória:", SMemUnits, "299", "Nº de Slots de Memória livres:", SMemFree) End If strProp = "*" objClass = "Win32_PhysicalMemory" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE MemoryType <> 0 AND MemoryType <> 1 AND MemoryType <> 10 AND MemoryType <> 11 AND FormFactor = 0 OR FormFactor = 6 OR FormFactor = 7 OR FormFactor = 8 OR FormFactor = 11 OR FormFactor = 12 OR FormFactor = 13" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iMem = iMem + 1 MemBank = objItem.BankLabel MemDevLoc = objItem.DeviceLocator MemSize = fMem(objItem.Capacity) MemBits = fBit(objItem.DataWidth) MemFFactor = gMemFFactor(objItem.FormFactor) MemType = gMemType(objItem.MemoryType) MemFab = objItem.Manufacturer MemSpeed = fClock(objItem.Speed) aLin = aLin & aLine0("", fColor, "300", MemBank & " - " & MemDevLoc & ":", MemSize, "299", "Endereçamento:", MemBits) aLin = aLin & aLine0("", fColor, "300", "Tipo do Módulo:", MemFFactor, "299", "Tipo de Memória:", MemType) aLin = aLin & aLine0("", fColor, "300", "Fabricante:", MemFab, "299", "Freq. da Memória:", MemSpeed) aLin = aLin & dLine0("linestyle2", "  ") Next If iMem = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Slots - AGP/PCI/PCI-EXPRESS/ISA/AMR/CNR/OUTROS") strProp = "*" objClass = "Win32_SystemSlot" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iSlot = iSlot + 1 SlotID = gSlotID(objItem.Tag) SlotType = gSlotType(Join(objItem.ConnectorType, ",")) SlotDesign = objItem.SlotDesignation SlotBitSize = gSlotBit(objItem.MaxDataWidth) SlotTypeID = SlotDesign & " (" & SlotType & " " & SlotBitSize & ")" SlotStatus = gSlotStatus(strFmt, objItem.CurrentUsage) aLin = aLin & aLine0("", fColor, "300", "Slot " & SlotID & ":", SlotTypeID, "299", "Status:", SlotStatus) Next If iSlot = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") Else aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Controladoras - IDE/SATA") strProp = "*" objClass = "Win32_IDEController" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iIDE = iIDE + 1 IDEID = objItem.Name IDEFab = objItem.Manufacturer aLin = aLin & aLine0("", fColor, "300", "Controladora:", IDEID, "299", "Fabricante:", IDEFab) aLin = aLin & dLine0("linestyle2", "  ") Next If iIDE = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Controladoras - SCSI/SAS") strProp = "*" objClass = "Win32_SCSIController" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iSCSI = iIDE + 1 SCSIID = objItem.Name SCSIFab = objItem.Manufacturer aLin = aLin & aLine0("", fColor, "300", "Controladora:", SCSIID, "299", "Fabricante:", SCSIFab) aLin = aLin & dLine0("linestyle2", "  ") Next If iSCSI = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Dispositivos On-Board") strProp = "*" objClass = "Win32_OnBoardDevice" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iOnB = iOnB + 1 OnBDevID = objItem.Description OnBDevType = gOnBDevType(objItem.DeviceType) OnBDevOn = gOnBDevOn(strFmt, objItem.Enabled) aLin = aLin & aLine0("", fColor, "300", "Dispositivo:", OnBDevID, "299", "Tipo:", OnBDevType) aLin = aLin & aLine0("", fColor, "600", "Status:", OnBDevOn, "", "", "") aLin = aLin & dLine0("linestyle2", "  ") Next If iOnB = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Dispositivos USB") strProp = "*" objClass = "Win32_USBController" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iUSB = iUSB + 1 USBName = objItem.Name USBID = objItem.DeviceID aLin = aLin & dLine0("divcenter2", USBName) strProp = "*" objClass = "Win32_USBControllerDevice" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem1 in colItems iUSBDev = iUSBDev + 1 strDevName1 = objItem1.Antecedent strQuotes = Chr(34) strDevName1 = Replace(strDevName1, strQuotes, "") arrDevNames1 = Split(strDevName1, "=") strDevName1 = Replace(arrDevNames1(1), "\\", "\") strDevName2 = objItem1.Dependent strQuotes = Chr(34) strDevName2 = Replace(strDevName2, strQuotes, "") arrDevNames2 = Split(strDevName2, "=") strDevName2 = arrDevNames2(1) If strDevName1 = USBID Then Set colItems = objWMI.ExecQuery("SELECT Caption, DeviceID, Description FROM Win32_PnPEntity WHERE DeviceID = '" & strDevName2 & "'") For Each objItem2 in colItems USBDevName = objItem2.Caption USBDevDesc = objItem2.Description If USBDevDesc <> "USB Root Hub" AND USBDevDesc <> "Generic USB Hub" AND USBDevDesc <> "Generic volume" AND USBDevDesc <> "Volume genérico" AND USBDevDesc <> "USB Mass Storage Device" AND USBDevDesc <> "HID-compliant device" AND USBDevDesc <> "USB Human Interface Device" AND USBDevDesc <> "Dispositivo de interface humana USB" AND USBDevDesc <> "HID Keyboard Device" AND USBDevDesc <> "Dispositivo de teclado HID" AND USBDevDesc <> "USB Composite Device" AND USBDevDesc <> "HID-compliant consumer control device" AND USBDevDesc <> "USB Mass Storage Device" AND USBDevDesc <> "USB Printing Support" AND USBDevDesc <> "IEEE 1284.4 compatible printer" Then aLin = aLin & aLine0("", fColor, "600", "¬>", USBDevName, "", "", "") End If Next End If Next aLin = aLin & dLine0("linestyle2", "  ") Next If iUSB = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Hardware Desativado ou Instalado incorretamente") strProp = "*" objClass = "Win32_PnPEntity" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE ConfigManagerErrorCode <> '0'" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iHnID = iHnID + 1 HnIDName = objItem.Name HnIDFab = objItem.Manufacturer HnIDDesc = objItem.Description aLin = aLin & dLine0("divcenter2", HnIDName) aLin = aLin & aLine0("", fColor, "300", "Fabricante:", HnIDFab, "299", "Descrição:", HnIDDesc) aLin = aLin & dLine0("linestyle2", "  ") Next If iHnID = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sMain = aLin End Function '------------------------------------------------------------| '---[ PCeX - Placa de Vídeo e Monitor ]----------------------| Function sVid() On Error Resume Next aLin = sWin("6", "Vídeo") aLin = aLin & dLine0("divup1", "Informações Sobre Vídeo e Monitor") aLin = aLin & dLine0("divup2", "Adaptador(es) de Vídeo") strProp = "*" objClass = "Win32_VideoController" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iSVGA = iSVGA + 1 SVGADevID = iSVGA SVGAName = objItem.Name SVGAGPU = objItem.VideoProcessor SVGARam = fMem(objItem.AdapterRAM) SVGABitPix = fBit(objItem.CurrentBitsPerPixel) SVGAResH = objItem.CurrentHorizontalResolution SVGAResV = objItem.CurrentVerticalResolution SVGARefrRCurr = objItem.CurrentRefreshRate SVGARefrRMin = objItem.MinRefreshRate SVGARefrRMax = objItem.MaxRefreshRate SVGADrvVers = objItem.DriverVersion SVGADrvDate = fDateTime(objItem.DriverDate) If Not IsNull(Trim(SVGAName)) AND (SVGARefrRCurr > 0) AND Not IsNull(Trim(SVGARefrRMin)) AND Not IsNull(Trim(SVGARefrRMax)) Then SVGARefrRate = fHz(SVGARefrRCurr) & " (" & fHz(SVGARefrRMin) & " ~ " & fHz(SVGARefrRMax) & ")" Else SVGARefrRate = "" End If If Not IsNull(Trim(SVGAName)) AND (SVGAResH > 0) AND (SVGAResV > 0) Then SVGARes = SVGAResH & " x " & SVGAResV & ", " & SVGABitPix & " por Pixel" Else SVGARes = "" End If aLin = aLin & dLine0("divcenter2", SVGADevID & "º Adaptador de Vídeo") aLin = aLin & aLine0("", fColor, "600", "Dispositivo:", SVGAName, "", "", "") aLin = aLin & aLine0("", fColor, "300", "GPU:", SVGAGPU, "299", "Memória de vídeo:", SVGARam) aLin = aLin & aLine0("", fColor, "300", "Resolução de vídeo:", SVGARes, "299", "Taxa de atualização:", SVGARefrRate) aLin = aLin & aLine0("", fColor, "300", "Versão do driver:", SVGADrvVers, "299", "Data do Driver:", SVGADrvDate) aLin = aLin & dLine0("linestyle2", "  ") Next If iSVGA = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Monitor(es)") strProp = "DeviceID, Name, MonitorManufacturer, MonitorType" objClass = "Win32_DesktopMonitor" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iMon = iMon + 1 MonID = iMon MonName = objItem.Name MonFab = objItem.MonitorManufacturer aLin = aLin & dLine0("divcenter2", MonID & "º Monitor") aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", MonName, "299", "Fabricante:", MonFab) aLin = aLin & dLine0("linestyle2", "  ") Next If iMon = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sVid = aLin End Function '------------------------------------------------------------| '---[ PCeX - Multimídia ]------------------------------------| Function sMM() On Error Resume Next aLin = sWin("7", "Multimídia") aLin = aLin & dLine0("divup1", "Informações sobre os Dispositivos de Multimídia") aLin = aLin & dLine0("divup2", "Audio") strProp = "Name, Manufacturer" objClass = "Win32_SoundDevice" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iSound = iSound + 1 SoundName = objItem.Name SoundFab = objItem.Manufacturer aLin = aLin & dLine0("divcenter2", iSound & "º Dispositivo de Audio") aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", SoundName, "299", "Fabricante:", SoundFab) aLin = aLin & dLine0("linestyle2", "  ") Next If iSound = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Unidades Óticas") strProp = "Name, Drive, Manufacturer, MediaLoaded" objClass = "Win32_CDROMDrive" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iOD = iOD + 1 ODDrive = objItem.Drive ODName = objItem.Name ODMedLoad = gODLoad(strFmt, objItem.MediaLoaded) ODFab = objItem.Manufacturer aLin = aLin & dLine0("divcenter2", "Unidade " & ODDrive) aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", ODName, "299", "Mídia:", ODMedLoad) aLin = aLin & aLine0("", fColor, "600", "Fabricante:", ODFab, "", "", "") aLin = aLin & dLine0("linestyle2", "  ") Next If iOD = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sMM = aLin End Function '------------------------------------------------------------| '---[ PCeX - Dispositivos de Entrada ]-----------------------| Function sDIn() On Error Resume Next aLin = sWin("8", "Dispositivos de Entrada") aLin = aLin & dLine0("divup1", "Informações sobre os Dispositivos de Entrada") aLin = aLin & dLine0("divup2", "Teclado") strProp = "Description, Name, NumberOfFunctionKeys, Status" objClass = "Win32_Keyboard" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iKbDev = iKbDev + 1 KbDevDesc = objItem.Description KbDevType = objItem.Name KbDevNFKeys = objItem.NumberOfFunctionKeys KbDevStatus = gDStatus(strFmt, objItem.Status) aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", KbDevDesc, "299", "Tipo de Teclado:", KbDevType) aLin = aLin & aLine0("", fColor, "300", "Nº de Teclas de Função:", KbDevNFKeys, "299", "Status:", KbDevStatus) aLin = aLin & dLine0("linestyle2", "  ") Next If iKbDev = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Mouse") strProp = "HardwareType, DeviceInterface, Manufacturer, Status" objClass = "Win32_PointingDevice" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iMD = iMD + 1 MDName = objItem.HardwareType MDIConn = gMIConn(objItem.DeviceInterface) MDFab = objItem.Manufacturer MDStatus = gDStatus(strFmt, objItem.Status) aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", MDName, "299", "Interface:", MDIConn) aLin = aLin & aLine0("", fColor, "300", "Fabricante:", MDFab, "299", "Status:", MDStatus) aLin = aLin & dLine0("linestyle2", "  ") Next If iMD = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sDIn = aLin End Function '------------------------------------------------------------| '---[ PCeX - Dispositivos de Armazenamento ]-----------------| Function sStor() On Error Resume Next aLin = sWin("9", "Storage") aLin = aLin & dLine0("divup1", "Informações sobre os Dispositivos de Armazenamento e Backup de Arquivos") aLin = aLin & dLine0("divup2", "Unidades Físicas") strProp = "Caption, InterfaceType, DeviceID, Size" objClass = "Win32_DiskDrive" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iPhHD = iPhHD + 1 PhHDName = objItem.Caption PhHDIface = objItem.InterfaceType PhHDID = Replace(objItem.DeviceID, "\", "\\") PhHDSize = fMem(objItem.Size) Set colItems = objWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & PhHDID & """} WHERE AssocClass = " & "Win32_DiskDriveToDiskPartition") For Each objItem1 in colItems HDPartID = gHDPart(objItem1.DeviceID) HDPartSize = fMem(objItem1.Size) Set colItems = objWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskPartition.DeviceID=""" & objItem1.DeviceID & """} WHERE AssocClass = " & "Win32_LogicalDiskToPartition") For Each objItem2 in colItems LogHDID = objItem2.DeviceID Set colItems = objWMI.ExecQuery("ASSOCIATORS OF {Win32_DiskDrive.DeviceID=""" & PhHDID & """} WHERE AssocClass = " & "Win32_DiskDrivePhysicalMedia") For Each objItem3 in colItems PhMedSN = objItem3.SerialNumber aLin = aLin & dLine0("divcenter2", "Unidade " & LogHDID & " (" & HDPartID & ")") aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", PhHDName, "299", "Interface:", PhHDIface) aLin = aLin & aLine0("", fColor, "300", "Tamanho da Unidade Física:", PhHDSize, "299", "Tamanho da Partição Lógica:", HDPartSize) aLin = aLin & aLine0("", fColor, "600", "Nº Serial:", PhMedSN, "", "", "") aLin = aLin & dLine0("linestyle2", "  ") Next Next Next Next If iPhHD = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Unidades Lógicas") strProp = "Name, FileSystem, Size, FreeSpace, DriveType" objClass = "Win32_LogicalDisk" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iLogHD = iLogHD + 1 LogHDName = objItem.Name LogHDType = gTypeDrv(objItem.DriveType) LogHDFilSys = objItem.FileSystem LogHDMaxSize = fMem(objItem.Size) LogHDFreeSize = fMem(objItem.FreeSpace) If objItem.Size <> "" AND objItem.FreeSpace <> "" Then LogHDPercUsedSize = FormatPercent((objItem.Size - objItem.FreeSpace) / objItem.Size, 0) LogHDPercFreeSize = FormatPercent(objItem.FreeSpace / objItem.Size, 0) LogHDMaxSize = LogHDMaxSize & " (" & LogHDPercUsedSize & " em uso)" LogHDFreeSize = LogHDFreeSize & " (" & LogHDPercFreeSize & ") " & gLogHDAlert(strDX, Replace(LogHDPercFreeSize, "%", "")) Else LogHDPercUsedSize = 0 LogHDPercFreeSize = 0 End If LogHDGraphSize = gHDGraph(strDX, Replace(LogHDPercFreeSize, "%", ""), Replace(LogHDPercUsedSize, "%", "")) aLin = aLin & dLine0("divcenter2", "Unidade " & LogHDName & LogHDGraphSize) aLin = aLin & aLine0("", fColor, "300", "Tipo:", LogHDType, 299, "Sistema de Arquivos:", LogHDFilSys) aLin = aLin & aLine0("", fColor, "300", "Espaço Total:", LogHDMaxSize, 299, "Espaço Livre:", LogHDFreeSize) aLin = aLin & dLine0("linestyle2", "  ") Next If iLogHD = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Unidade(s) de Backup") strProp = "Name, Manufacturer"', Compression, ECC" objClass = "Win32_TapeDrive" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iTape = iTape + 1 TapeName = objItem.Name TapeFab = objItem.Manufacturer aLin = aLin & dLine0("divcenter2", iTape & "ª Unidade de Backup") aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", TapeName, 299, "Fabricante:", TapeFab) aLin = aLin & dLine0("linestyle2", "  ") Next If iTape = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sStor = aLin End Function '------------------------------------------------------------| '---[ PCeX - Centro de Conectividade ]-----------------------| Function sConn() On Error Resume Next aLin = sWin("10", "Centro de Conectividade") aLin = aLin & dLine0("divup1", "Informações sobre os Dispositivos Físicos de Rede disponíveis") aLin = aLin & dLine0("divup2", "Dispositivos de Rede") Dim NicConnID, NicConnStatus, NicEnable, NicType strProp = "ProductName, Manufacturer, Installed, MACAddress, NetEnabled, NetConnectionID, NetConnectionStatus, PhysicalAdapter" 'AdapterType, objClass = "Win32_NetworkAdapter" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems NicName = objItem.ProductName NicFab = objItem.Manufacturer NicStatus = gNicStatus(strFmt, objItem.NetConnectionStatus) NicActive = gNicActive(strFmt, objItem.Installed) NicMAC = objItem.MACAddress NicEnable = gNicEnable(strFmt, objItem.NetEnabled) NicConnID = objItem.NetConnectionID NicConnStatus = objItem.NetConnectionStatus NicType = gNicType(objItem.PhysicalAdapter) If Not IsNull(NicConnStatus) Then iNic = iNic + 1 aLin = aLin & dLine0("divcenter2", iNic & "º Dispositivo de Rede") aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", NicName, "299", "Fabricante:", NicFab) aLin = aLin & aLine0("", fColor, "300", "Status da Conexão de Rede:", NicStatus, "299", "Status do Dispositivo:", NicActive) aLin = aLin & aLine0("", fColor, "300", "Endereço MAC:", NicMAC, "299", "Dispositivo Ativo:", NicEnable) aLin = aLin & aLine0("", fColor, "300", "Tipo do dispositivo:", NicType, "299", "Nome da Interface:", NicConnID) aLin = aLin & dLine0("linestyle2", "  ") End If Next If iNic = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Modem") strProp = "Caption, DeviceType, AttachedTo, DriverDate, StatusInfo" objClass = "Win32_POTSModem" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iMod = iMod + 1 ModName = objItem.Caption ModType = objItem.DeviceType ModPort = objItem.AttachedTo ModDRVDate = fDateTime(objItem.DriverDate) ModStatus = gModStatus(strFmt, objItem.StatusInfo) aLin = aLin & dLine0("divcenter2", "Modem Nº " & iMod) aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", ModName, "299", "Tipo de Modem:", ModType) aLin = aLin & aLine0("", fColor, "300", "Porta:", ModPort, "299", "Data do Driver:", ModDRVDate) aLin = aLin & aLine0("", fColor, "600", "Status:", ModStatus, "", "", "") aLin = aLin & dLine0("linestyle2", "  ") Next If iMod = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Infra-Vermelho") strProp = "Name, Manufacturer, Status" objClass = "Win32_InfraredDevice" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iIR = iIR + 1 IRName = objItem.Name IRFab = objItem.Manufacturer IRStatus = gIRStatus(strFmt, objItem.Status) aLin = aLin & dLine0("divcenter2", "Dispositivo Infravermelho Nº " & iIR) aLin = aLin & aLine0("", fColor, "300", "Nome do Dispositivo:", IRName, "299", "Fabricante:", IRFab) aLin = aLin & aLine0("", fColor, "600", "Status:", IRStatus, "", "", "") aLin = aLin & dLine0("linestyle2", "  ") Next If iIR = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sConn = aLin End Function '------------------------------------------------------------| Function strNull(byVal ChkVal) If IsNull(ChkVal) Then ChkVal = "-" End If strNull = ChkVal End Function '---[ PCeX - Centro de Impressão ]---------------------------| Function sPrint() On Error Resume Next aLin = sWin("11", "Centro de Impressão") aLin = aLin & dLine0("divup1", "Impressoras Instaladas") aLin = aLin & dLine0("divup2", "Informações Gerais") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "PrtName", adVarChar, MaxCharacters Dlst.Fields.Append "PrtFab", adVarChar, MaxCharacters Dlst.Fields.Append "PrtPort", adVarChar, MaxCharacters Dlst.Fields.Append "PrtShareName", adVarChar, MaxCharacters Dlst.Fields.Append "PrtDefault", adVarChar, MaxCharacters Dlst.Open strProp = "*" objClass = "Win32_Printer" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems PrtName = objItem.Caption PrtFab = objItem.Manufacturer PrtPort = objItem.PortName PrtShareName = objItem.ShareName PrtDefault = gPrtDefault(strFmt, objItem.Default) Dlst.AddNew Dlst("PrtName") = PrtName Dlst("PrtFab") = PrtFab Dlst("PrtPort") = PrtPort Dlst("PrtShareName") = PrtShareName Dlst("PrtDefault") = PrtDefault Dlst.Update Next Dlst.Sort = "PrtDefault" Dlst.MoveFirst Do Until Dlst.EOF iPrt = iPrt + 1 aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("PrtName")) aLin = aLin & aLine0("", fColor, "300", "Fabricante:", Dlst.Fields.Item("PrtFab"), "299", "Porta:", Dlst.Fields.Item("PrtPort")) aLin = aLin & aLine0("", fColor, "300", "Impressora Padrão:", Dlst.Fields.Item("PrtDefault"), "299", "Nome do Compartilhamento:", Dlst.Fields.Item("PrtShareName")) aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iPrt = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sPrint = aLin End Function '------------------------------------------------------------| '---[ PCeX - Grupos e Usuários ]-----------------------------| Function sGU() On Error Resume Next aLin = sWin("12", "Grupos e Usuários") aLin = aLin & dLine0("divup1", "Grupos e contas de Usuários") aLin = aLin & dLine0("divup2", "Informações Gerais") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "GroupName", adVarChar, MaxCharacters Dlst.Open Set colItems = GetObject("WinNT://" & strPC) colItems.Filter = Array("group") For Each objItem In colItems iGroup = iGroup + 1 GroupName = objItem.Name Dlst.AddNew Dlst("GroupName") = GroupName Dlst.Update Next Dlst.Sort = "GroupName" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("GroupName")) Set Dlst1 = CreateObject("ADOR.Recordset") Dlst1.Fields.Append "UserAccName", adVarChar, MaxCharacters Dlst1.Fields.Append "UserAccBlk", adVarChar, MaxCharacters Dlst1.Fields.Append "UserDef", adVarChar, MaxCharacters Dlst1.Open Set colItems = GetObject("WinNT://" & strPC & "/"& Dlst.Fields.Item("GroupName") &", Group") For Each objItem1 in colItems.Members UserAccName = objItem1.Name UserAccBlk = gUAccBlk(strFmt, objItem1.AccountDisabled) If InStr(objItem1.AdsPath, "/" & strPC & "/") Then UserDef = objItem1.Class & " Local" ElseIf InStr(objItem1.AdsPath, "/" & ProfLLogon & "/") Then UserDef = objItem1.Class & " do Domínio" End If UserDef = Replace(UserDef, "Group", "Grupo") UserDef = Replace(UserDef, "User", "Usuário") Dlst1.AddNew Dlst1("UserAccName") = UserAccName Dlst1("UserAccBlk") = UserAccBlk Dlst1("UserDef") = UserDef Dlst1.Update Next Dlst1.Sort = "UserAccName" Dlst1.MoveFirst Do Until Dlst1.EOF aLin = aLin & aLine0("", fColor, "300", "¬> " & Dlst1.Fields.Item("UserDef") & ":", Dlst1.Fields.Item("UserAccName"), "299", "Bloqueio da Conta:", Dlst1.Fields.Item("UserAccBlk")) Dlst1.MoveNext Loop Dlst1.Close aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iGroup = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sGU = aLin End Function '------------------------------------------------------------| '---[ PCeX - Compartilhamento de Pastas ]--------------------| Function sShared() On Error Resume Next aLin = sWin("13", "Compartilhamento de Pastas") aLin = aLin & dLine0("divup1", "Informações Gerais") aLin = aLin & dLine0("divup2", "Compartilhamentos") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "SharePath", adVarChar, MaxCharacters Dlst.Fields.Append "ShareFolder", adVarChar, MaxCharacters Dlst.Fields.Append "ShareInfo", adVarChar, MaxCharacters Dlst.Open strProp = "Name, Path, Description" objClass = "Win32_Share" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iShare = iShare + 1 ShareFolder = objItem.Name SharePath = objItem.Path ShareInfo = objItem.Description Dlst.AddNew Dlst("ShareFolder") = ShareFolder Dlst("SharePath") = SharePath Dlst("ShareInfo") = ShareInfo Dlst.Update Next Dlst.Sort = "ShareFolder" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("ShareFolder")) aLin = aLin & aLine0("", fColor, "300", "Caminho do Compartilhamento:", Dlst.Fields.Item("SharePath"), "299", "Descrição:", Dlst.Fields.Item("ShareInfo")) aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iShare = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Drives Mapeados") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "MapID", adVarChar, MaxCharacters Dlst.Fields.Append "MapProv", adVarChar, MaxCharacters Dlst.Fields.Append "MapSize", adVarChar, MaxCharacters Dlst.Open strProp = "DeviceID, DriveType, ProviderName, Size" objClass = "Win32_LogicalDisk" strQuery = "SELECT " & strProp & " FROM " & objClass & " WHERE DriveType = 4" Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iMap = iMap + 1 MapID = objItem.DeviceID MapProv = objItem.ProviderName MapSize = fMem(objItem.Size) Dlst.AddNew Dlst("MapID") = MapID Dlst("MapProv") = MapProv Dlst("MapSize") = MapSize Dlst.Update Next Dlst.Sort = "MapID" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("MapID")) aLin = aLin & aLine0("", fColor, "300", "Caminho do Mapeamento:", Dlst.Fields.Item("MapProv"), "299", "Tamanho:", Dlst.Fields.Item("MapSize")) aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iMap = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Sessões Remotas") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "SessionUser", adVarChar, MaxCharacters Dlst.Fields.Append "SessionPC", adVarChar, MaxCharacters Dlst.Open Set colItems = GetObject("WinNT://" & strPC & "/LanmanServer") For Each objItem in colItems.Sessions iSession = iSession + 1 SessionUser = objItem.User SessionPC = objItem.Computer Dlst.AddNew Dlst("SessionUser") = SessionUser Dlst("SessionPC") = SessionPC Dlst.Update Next Dlst.Sort = "SessionUser" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & aLine0("", fColor, "300", "Usuário:", Dlst.Fields.Item("SessionUser"), "299", "Computador:", Dlst.Fields.Item("SessionPC")) aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iSession = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Arquivos Abertos") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "OFilesUser", adVarChar, MaxCharacters Dlst.Fields.Append "OFilesPath", adVarChar, MaxCharacters Dlst.Open Set colItems = GetObject("WinNT://" & strPC & "/LanmanServer") For Each objItem in colItems.Resources iOFiles = iOFiles + 1 OFilesUser = objItem.User OFilesPath = objItem.Path If Not IsNull(OFilesUser) AND Not Isnull(OFilesPath) Then Dlst.AddNew Dlst("OFilesUser") = OFilesUser Dlst("OFilesPath") = OFilesPath Dlst.Update End If Next Dlst.Sort = "OFilesUser" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & aLine0("", fColor, "300", "Usuário:", Dlst.Fields.Item("OFilesUser"), "299", "Arquivo Aberto:", Dlst.Fields.Item("OFilesPath")) aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iOFiles = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sShared = aLin End Function '------------------------------------------------------------| '---[ PCeX - Softwares e Atualizações ]----------------------| Function sAppInst() On Error Resume Next aLin = sWin("14", "Softwares e Aplicativos") aLin = aLin & dLine0("divup1", "Softwares e Aplicativos Instalados no Sistema") aLin = aLin & dLine0("divup2", "Softwares 32bit") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "strAppName", adVarChar, MaxCharacters Dlst.Fields.Append "strAppVer", adVarChar, MaxCharacters Dlst.Fields.Append "strAppInstDate", adVarChar, MaxCharacters Dlst.Fields.Append "strAppInstLoc", adVarChar, MaxCharacters Dlst.Open strKey = "Software\Wow6432Node\Microsoft\Windows\CurrentVersion\Uninstall" objReg.EnumKey HKLM, strKey, arrSubKeys For Each strSubKey In arrSubKeys iApp = iApp + 1 objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "DisplayName", strAppName objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "DisplayVersion", strAppVer objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "InstallDate", strAppInstDate objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "InstallLocation", strAppInstLoc AppInstName = strAppName AppVersion = strAppVer AppInstDate = strAppInstDate AppLocation = strAppInstLoc If Not IsNull(AppInstName) AND Not IsNull(AppVersion) Then If InStr(AppInstName, AppKB) <= 0 Then Dlst.AddNew Dlst("strAppName") = AppInstName Dlst("strAppVer") = AppVersion Dlst("strAppInstDate") = fDateTime(AppInstDate) Dlst("strAppInstLoc") = AppLocation Dlst.Update End If End If Next Dlst.Sort = "strAppName" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("strAppName")) aLin = aLin & aLine0("", fColor, "300", "Versão:", Dlst.Fields.Item("strAppVer"), "299", "Data de Instalação:", Dlst.Fields.Item("strAppInstDate")) aLin = aLin & aLine0("", fColor, "600", "Localização:", Dlst.Fields.Item("strAppInstLoc"), "", "", "") aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close aLin = aLin & dLine0("divup2", "Softwares 64bit") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "strAppName", adVarChar, MaxCharacters Dlst.Fields.Append "strAppVer", adVarChar, MaxCharacters Dlst.Fields.Append "strAppInstDate", adVarChar, MaxCharacters Dlst.Fields.Append "strAppInstLoc", adVarChar, MaxCharacters Dlst.Open strKey = "Software\Microsoft\Windows\CurrentVersion\Uninstall" objReg.EnumKey HKLM, strKey, arrSubKeys For Each strSubKey In arrSubKeys iApp = iApp + 1 objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "DisplayName", strAppName objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "DisplayVersion", strAppVer objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "InstallDate", strAppInstDate objReg.GetStringValue HKLM, strKey & "\" & strSubKey, "InstallLocation", strAppInstLoc AppInstName = strAppName AppVersion = strAppVer AppInstDate = strAppInstDate AppLocation = strAppInstLoc If Not IsNull(AppInstName) AND Not IsNull(AppVersion) Then If InStr(AppInstName, AppKB) <= 0 Then Dlst.AddNew Dlst("strAppName") = AppInstName Dlst("strAppVer") = AppVersion Dlst("strAppInstDate") = fDateTime(AppInstDate) Dlst("strAppInstLoc") = AppLocation Dlst.Update End If End If Next Dlst.Sort = "strAppName" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("strAppName")) aLin = aLin & aLine0("", fColor, "300", "Versão:", Dlst.Fields.Item("strAppVer"), "299", "Data de Instalação:", Dlst.Fields.Item("strAppInstDate")) aLin = aLin & aLine0("", fColor, "600", "Localização:", Dlst.Fields.Item("strAppInstLoc"), "", "", "") aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iApp = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sAppInst = aLin End Function '------------------------------------------------------------| '---[ PCeX - Processos e Serviços ]--------------------------| Function sProcServ() On Error Resume Next aLin = sWin("15", "Processos e Serviços") aLin = aLin & dLine0("divup1", "Informações Gerais") aLin = aLin & dLine0("divup2", "Processos do Sistema") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "ProcId", adVarChar, MaxCharacters Dlst.Fields.Append "ProcName", adVarChar, MaxCharacters Dlst.Fields.Append "ProcPath", adVarChar, MaxCharacters Dlst.Open strProp = "ProcessId, Name, ExecutablePath" objClass = "Win32_Process" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iProc = iProc + 1 ProcId = objItem.ProcessId ProcName = objItem.Name ProcPath = objItem.ExecutablePath Dlst.AddNew Dlst("ProcId") = ProcId Dlst("ProcName") = ProcName Dlst("ProcPath") = ProcPath Dlst.Update Next Dlst.Sort = "ProcName" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("ProcName")) aLin = aLin & aLine0("", fColor, "300", "Identificação:", Dlst.Fields.Item("ProcID"), "299", "Caminho da Execução:", Dlst.Fields.Item("ProcPath")) aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iProc = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & dLine0("divup2", "Serviços do Sistema") Set Dlst = CreateObject("ADOR.Recordset") Dlst.Fields.Append "SrvName", adVarChar, MaxCharacters Dlst.Fields.Append "SrvStatus", adVarChar, MaxCharacters Dlst.Fields.Append "SrvStatMode", adVarChar, MaxCharacters Dlst.Open strProp = "DisplayName, State, StartMode" objClass = "Win32_Service" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems iServ = iServ + 1 SrvName = objItem.DisplayName SrvStatus = gStatSrv(strFmt, objItem.State) SrvStatMode = gStatSrvMode(objItem.StartMode) Dlst.AddNew Dlst("SrvName") = SrvName Dlst("SrvStatus") = SrvStatus Dlst("SrvStatMode") = SrvStatMode Dlst.Update Next Dlst.Sort = "SrvName" Dlst.MoveFirst Do Until Dlst.EOF aLin = aLin & dLine0("divcenter2", Dlst.Fields.Item("SrvName")) aLin = aLin & aLine0("", fColor, "300", "Status:", Dlst.Fields.Item("SrvStatus"), "299", "Modo:", Dlst.Fields.Item("SrvStatMode")) aLin = aLin & dLine0("linestyle2", "  ") Dlst.MoveNext Loop Dlst.Close If iServ = 0 Then aLin = aLin & vNull(fColor, 2) aLin = aLin & dLine0("linestyle2", "  ") End If aLin = aLin & eWin(2) sProcServ = aLin End Function '------------------------------------------------------------| '---{ Função Checagem de Erro }------------------------------| Function gErr() Dim MsgErr If Err.Number <> 0 Then Select Case Err.Number Case 70: MsgErr = "Acesso negado!" & vbCrLf &_ "Verifique seus níveis de permissão neste computador." Case 424: MsgErr = "Objeto Requirido!" Case 451: MsgErr = "HEX Error is: 1C3" Case 462: MsgErr = "Computador não existe ou não está acessível!" & vbCrLf &_ "Por Favor, digite corretamente o nome do computador e" & vbCrLf &_ "verifique se há um firewall ativo!" Case -2147023174: MsgErr = "Servidor RPC indisponível." & vbCrLf &_ "Conexão não é possível." Case -2147023174: MsgErr = "Conexão não é possível." Case -2147023174: MsgErr = "Conexão não é possível." Case Else MsgErr = Err.Number End Select MsgBox "Computador: " & strPC & vbCrLf &_ MsgErr & vbCrLf &_ "Origem: " & Err.Source & "." & vbCrLf &_ "Nº do erro: " & Err.Number & " (" & Hex(Err.Number) & ")." & vbCrLf &_ "Descrição: " & Err.Description & ".", vbOKOnly + vbCritical, "Alerta de Erro!" Err.Clear() WScript.Quit End If End Function '------------------------------------------------------------| '---{ Função Data e Hora para Auditoria }--------------------| Function AudData() DateTime = Date & " às " & Time AudData = DateTime End Function '------------------------------------------------------------| '---{ Função Tamanho do Clock }------------------------------| Function fClock(byVal ChkVal) If ChkVal >= 1000 Then fClock = FormatNumber(ChkVal / 1000, 2) & " GHz" ElseIf ChkVal > 1 AND ChkVal < 1000 Then fClock = ChkVal & " MHz" ElseIf ChkVal = -1 Then fClock = "-" Else fClock = "-" End If End Function '------------------------------------------------------------| '---{ Função Tamanho da Memória 1 }--------------------------| Function fMem(byVal ChkVal) If ChkVal >= 1098437885952 Then fMem = FormatNumber(ChkVal / 1024^4, 1) fMem = fMem & " TB" ElseIf ChkVal >= 1072693248 AND ChkVal < 1098437885952 Then fMem = FormatNumber(ChkVal / 1024^3, 1) fMem = fMem & " GB" ElseIf ChkVal >= 1047552 Then fMem = Round(ChkVal / 1024^2) fMem = fMem & " MB" ElseIf ChkVal < 1024 Then fMem = Int(ChkVal / 1024) fMem = fMem & " KB" End If End Function '------------------------------------------------------------| '---{ Função Tamanho da Memória 2 }--------------------------| Function fMemSys(byVal ChkVal) If ChkVal <> 0 Then If ChkVal < 1024 Then fMemSys = Clng(ChkVal) & " KB" ElseIf ChkVal > 1024 Then fMemSys = FormatNumber((ChkVal / 1024) ,0) & " MB" End If Else ChkVal = "-" End If End Function '------------------------------------------------------------| '---{ Função Valor Data/Hora }-------------------------------| Function fDateTime(byVal ChkVal) ChkVal = Replace(ChkVal, "******.******+***", "") 'Dia / mês / Ano Hora:Minutos:Segundos If Len(ChkVal) > 8 Then ChkVal = CDate(Mid(ChkVal, 5, 2) & "/" & Mid(ChkVal, 7, 2) & "/" & Left(ChkVal, 4) & " " & Mid(ChkVal, 9, 2) & ":" & Mid(ChkVal, 11, 2) & ":" & Mid(ChkVal, 13, 2)) Else ChkVal = CDate(Mid(ChkVal, 5, 2) & "/" & Mid(ChkVal, 7, 2) & "/" & Left(ChkVal, 4)) End If fDateTime = ChkVal End Function '------------------------------------------------------------| '---{ Função Complemento de Informação - Bit }---------------| Function fBit(byVal ChkVal) If ChkVal <> 0 Then fBit = ChkVal & " Bit" End If End Function '------------------------------------------------------------| '---{ Função para Checagem de Valores no Registro }----------| Function gKReg(byVal KVal, byVal RVal) KVal = Trim(KVal) RVal = LCase(Trim(RVal)) gKReg = False If objReg.EnumValues(HKLM, KVal, aValNames, aValTypes) = 0 Then If Not IsNull(aValNames) Then For i = 0 To UBound(aValNames) If LCase(aValNames(i)) = RVal Then gKReg = True End If Next End If End If End Function Function gPReg(byVal KName, byVal KVal) KName = Trim(KName) KVal = Trim(KVal) If objReg.EnumValues(KName, KVal, aValNames, aValTypes) = 0 Then gPReg = True Else gPReg = False End If End Function '------------------------------------------------------------| '---{ Função converte binário para chave do Windows }--------| Function gKey(byVal rpk) Dim szPossibleChars, dwAccumulator, j, szProductKey Const rpkOffset=52:i=28 '# gKey szPossibleChars="BCDFGHJKMPQRTVWXY2346789" Do 'Rep1 dwAccumulator=0 : j=14 Do dwAccumulator=dwAccumulator*256 dwAccumulator=rpk(j+rpkOffset)+dwAccumulator rpk(j+rpkOffset)=(dwAccumulator\24) and 255 dwAccumulator=dwAccumulator Mod 24 j=j-1 Loop While j>=0 i=i-1 : szProductKey=mid(szPossibleChars,dwAccumulator+1,1)&szProductKey if (((29-i) Mod 6)=0) and (i<>-1) then i=i-1 : szProductKey="-"&szProductKey End If Loop While i>=0 'Goto Rep1 gKey = szProductKey End Function '------------------------------------------------------------| '---{ Função Service Pack String Replace }-------------------| Function gOSRem(byVal ChkVal) gOSRem = Replace(ChkVal, "Microsoft", "") gOSRem = Replace(ChkVal, ",", "") End Function '------------------------------------------------------------| '---{ Função Tipo do Computador }----------------------------| Function gPCType(byVal ChkVal) Select Case ChkVal Case 1: gPCType = "Estação de Trabalho" Case 2: gPCType = "Controlador de Domínio" Case 3: gPCType = "Servidor" End Select End Function '------------------------------------------------------------| '---{ Função Linguagem do Sistema }--------------------------| Function gSOLang(byVal ChkVal) Select Case ChkVal Case 1033: gSOLang = "Inglês - Estados Unidos" Case 1046: gSOLang = "Português - Brasil" Case Else gSOLang = "Outro idioma" End Select End Function '------------------------------------------------------------| '---{ Função Tipo da Suíte do Sistema }----------------------| Function gSuite(byVal ChkVal) Select Case ChkVal Case 1: gSuite = "Small Business" Case 2: gSuite = "Enterprise" Case 4: gSuite = "Backoffice" Case 8: gSuite = "Servidor de Comunicação" Case 16: gSuite = "Terminal Server" case 18: gSuite = "Enterprise e Terminal Server" Case 32: gSuite = "Small Business (Restrito)" Case 64: gSuite = "NT Embutido" Case 128: gSuite = "Data Center" Case 256: gSuite = "Único Usuário" Case 512: gSuite = "Pessoal" Case 1024: gSuite = "Blade" End Select End Function '------------------------------------------------------------| '---{ Função Horário de Verão }------------------------------| Function gDayLTSet(byVal ChkVal) Select Case ChkVal Case 1: gDayLTSet = "Desabilitado" Case Else gDayLTSet = "Habilitado" End Select End Function Function gHVerao(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case "Habilitado": ChkCol = "green" Case "Desabilitado": ChkCol = "red" End Select Select Case ChkFmt Case 1: gHVerao = "" & ChkVal & "" Case Else gHVerao = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Versão DirectX }--------------------------------| Function gDX(byVal ChkVal) Select Case ChkVal Case "4.02.0095": gDX = "1.0 - " & ChkVal Case "4.03.00.1096": gDX = "2.0 - " & ChkVal Case "4.04.0068": gDX = "3.0 - " & ChkVal Case "4.04.0069": gDX = "3.0 - " & ChkVal Case "4.05.00.0155": gDX = "5.0 - " & ChkVal Case "4.05.01.1721": gDX = "5.0 - " & ChkVal Case "4.05.01.1998": gDX = "5.2 - " & ChkVal Case "4.05.01.1600": gDX = "5.2 - " & ChkVal Case "4.06.00.0318": gDX = "6.0 - " & ChkVal Case "4.06.02.0436": gDX = "6.1 - " & ChkVal Case "4.07.00.0700": gDX = "7.0 - " & ChkVal Case "4.07.00.0716": gDX = "7.0a - " & ChkVal Case "4.07.01.3000": gDX = "7.1 - " & ChkVal Case "4.08.00.0400": gDX = "8.0 - " & ChkVal Case "4.08.01.0810": gDX = "8.1 - " & ChkVal Case "4.08.01.0881": gDX = "8.1 - " & ChkVal Case "4.08.01.0901": gDX = "8.1a - " & ChkVal Case "4.08.01.0901": gDX = "8.1b - " & ChkVal Case "4.08.02.0134": gDX = "8.2 - " & ChkVal Case "4.09.00.0900": gDX = "9.0 - " & ChkVal Case "4.09.0000.0900": gDX = "9.0 - " & ChkVal Case "4.09.00.0901": gDX = "9.0a - " & ChkVal Case "4.09.0000.0901": gDX = "9.0a - " & ChkVal Case "4.09.00.0902": gDX = "9.0b - " & ChkVal Case "4.09.0000.0902": gDX = "9.0b - " & ChkVal Case "4.09.00.0903": gDX = "9.0c - " & ChkVal Case "4.09.00.0904": gDX = "9.0c - " & ChkVal Case "4.09.0000.0904": gDX = "9.0c - " & ChkVal Case "6.0.6000.16386": gDX = "10 - " & ChkVal Case Else ChkVal = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Tipo de Sistema no Ambiente de Rede }-----------| Function gDRole(byVal ChkVal) Select Case ChkVal Case 0: gDRole = "Somente Desktop" Case 1: gDRole = "Desktop membro do domínio" Case 2: gDRole = "Somente Servidor" Case 3: gDRole = "Servidor membro do domínio" Case 4: gDRole = "Backup do Controlador de domínio" Case 5: gDRole = "Controlador Primário do domínio" End Select End Function '------------------------------------------------------------| '---{ Função Formata Cor - DHCP }----------------------------| Function gDHCP(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Dinâmico" ChkCol = "green" Case False ChkVal = "Estático" ChkCol = "red" End Select Select Case ChkFmt Case 1: gDHCP = "" & ChkVal & "" Case Else gDHCP = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Formata Cor - Antivírus }-----------------------| Function gAv(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case "Sim": ChkCol = "green" Case "Ativa": ChkCol = "green" Case "Ativado": ChkCol = "green" Case "OK": ChkCol = "green" Case Else ChkCol = "red" End Select Select Case ChkFmt Case 1: gAv = "" & ChkVal & "" Case Else gAv = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Formata Cor - AntiSpyware - On/Off }------------| Function gWDOn(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case 1 ChkVal = "Desativado" ChkCol = "red" Case 0 ChkVal = "Ativado" ChkCol = "green" End Select Select Case ChkFmt Case 1: gWDOn = "" & ChkVal & "" Case Else gWDOn = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Formata Cor - AntiSpyware - Updt }--------------| Function gAs(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case 1 ChkVal = "Desativado" ChkCol = "red" Case 0 ChkVal = "Ativado" ChkCol = "green" End Select Select Case ChkFmt Case 1: gAs = "" & ChkVal & "" Case Else gAs = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Formata Cor - Firewall }------------------------| Function gWinFw(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case 0 ChkVal = "Desativado" ChkCol = "red" Case 1 ChkVal = "Ativado" ChkCol = "green" End Select Select Case ChkFmt Case 1: gWinFw = "" & ChkVal & "" Case Else gWinFw = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Formata Valor Porcentagem }---------------------| Function fPerc(byVal ChkVal) If ChkVal >= 0 Then fPerc = ChkVal & " %" End If End Function '------------------------------------------------------------| '---{ Função Formata Valor Bit }-----------------------------| Function fBit(byVal ChkVal) If ChkVal <> 0 Then fBit = ChkVal & " Bit" End If End Function '------------------------------------------------------------| '---{ Função Família da CPU }--------------------------------| Function gCPUFam(byVal ChkVal) Select Case ChkVal Case 1: gCPUFam = "Outra" Case 2: gCPUFam = "Não identificável" Case 5: gCPUFam = "Intel386™ processor" Case 6: gCPUFam = "Intel486™ processor" Case 11: gCPUFam = "Pentium® brand" Case 12: gCPUFam = "Pentium® Pro" Case 13: gCPUFam = "Pentium® II" Case 14: gCPUFam = "Pentium® processor with MMX technology" Case 15: gCPUFam = "Celeron™" Case 16: gCPUFam = "Pentium® II Xeon" Case 17: gCPUFam = "Pentium® III" Case 18: gCPUFam = "M1 Family" Case 19: gCPUFam = "M2 Family" Case 24: gCPUFam = "AMD Duron™ Processor" Case 25: gCPUFam = "K5 Family" Case 26: gCPUFam = "K6 Family" Case 27: gCPUFam = "K6-2 Family" Case 28: gCPUFam = "K6-3 Family" Case 29: gCPUFam = "AMD Athlon™ Processor Family" Case 30: gCPUFam = "AMD2900 Family" Case 31: gCPUFam = "K6-2+ Family" Case 120: gCPUFam = "Crusoe™ TM5000 Family" Case 121: gCPUFam = "Crusoe™ TM3000 Family" Case 122: gCPUFam = "Efficeon™ TM8000 Family" Case 130: gCPUFam = "Itanium™ Processor" Case 131: gCPUFam = "AMD Athlon 64 Processor Famiily" Case 132: gCPUFam = "AMD Opteron™ Processor Family" Case 176: gCPUFam = "Pentium® III Xeon™" Case 177: gCPUFam = "Pentium® III Processor with Intel® SpeedStep™ Technology" Case 178: gCPUFam = "Pentium® 4" Case 179: gCPUFam = "Intel® Xeon™" Case 181: gCPUFam = "Intel® Xeon™ processor MP" Case 182: gCPUFam = "AMD Athlon™ XP Family" Case 183: gCPUFam = "AMD Athlon™ MP Family" Case 184: gCPUFam = "Intel® Itanium® 2" Case 185: gCPUFam = "Intel Pentium M Processor" Case 190: gCPUFam = "K7 Family" Case 300: gCPUFam = "6x86 Family" Case 301: gCPUFam = "MediaGX Family" Case 302: gCPUFam = "MII Family" Case 320: gCPUFam = "WinChip Family" End Select End Function '------------------------------------------------------------| '---{ Função Status da CPU }---------------------------------| Function fCPUAval(byVal ChkVal) Select Case ChkVal Case 1: fCPUAval = "Outro" Case 2: fCPUAval = "Não Avaliável" Case 3: fCPUAval = "Executando/Full Power" Case 4: fCPUAval = "Perigo" Case 5: fCPUAval = "Em teste" Case 6: fCPUAval = "Não aplicável" Case 7: fCPUAval = "Desligado" Case 8: fCPUAval = "Off Line" Case 9: fCPUAval = "Off Duty" Case 10: fCPUAval = "Degradado" Case 11: fCPUAval = "Não instalado" Case 12: fCPUAval = "Erro de Instalação" Case 13: fCPUAval = "Power Save - Não Avaliável" Case 14: fCPUAval = "Power Save - Low Power Mode" Case 15: fCPUAval = "Power Save - Standby" Case 16: fCPUAval = "Power Cycle" Case 17: fCPUAval = "Power Save - Warning" End Select End Function '------------------------------------------------------------| '---{ Função Gerenciamento da CPU }--------------------------| Function fCPUMan(byVal ChkVal) Select Case ChkVal Case 0: fCPUMan = "Não suportado" Case 1: fCPUMan = "Suportado" End Select End Function '------------------------------------------------------------| '---{ Função Formata Voltagem }------------------------------| Function fCPUVolt(byVal ChkVal) fCPUVolt = Replace((ChkVal / 10), ",", ".") & " V" End Function '------------------------------------------------------------| '---{ Função Fabricante da CPU }-----------------------------| Function fCPUFab(byVal ChkVal) Select Case ChkVal Case "GenuineIntel": fCPUFab = "©Intel Corporation." Case "AuthenticAMD": fCPUFab = "©Advanced Micro Devices, Inc." Case "CyrixInstead": fCPUFab = "©VIA Technologies, Inc." Case "CentaurHauls": fCPUFab = "©VIA Technologies, Inc." Case "GenuineTMx86": fCPUFab = "©Transmeta Corporation." Case Else fCPUFab = fCPUFab End Select End Function '------------------------------------------------------------| '---{ Função Uso em Porcentagem da CPU }---------------------| Function gCPUPerc(byVal ChkVal) If IsNull(ChkVal) Then ChkVal = "0%" Else ChkVal = ChkVal & "%" End If gCPUPerc = ChkVal End Function Function gCPUGraph(byVal ChkDx, byVal ChkVal) Dim tClass, tColor, tStyle If Isnull(ChkVal) Then tClass = "green" tColor = "green" ChkVal = 0 Else If ChkVal >= 75 AND ChkVal <= 100 Then tClass = "red" tColor = "#FF0000" ChkVal = ChkVal ElseIf ChkVal >= 50 AND ChkVal < 75 Then tClass = "orange" tColor = "#FFBD19" ChkVal = ChkVal Else tClass = "green" tColor = "green" ChkVal = ChkVal End If End If Select Case ChkDx Case 1: tStyle = "filter: progid:DXImageTransform.Microsoft.Gradient(startColorStr=#ffffff, endColorStr=" & tColor & ", gradientType=0); position: absolute; width: " & ChkVal & "px; height: 4px; background-color: " & tColor & "; marging: 1px 1px 1px 1px; border: 0px;" Case 0: tStyle = "width: " & ChkVal & "px; height: 4px; background-color: " & tColor & "; marging: 1px 1px 1px 1px; border: 0px;" End Select sRel = "
" gCPUGraph = sRel End Function '------------------------------------------------------------| '---{ Função Uso Porcentagem Memória do Sistema }------------| Function gMemGraph(byVal ChkDx, byVal ChkVal) Dim tClass, tColor, tStyle, tSize If ChkVal > 100 Then tClass = "green" tColor = "green" tSize = 100 ElseIf ChkVal >= 90 AND ChkVal <= 100 Then tClass = "red" tColor = "red" tSize = ChkVal ElseIf ChkVal >= 79 AND ChkVal <= 89 Then tClass = "orange" tColor = "#FFBD19" tSize = ChkVal ElseIf ChkVal <= 78 AND ChkVal >= 0 Then tClass = "green" tColor = "green" tSize = ChkVal ElseIf IsNull(ChkVal) Then tClass = "green" tColor = "green" tSize = ChkVal End If Select Case ChkDx Case 1: tStyle = "filter: progid:DXImageTransform.Microsoft.Gradient(startColorStr=#ffffff, endColorStr=" & tColor & ", gradientType=0); position: absolute; width: " & tSize & "px; height: 4px; background-color: " & tColor & "; marging: 1px 1px 1px 1px; border: 0px;" Case 0: tStyle = "width: " & tSize & "px; height: 4px; background-color: " & tColor & "; marging: 1px 1px 1px 1px; border: 0px;" End Select sRel = "
" gMemGraph = sRel End Function '------------------------------------------------------------| '---{ Função Tipo da memória 1 }-----------------------------| Function gMemFFactor(byVal ChkVal) Select Case ChkVal Case 7: GetMemType = "SIMM" Case 6: GetMemType = "Proprietário" Case 8: GetMemType = "DIMM" Case 11: GetMemType = "RIMM" Case 12: GetMemType = "SODIMM" Case 13: GetMemType = "SRIMM" Case Else GetMemType = "Não identificável" End Select End Function '------------------------------------------------------------| '---{ Função Tipo da memória 2 }-----------------------------| Function gMemType(byVal ChkVal) Select Case ChkVal Case 0: gMemType = "Não identificável" Case 1: gMemType = "Outro tipo" Case 2: gMemType = "DRAM" Case 3: gMemType = "DRAM Síncrona" Case 4: gMemType = "Cache DRAM" Case 5: gMemType = "EDO" Case 6: gMemType = "EDRAM" Case 9: gMemType = "RAM" Case 10: gMemType = "ROM" Case 11: gMemType = "Flash" Case 17: gMemType = "SDRAM" Case 19: gMemType = "RDRAM" Case 20: gMemType = "DDR" End Select End Function '------------------------------------------------------------| '---{ Função Formata Nº Slot }-------------------------------| Function gSlotID(byVal ChkVal) gSlotID = Replace(ChkVal, "System Slot", "") gSlotID = Trim(gSlotID) End Function '------------------------------------------------------------| '---{ Função Typo de Slot }----------------------------------| Function gSlotType(byVal ChkVal) Select Case ChkVal Case 0: gSlotType = SlotDesign Case 1: gSlotType = "Outro" Case 6: gSlotType = "SCSI (A) High-Density (50 pins)" Case 7: gSlotType = "SCSI (A) Low-Density (50 pins)" Case 8: gSlotType = "SCSI (P) High-Density (68 pins)" Case 9: gSlotType = "SCSI SCA-I (80 pins)" Case 10: gSlotType = "SCSI SCA-II (80 pins)" Case 11: gSlotType = "SCSI Fibre Channel (DB-9, Copper)" Case 12: gSlotType = "SCSI Fibre Channel (Fibre)" Case 13: gSlotType = "SCSI Fibre Channel SCA-II (40 pins)" Case 14: gSlotType = "SCSI Fibre Channel SCA-II (20 pins)" Case 15: gSlotType = "SCSI Fibre Channel BNC" Case 16: gSlotType = "ATA 3-1/2 Inch (40 pins)" Case 17: gSlotType = "ATA 2-1/2 Inch (44 pins)" Case 18: gSlotType = "ATA-2" Case 19: gSlotType = "ATA-3" Case 20: gSlotType = "ATA/66" Case 43: gSlotType = "PCI" Case 44: gSlotType = "ISA" Case 45: gSlotType = "EISA" Case 46: gSlotType = "VESA" Case 47: gSlotType = "PCMCIA" Case 48: gSlotType = "PCMCIA Type I" Case 49: gSlotType = "PCMCIA Type II" Case 50: gSlotType = "PCMCIA Type III" Case 53: gSlotType = "USB" Case 54: gSlotType = "IEEE 1394 (Firewire)" Case 62: gSlotType = "Infrared" Case 73: gSlotType = "AGP" Case 76: gSlotType = "Proprietário" Case 77: gSlotType = "Proprietary Processor Card Slot" Case 78: gSlotType = "Proprietary Memory Card Slot" Case 79: gSlotType = "Proprietary I/O Riser Slot" Case 80: gSlotType = "PCI-66MHZ" Case 81: gSlotType = "AGP2X" Case 82: gSlotType = "AGP4X" Case 88: gSlotType = "PCI-X" Case 89: gSlotType = "SSA SCSI" Case 91: gSlotType = "On Board IDE Connector" Case 92: gSlotType = "On Board Floppy Connector" Case 99: gSlotType = "PCI-X" Case 122: gSlotType = "InfiniBand" Case 123: gSlotType = "AGP8X" Case 124: gSlotType = "PCI-Express" End Select End Function '------------------------------------------------------------| '---{ Função Tamanho do Bit nos Slots }----------------------| Function gSlotBit(byVal ChkVal) Select Case ChkVal Case 0: gSlotBit = "8 Bit" Case 1: gSlotBit = "16 Bit" Case 2: gSlotBit = "32 Bit" Case 3: gSlotBit = "64 Bit" Case 4: gSlotBit = "128 Bit" Case Else gSlotBit = "" End Select End Function '------------------------------------------------------------| '---{ Função Status do Slot }--------------------------------| Function gSlotStatus(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case 0 ChkVal = "Reservado" ChkCol = "orange" Case 1 ChkVal = "Outro" ChkCol = "orange" Case 2 ChkVal = "Não identificado" ChkCol = "red" Case 3 ChkVal = "Disponível" ChkCol = "green" Case 4 ChkVal = "Em uso" ChkCol = "red" End Select Select Case ChkFmt Case 1: gSlotStatus = "" & ChkVal & "" Case Else gSlotStatus = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Tipo do dispositivo On-Board }------------------| Function gOnBDevType(byVal ChkVal) Select Case ChkVal Case 1: gOnBDevType = "Outro dispositivo" Case 2: gOnBDevType = "Não identificável" Case 3: gOnBDevType = "Vídeo On-Board" Case 4: gOnBDevType = "Controladora SCSI" Case 5: gOnBDevType = "Rede On-Board" Case 6: gOnBDevType = "Token Ring" Case 7: gOnBDevType = "Som On-Board" End Select End Function '------------------------------------------------------------| '---{ Função Status do dispositivo On-Board }----------------| Function gOnBDevOn(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Ativo" ChkCol = "green" Case Else ChkVal = "Desativado" ChkCol = "red" End Select Select Case ChkFmt Case 1: gOnBDevOn = "" & ChkVal & "" Case Else gOnBDevOn = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status do Windows Update }----------------------| Function gAUOpt(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case 0 ChkVal = "0" ChkCol = "red" Case 1 ChkVal = "Desativado" ChkCol = "red" Case 2 ChkVal = "Apenas notificar sobre atualizações." ChkCol = "orange" Case 3 ChkVal = "Apenas baixar atualizações." ChkCol = "orange" Case 4 ChkVal = "Download das atualizações com instalação agendada." ChkCol = "green" Case 5 ChkVal = "Download das atualizações com instalação agendada (data e hora)." ChkCol = "green" End Select Select Case ChkFmt Case 1: gAUOpt = "" & ChkVal & "" Case Else gAUOpt = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Data Instalação do Windows Update }-------------| Function gAUDay(byVal ChkVal) Select Case ChkVal Case 0: gAUDay = "Diariamente." Case 1: gAUDay = "Domingo" Case 2: gAUDay = "Segunda" Case 3: gAUDay = "Terça" Case 4: gAUDay = "Quarta" Case 5: gAUDay = "Quinta" Case 6: gAUDay = "Sexta" Case 7: gAUDay = "Sábado" End Select End Function '------------------------------------------------------------| '---{ Função Formata Hertz }---------------------------------| Function fHz(byVal ChkVal) If ChkVal >= 0 Then fHz = ChkVal & " Hz" End If End Function '------------------------------------------------------------| '---{ Função Mídia Status }----------------------------------| Function gODLoad(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Presente" ChkCol = "green" Case Else ChkVal = "Não presente" ChkCol = "red" End Select Select Case ChkFmt Case 1: gODLoad = "" & ChkVal & "" Case Else gODLoad = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status do Teclado/Mouse }-----------------------| Function gDStatus(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case "OK" ChkVal = "Presente" ChkCol = "green" Case Else ChkVal = "Não presente" ChkCol = "red" End Select Select Case ChkFmt Case 1: gDStatus = "" & ChkVal & "" Case Else gDStatus = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Interface de Conexão Mouse }--------------------| Function gMIConn(byVal ChkVal) Select Case ChkVal Case 1: gMIConn = "Outra" Case 2: gMIConn = "Não definida" Case 3: gMIConn = "Serial" Case 4: gMIConn = "PS/2" Case 5: gMIConn = "Infra Vermelho" Case 6: gMIConn = "HP-HIL" Case 7: gMIConn = "Bus Mouse" Case 8: gMIConn = "ADB (Apple Desktop Bus)" Case 160: gMIConn = "DB-9" Case 161: gMIConn = "Micro-DIN" Case 162: gMIConn = "USB" Case Else gMIConn = "Não identificável" End Select End Function '------------------------------------------------------------| '---{ Função Informação Disco e Partição }-------------------| Function gHDPart(byVal ChkVal) ChkVal = Replace(ChkVal, "Disk #", "Unidade Nº ") ChkVal = Replace(ChkVal, "Partition #", "Partição Nº ") gHDPart = ChkVal End Function '------------------------------------------------------------| '---{ Função Tipo Drive Lógico }-----------------------------| Function gTypeDrv(byVal ChkVal) Select Case ChkVal Case 0: gTypeDrv = "Unidade não encontrada" Case 1: gTypeDrv = "Unidade de Ram" Case 2: gTypeDrv = "Unidade Removível" Case 3: gTypeDrv = "Unidade Local" Case 4: gTypeDrv = "Unidade de Rede" Case 5: gTypeDrv = "CD-ROM / DVD-ROM" End Select End Function '------------------------------------------------------------| '---{ Função Alerta Uso de Espaço em Disco }-----------------| Function gLogHDAlert(byVal ChkFmt, byVal ChkVal) If ChkVal >= 31 AND ChkVal <= 100 Then ChkCol = "green" ChkVal = "" ElseIf ChkVal >= 16 AND ChkVal <= 30 Then ChkCol = "orange" ChkVal = "Nível Regular!" ElseIf ChkVal <= 15 AND ChkVal >= 0 Then ChkCol = "red" ChkVal = "Nível Crítico!" End If 'If ChkVal = 0 Then ' ChkCol = "green" ' ChkVal = "" 'ElseIf ChkVal < 15 Then ' ChkCol = "red" ' ChkVal = "Nível Crítico!" 'ElseIf ChkVal >= 15 AND ChkVal <= 30 Then ' ChkCol = "orange" ' ChkVal = "Nível Regular!" 'Else ' ChkCol = "green" ' ChkVal = "" 'End If Select Case ChkFmt Case 1: gLogHDAlert = "" & ChkVal & "" Case Else gLogHDAlert = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Gráfico Uso de espaço em disco }----------------| Function gHDGraph(byVal ChkDx, byVal ChkVal, byVal tSize) Dim tClass, tColor, tStyle If tSize >= 85 AND tSize <= 100 Then tClass = "red" tColor = "red" ElseIf tSize >= 70 AND tSize <= 84 Then tClass = "orange" tColor = "#FFBD19" ElseIf tSize <= 69 AND tSize >= 0 Then tClass = "green" tColor = "green" End If Select Case ChkDx Case 1: tStyle = "filter: progid:DXImageTransform.Microsoft.Gradient(startColorStr=#ffffff, endColorStr=" & tColor & ", gradientType=0); position: absolute; width: " & tSize & "px; height: 4px; background-color: " & tColor & "; marging: 1px 1px 1px 1px; border: 0px;" Case 0: tStyle = "width: " & tSize & "px; height: 4px; background-color: " & tColor & "; marging: 1px 1px 1px 1px; border: 0px;" End Select sRel = "
" gHDGraph = sRel End Function '------------------------------------------------------------| '---{ Função Status Compressão }-----------------------------| Function gTapeZip(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Ativa" ChkCol = "green" Case Else ChkVal = "Desativada" ChkCol = "red" End Select Select Case ChkFmt Case 1: gTapeZip = "" & ChkVal & "" Case Else gTapeZip = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status Checagem de Erro }-----------------------| Function gTapeECC(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Suportado" ChkCol = "green" Case Else ChkVal = "Não Suportado" ChkCol = "red" End Select Select Case ChkFmt Case 1: gTapeECC = "" & ChkVal & "" Case Else gTapeECC = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status de Presença para Nics }------------------| Function gNicActive(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Presente" ChkCol = "green" Case False ChkVal = "Não Presente" ChkCol = "red" Case Else ChkVal = "Não identificável" ChkCol = "red" End Select Select Case ChkFmt Case 1: gNicActive = "" & ChkVal & "" Case Else gNicActive = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status da Nics }--------------------------------| Function gNicStatus(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case 0 ChkVal = "Desconectado" ChkCol = "red" Case 1 ChkVal = "Conectando" ChkCol = "orange" Case 2 ChkVal = "Conectado" ChkCol = "green" Case 3 ChkVal = "Desconectando" ChkCol = "orange" Case 4 ChkVal = "Dispositivo não Presente" ChkCol = "red" Case 5 ChkVal = "Dispositivo Desabilitado" ChkCol = "red" Case 6 ChkVal = "Dispositivo com Problemas" ChkCol = "red" Case 7 ChkVal = "Cabo de Rede Desconectado" ChkCol = "red" Case 8 ChkVal = "Autenticando" ChkCol = "orange" Case 9 ChkVal = "Autenticação realizada com Sucesso" ChkCol = "green" Case 10 ChkVal = "Autenticação Falhou" ChkCol = "red" Case 11 ChkVal = "Endereço Inválido" ChkCol = "red" Case 12 ChkVal = "Credenciais Requiridas" ChkCol = "red" Case Else ChkVal = "Não identificável" ChkCol = "red" End Select Select Case ChkFmt Case 1: gNicStatus = "" & ChkVal & "" Case Else gNicStatus = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status de Presença para Nics }------------------| Function gNicEnable(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Sim" ChkCol = "green" Case False ChkVal = "Não" ChkCol = "red" Case Else ChkVal = "Não identificável" ChkCol = "red" End Select Select Case ChkFmt Case 1: gNicEnable = "" & ChkVal & "" Case Else gNicEnable = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Tipo de placa de rede }-------------------------| Function gNicType(byVal ChkVal) Select Case ChkVal Case True ChkVal = "Físico" Case False ChkVal = "Virtual" Case Else ChkVal = "Não identificável" End Select gNicType = ChkVal End Function '------------------------------------------------------------| '---{ Função Status de Ativo para Nics }---------------------| Function gNicSpeedMax(byVal ChkVal) If ChkVal < 10000 Then gNicSpeedMax = ChkVal / 10 & " Kbps" Else gNicSpeedMax = ChkVal / 10000 & " Mbps" End If End Function '------------------------------------------------------------| '---{ Função Modo de Operação das Nics }---------------------| Function gNicMode(byVal ChkVal) Select Case ChkVal Case 16 gNicMode = "Full Duplex" Case Else gNicMode = "Half Duplex" End Select End Function '------------------------------------------------------------| '---{ Função Status do Modem }-------------------------------| Function gModStatus(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case 1 ChkVal = "Outro" ChkCol = "green" Case 2 ChkVal = "Desativado ou não Presente" ChkCol = "red" Case 3 ChkVal = "Ativo" ChkCol = "green" Case 4 ChkVal = "Desativado" ChkCol = "red" Case 5 ChkVal = "Não aplicável" ChkCol = "red" End Select Select Case ChkFmt Case 1: gModStatus = "" & ChkVal & "" Case Else gModStatus = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status do Infra-Vermelho }----------------------| Function gIRStatus(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case "OK" ChkCol = "green" Case Else ChkCol = "red" End Select Select Case ChkFmt Case 1: gIRStatus = "" & ChkVal & "" Case Else gIRStatus = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status do Infra-Vermelho }----------------------| Function gPrtDefault(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Sim" ChkCol = "green" Case Else ChkVal = "Não" ChkCol = "red" End Select Select Case ChkFmt Case 1: gPrtDefault = "" & ChkVal & "" Case Else gPrtDefault = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Status da Conta de Usuário }--------------------| Function gUAccBlk(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case True ChkVal = "Sim" ChkCol = "green" Case False ChkVal = "Não" ChkCol = "red" End Select Select Case ChkFmt Case 1: gUAccBlk = "" & ChkVal & "" Case Else gUAccBlk = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Service Status }--------------------------------| Function gStatSrv(byVal ChkFmt, byVal ChkVal) Select Case ChkVal Case "Running" ChkVal = "Em Execução" ChkCol = "green" Case "Stopped" ChkVal = "Parado" ChkCol = "red" End Select Select Case ChkFmt Case 1: gStatSrv = "" & ChkVal & "" Case Else gStatSrv = ChkVal End Select End Function '------------------------------------------------------------| '---{ Função Service Status Mode }---------------------------| Function gStatSrvMode(byVal ChkVal) Select Case ChkVal Case "Manual": ChkVal = "Manual" Case "Disabled": ChkVal = "Desabilitado" Case "Auto": ChkVal = "Automático" End Select gStatSrvMode = ChkVal End Function '------------------------------------------------------------| '---[ Função para construção do Layout HTML - Parte 1 ]------| Function sWin(byVal nID, byVal iHead) If (strFmt = 1) OR (strFmt = 2) Then sRel = "
" & vbCrLf sRel = sRel & "
" & vbCrLf sRel = sRel & "

" & iHead & "

" & vbCrLf sRel = sRel & "
" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "
" & vbCrLf sRel = sRel & "
" & vbCrLf Else sRel = "
  •   
    • " & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf End If ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then sRel = sRel & "::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" & vbCrLf & vbCrLf End If eWin = sRel End Function Function aLine0(byVal gStyle, byVal gColor, byVal nVal1, byVal pVal1, byVal pVal2, byVal nVal2, byVal pVal3, byVal pVal4) If (strFmt = 1) OR (strFmt = 2) Then If gStyle <> "" AND gColor = "" AND nVal2 = "" AND pVal3 = "" AND pVal4 = "" Then sRel = "
  • " & ChkNull(pVal1) & "  " & ChkNull(pVal2) & "
    • " & vbCrLf ElseIf gStyle <> "" AND gColor = "" Then sRel = "
  • " & ChkNull(pVal1) & "  " & ChkNull(pVal2) & "" & ChkNull(pVal3) & "  " & ChkNull(pVal4) & "
    • " & vbCrLf ElseIf gStyle = "" AND gColor <> "" AND nVal2 = "" AND pVal3 = "" AND pVal4 = "" Then sRel = "
  • " & ChkNull(pVal1) & "  " & ChkNull(pVal2) & "
    • " & vbCrLf ElseIf gStyle = "" AND gColor <> "" Then sRel = "
  • " & ChkNull(pVal1) & "  " & ChkNull(pVal2) & "" & ChkNull(pVal3) & "  " & ChkNull(pVal4) & "
    • " & vbCrLf ElseIf gStyle <> "" AND gColor <> "" Then sRel = "
  • " & ChkNull(pVal1) & "  " & ChkNull(pVal2) & "" & ChkNull(pVal3) & "  " & ChkNull(pVal4) & "
    • " & vbCrLf End If ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If aLine0 = sRel End Function Function aLine1(byVal gStyle, byVal gColor, byVal nVal1, byVal pVal1, byVal pVal2, byVal pVal3, byVal nVal2, byVal pVal4, byVal pVal5) If (strFmt = 1) OR (strFmt = 2) Then sRel = "
  • " & ChkNull(pVal1) & "  " & ChkNull(pVal2) & " " & ChkNull(pVal3) & "" & ChkNull(pVal4) & "  " & ChkNull(pVal5) & "
    • " & vbCrLf ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If aLine1 = sRel End Function Function aLine2(byVal gStyle, byVal gColor, byVal nVal1, byVal pVal1, byVal nVal2, byVal pVal2, byVal nVal3, byVal pVal3, byVal nVal4, byVal pVal4, byVal nVal5, byVal pVal5) If (strFmt = 1) OR (strFmt = 2) Then sRel = "
  • " & ChkNull(pVal1) & "" & ChkNull(pVal2) & "" & ChkNull(pVal3) & "" & ChkNull(pVal4) & "" & ChkNull(pVal5) & "
    • " & vbCrLf ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If aLine2 = sRel End Function Function sLine0(byVal gStyle, byVal pVal1) If (strFmt = 1) OR (strFmt = 2) Then sRel = "
  • " & pVal1 & "
    • " & vbCrLf ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If sLine0 = sRel End Function Function dLine0(byVal gStyle, byVal pVal1) If (strFmt = 1) OR (strFmt = 2) Then sRel = "
  • " & pVal1 & "
    • " & vbCrLf ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If dLine0 = sRel End Function Function dLine1(byVal gStyle, byVal nVal1, byVal pVal1, byVal nVal2, byVal pVal2, byVal nVal3, byVal pVal3, byVal nVal4, byVal pVal4) If (strFmt = 1) OR (strFmt = 2) Then sRel = "
  • " & pVal1 & "" & pVal2 & "" & pVal3 & "" & pVal4 & "
    • " & vbCrLf ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If dLine1 = sRel End Function Function ChkNull(byVal ChkVal) If IsNull(Trim(ChkVal)) = True OR Trim(ChkVal) = "" OR Trim(ChkVal) = " " OR Trim(ChkVal) = "-1" Then ChkNull = "-" Else ChkNull = ChkVal End If End Function Function vNull(byVal gColor, byVal ChkVal) Select Case ChkVal Case 1: ChkVal = vOutMsg01 Case 2: ChkVal = vOutMsg02 Case 3: ChkVal = vOutMsg03 End Select If (strFmt = 1) OR (strFmt = 2) Then sRel = "
  • " & ChkVal & "
    • " & vbCrLf ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If vNull = sRel End Function '------------------------------------------------------------| Function AlertSys(byVal ChkVal) Dim gStyle Select Case ChkVal Case 1: ChkVal = vAlertMsg01 gStyle = "linestyle4" Case 2: ChkVal = vAlertMsg02 gStyle = "linestyle4" End Select If (strFmt = 1) OR (strFmt = 2) Then sRel = "
  • " & ChkVal & "
    • " & vbCrLf ElseIf (strFmt = 3) Then ElseIf (strFmt = 4) Then End If AlertSys = sRel End Function '------------------------------------------------------------| '---[ Função para construção do Layout HTML - Parte 2 ]------| Function sPage() If (strFmt = 1) OR (strFmt = 2) Then sRel = "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vAppName & vAppVer & vAppBuild & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "

    " & vAppName & "

    " & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "
      " & vbCrLf sRel = sRel & "
    • Arquivo  Editar  Visualizar  Help  Sobre
      • " & vbCrLf sRel = sRel & "
    • Início do inventário: " & AudData() & "
      • " & vbCrLf sRel = sRel & "
    " & vbCrLf Elseif (strFmt = 3) Then Elseif (strFmt = 4) Then sRel = sRel & "::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" & VbCrLf sRel = sRel & ":: ::" & VbCrLf sRel = sRel & "::" & Center_Text(Var_Soft_Name & Var_Soft_Version & Var_Soft_Build, 54) & "::" & VbCrLf sRel = sRel & ":: ::" & VbCrLf sRel = sRel & "::::::::::::::::::::::::::::::::::::::::::::::::::::::::::" & VbCrLf Elseif (strFmt = 5) Then End If sPage = sRel End Function '------------------------------------------------------------| '---[ Função para construção do Layout HTML - Parte 3 ]------| Function ePage() If (strFmt = 1) OR (strFmt = 2) Then sRel = "
    " & vbCrLf sRel = sRel & "
      " & vbCrLf sRel = sRel & "
    • Término do inventário: " & AudData() & "
      • " & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "
    " & vbCrLf sRel = sRel & "" & vbCrLf sRel = sRel & "" & vbCrLf Elseif (strFmt = 3) Then Elseif (strFmt = 4) Then Elseif (strFmt = 5) Then End If ePage = sRel End Function '------------------------------------------------------------| '---[ Função geração do relatório ]--------------------------| Function CreateArch(byVal BodyArch) Dim sArq, objFSys, objFH strProp = "Name" objClass = "Win32_ComputerSystem" strQuery = "SELECT " & strProp & " FROM " & objClass Set colItems = objWMI.ExecQuery(strQuery, "WQL", strStruc) For Each objItem in colItems HostName = objItem.Name DateTime = Replace(Date, "/", "-") & "~" & Replace(Time,":", "-") Next If (strFmt = 1) OR (strFmt = 2) Then sArq = UCase(HostName & "-" & DateTime & ".html") Elseif (strFmt = 3) Then sArq = UCase(HostName & "-" & DateTime & ".xml") Elseif (strFmt = 4) Then sArq = UCase(HostName & "-" & DateTime & ".txt") Elseif (strFmt = 5) Then sArq = UCase(HostName & "-" & DateTime & ".csv") End If Set objFSys = CreateObject("Scripting.FileSystemObject") Set objFH = objFSys.CreateTextFile(sArq, ForWriting, True) objFH.WriteLine BodyArch If (strFmt = 2) Then Dim objMsg, PathFile, FileIn, FileOut Set objMsg = CreateObject("CDO.Message") Set PathFile = objFSys.GetFile(".\" & sArq) FileIn = PathFile.Path FileOut = PathFile.ParentFolder 'WScript.Echo FileIn & " e " & FileOut objMsg.CreateMHTMLBody FileIn SaveToFile objMsg, FileOut & "\" & UCase(HostName & "-" & DateTime & ".mht") If objFSys.FileExists(FileIn) Then 'WScript.Echo "Arquivo Existe!" 'objFSys.DeleteFile(FileIn), True End If End If objFH.Close Set objFSys = Nothing Set objFH = Nothing End Function '------------------------------------------------------------| 'VER Sub SaveToFile(Msg, Fn) Dim Strm, Dsk Set Strm = CreateObject("ADODB.Stream") Strm.Type = adTypeText Strm.Charset = "US-ASCII" Strm.Open Set Dsk = Msg.DataSource Dsk.SaveToObject Strm, "_Stream" Strm.SaveToFile Fn, adSaveCreateOverWrite End Sub '---[ Execução do Script ]-----------------------------------| GetArgs() '------------------------------------------------------------|