pTraffer - Поиск почтовых архивов и баз 1С на пользовательских ПК (PST, MD, 1C8, 1C7)

Итак - сканирование пользовательских ПК на наличие баз 1С, причины думаю очевидны

1) Запускаем 1_dump_pc's_from_AD.vbs -> в файле PC.txt получаем свежий список ПК в AD
2) Запускаем 2_scan.vbs в контексте пользователя с правами локального администратора на пользовательских ПК

- файл вида "03.03.2011_13_42_offline.txt" содержит ПК которые в оффлайне, если была ошибка то её описание (для повторного сканирования)
- файл вида "03.03.2011_13_42_online.txt" содержит пути к файлам баз в формате

Имя ПК            размер файла    путь к файлу

WKS1094    262144        c:\documents and settings\...\мои документы\infobase\1cv8.1cd
WKS3008    262144        c:\documents and settings\...\мои документы\infobase\1cv8.1cd
WKS3008    270336        c:\documents and settings\...\мои документы\infobase1\1cv8.1cd


Соответственно если размер основного файла базы (почтового архива) 250 килобайт значит он\она пусты(?)

Предполагается что после первого первого "прогона" все офф-лайн ПК будут скопированы в "PC.txt" заново для повторного сканирования.

Дабы не потерять данные - имена логов содержат текущее время.

Итоги работы ниже

Далее код

1_dump_pc's_from_AD.vbs

============================================

option explicit

dim dLastMessageDate, szLastIniFileName, szLastIniData, nLastRecordNumber, szStrTmp, szStrTmp2, szArchiverPath
Dim objFolder, objWMI, objEvent, j, strIniFileName, k, bWasError, fLogFile
Dim intEvent, intNumberID, intRecordNum, colLoggedEvents, objInstalledLogFiles, objLogfile
Dim WshShell, FSO, WshNetwork, Shell, objItem, objSubItem, szPath, objFolderNetwork, szPCname, szCurFilePC, szCurDomain, Dict, objConnection, objCommand, objRecordSet, i
dim d, WshArg

Set WshArg = WScript.Arguments
Set WshShell = CreateObject("WScript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set WshNetwork = CreateObject("WScript.Network")
Set Shell = CreateObject("Shell.Application")
Set Dict = CreateObject("Scripting.Dictionary")

const bDebugMode = true





strIniFileName = FSO.GetParentFolderName(Wscript.ScriptFullName) & "\Events.ini"

If ScriptHost <> "cscript.exe" Then
CreateObject("WScript.Shell").Run "cmd /c start /wait /max cscript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34), 0, True
Wscript.quit
End If


on error resume next
szCurDomain = split(Replace(GetObject("LDAP://rootDSE").Get("defaultNamingContext"), "DC=", "",1,-1,vbTextCompare),",")(0)

if err then
WshShell.popup "Ошибка получения имени домена", 15, WScript.ScriptName , 0
errr.clear
end if

wscript.echo "Gathering from Shell..."

For Each objItem In Shell.NameSpace("::{208D2C60-3AEA-1069-A2D7-08002B30309D}").Items().Item("EntireNetwork").GetFolder.Items()
If objItem.Name = "Microsoft Windows Network" Then
Set objFolderNetwork = objItem.GetFolder
End If
Next


on error goto 0

wscript.echo "Ок - found " & dict.count & " computers."

i = dict.count

wscript.echo "Gathering from AD..."

Const ADS_SCOPE_SUBTREE = 2

Set objConnection = CreateObject("ADODB.Connection")
Set objCommand =   CreateObject("ADODB.Command")
objConnection.Provider = "ADsDSOObject"
objConnection.Open "Active Directory Provider"

'msgbox "Определён домен - " & szCurDomain

Set objCOmmand.ActiveConnection = objConnection
objCommand.CommandText = "Select Name, Location from 'LDAP://DC=" & szCurDomain & ",DC=int' " & "Where objectClass='computer'" 
objCommand.Properties("Page Size") = 1000
objCommand.Properties("Searchscope") = ADS_SCOPE_SUBTREE
Set objRecordSet = objCommand.Execute
objRecordSet.MoveFirst

on error resume next

Do Until objRecordSet.EOF
if not dict.exists(ucase(objRecordSet.Fields("Name").Value)) then
Dict.Add ucase(objRecordSet.Fields("Name").Value), ""
end if
objRecordSet.MoveNext
Loop

on error goto 0

wscript.echo "Ок - added " & dict.count-i & " new computers."
wscript.echo "Overall count -  " & dict.count & "."
wscript.echo ""

Dim strComputer, objRemoteServices, objShare, objInParam, objOutParams, file

Set file = fso.CreateTextFile("PC.txt", 2)


for i=0 to dict.count-1



strComputer = Dict.Keys()(i)


wscript.echo strComputer & vbtab & " - " & i & "\" & dict.count & " - saving..."

if left(strComputer, 1) <> "S" then 'не показываем все ПК начинающиеся на ... - фильтруем сервера
file.writeline strComputer
end if



next

file.close



wscript.quit



Function ScriptHost()
ScriptHost = LCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2))
End Function

============================================

2_scan.vbs

============================================

option explicit

Dim TextStream,szCurPC, FSO,file,file2, bFounded



set FSO = CreateObject("Scripting.FileSystemObject")
const my_ini_file="PC.TXT"


If ScriptHost <> "cscript.exe" Then
CreateObject("WScript.Shell").Run "cmd /c start /wait /max cscript.exe " & Chr(34) & WScript.ScriptFullName & Chr(34), 0, True
Wscript.quit
End If

Set TextStream = FSO.GetFile(my_ini_file).OpenAsTextStream(1)

Set file = fso.CreateTextFile( date & "_" & hour(time()) & "_" & minute(time()) & "_online.txt", 8,True)
Set file2 = fso.CreateTextFile( date & "_" & hour(time()) & "_" & minute(time()) & "_offline.txt", 8,True)

While Not TextStream.AtEndOfStream

szCurPC=""

szCurPC = TextStream.ReadLine()

'if bFounded then
fExtractEvents szCurPC
'end if
'wscript.echo szCurPC

'если надо - продолжаем с...
'if "WKS4023"=szCurPC then bFounded=true

Wend


wscript.quit


sub fExtractEvents(strComputer)

dim objWMIService

If WMIPing (strComputer)  or strComputer="." Then     

on error resume next

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\CIMV2")
wscript.echo "Processing " & strComputer

if err then
file2.writeline strComputer & err.description
exit sub
end if

on error goto 0

dim colItems,objItem

const wbemFlagReturnWhenComplete=0

Set colItems = objWMIService.ExecQuery( "SELECT * FROM CIM_Datafile WHERE Extension = 'pst' OR Extension = '1cd' OR Extension = 'md'", , wbemFlagReturnWhenComplete)

'   ********* Контрольная точка

For Each objItem in colItems
if instr(1,lcase(objItem.Name),"\application data\")=0 or lcase(right(objItem.Name,4))=".pst" then
if len(cstr(objItem.filesize))<8 then
file.writeline objItem.CSName & vbtab & objItem.filesize & vbtab & vbtab & objItem.Name
else
file.writeline objItem.CSName & vbtab & objItem.filesize & vbtab & objItem.Name
end if
end if
Next

Else
wscript.echo "Offline " & strComputer

file2.writeline strComputer

End If


end sub


Function WMIPing(strAdr)
Dim objPing
Dim objStatus
Set objPing = GetObject("winmgmts:{impersonationLevel=impersonate}").ExecQuery("select * from Win32_PingStatus where address = '" & strAdr & "'")
For Each objStatus In objPing
If IsNull(objStatus.StatusCode) Or objStatus.StatusCode <> 0 Then
WMIPing = False
Else
WMIPing = True
End If
Next
End Function

Function ScriptHost()
ScriptHost = LCase(Mid(Wscript.FullName, Len(Wscript.Path) + 2))
End Function

============================================