» Программирование "удобняшек" на VBScript

Hugo121
Огромное спасибо!
Логи вообще штука хорошая!

Ну вот так, что писать - можно и переделать, сейчас пишется дата ошибки и имя папки, пути
MyPath = "C:\temp\Magiogre"
LogPath = "C:\temp\MagiogreLog.txt"
подправьте:

Код: Option Explicit

Const ForAppending = 8

Dim fso, oFolder, oSubFolder
Dim objTS, objfile
Dim MyPath, LogPath, vremja, prefix

MyPath = "C:\temp\Magiogre"
LogPath = "C:\Tmp\MagiogreLog.txt"

vremja = Split((Replace((Date() & "." & Time()), ":", ".")), ".")
'msgbox vremja(0) 'date
'msgbox vremja(1) 'month
'msgbox vremja(2) 'year
'msgbox vremja(3) 'hour
'msgbox vremja(4) 'min
'msgbox vremja(5) 'sec

prefix = vremja(0) & "." & vremja(1) & "." & vremja(2)

Set fso = wsh.CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(MyPath)

On Error Resume Next
For Each oSubFolder in oFolder.SubFolders
if cdate(mid(oSubFolder.name, instr(1,oSubFolder.name, "[до")+4, 10)) <= cdate(prefix) then
    If err.number = 0 then
    fso.DeleteFolder oSubFolder, true
    else
' We now open the file to write it out
err.clear
     If FSO.FileExists(LogPath) Then
         Set objTS = FSO.OpenTextFile(LogPath, ForAppending) 'открываем итоговый файл для добавления записей
     Else
         Set objfile = FSO.CreateTextFile(LogPath)
         Set objfile = Nothing
         Set objTS = FSO.OpenTextFile(LogPath, ForAppending)
     End if
objTS.WriteLine Date() & " " & cstr(oSubFolder.name)
objTS.Close
Set objTS = Nothing
End if
End If
Next

К вопросу на 81стр
Как сделать чтобы скрипт понимал русский текст. У меня вместо русск букв глюки.
Винда XP англ, но все настройки "Regional" панели управления поставлены на Russian

Black_Lung

Цитата:

отркрываю файл set db = FSO.OpenTextFile("xxx")
читаю db.ReadLine
Есть ли функция возврата на начало файла на 1ю строку?

Нет: текстовый поток однонаправленный (на то он и "поток" ).

Можно в кач-ве альтернативы TextStream использовать Recordset ADODB.
Пример:
Код: Option Explicit
Dim cn, rs, i

Set cn = CreateObject("ADODB.Connection")
cn.Open "Provider=Microsoft.Jet.OLEDB.4.0;" & _
"Data Source=C:\Путь_к_папке_с_файлом(файлами)\;Extended Properties='text;HDR=No'"
Set rs = CreateObject("ADODB.Recordset")
Set rs = cn.Execute("SELECT * FROM Файл.txt")
Do Until rs.EOF
If Not IsNull(rs(0)) Then MsgBox rs(0)
If i = 10 Then
rs.MoveFirst 'Возврат с 10-й записи на первую
MsgBox rs(0)
End If
rs.MoveNext
i = i + 1
Loop
cn.Close
Set cn = Nothing : rs = Nothing

vlth
Спасибо

Цитата:

Это как? Вы печатать по-русски можете?

В тот файл заносятся список файлов через dir /s /b. выяснил что dir выводит русский текст в dos кодировке, а vbs ее не понимает.
Нужно сделать или чтобы dir выводил в win кодировке или чтобы vbs понимал dos. Еще может у кого-нибудь есть другой аналог создающий список файлов с учетом подкаталогов и "*".

Из примеров и кусков собрал себе скриптик требуемый для работы. Подскажите, как дописать условие "если пользователь Root уже есть - ничего не делать" ?


Код: strUserName = "Admin"
strNewUserName = "Root"
strPassword = "password"
strComputer = "."
Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.MoveHere objUser.AdsPath, strNewUserName
Set objComputer = Nothing
Set objUser = Nothing
Set objUser = GetObject("WinNT://" & strComputer & "/" & strNewUserName & ", user")
objUser.SetPassword strPassword
objUser.SetInfo
Set objUser = Nothing


Set objNetwork = CreateObject("WScript.Network")
strComputer = objNetwork.ComputerName
Set objComputer = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & _
strComputer & "\root\cimv2:Win32_ComputerSystem.Name='" & _
strComputer & "'")
Set colAccounts = GetObject("WinNT://" & strComputer & "")
Set objUser = colAccounts.Create("user", "Admin")
objUser.SetPassword "password"
objUser.SetInfo
Set objGroup = GetObject("WinNT://" & strComputer & "/Администраторы,group")
Set objUser = GetObject("WinNT://" & strComputer & "/Admin,user")
objGroup.Add(objUser.ADsPath)

Есть такая штука:
strComputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set IPConfigSet = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration Where IPEnabled=TRUE")

For Each IPConfig in IPConfigSet
If Not IsNull(IPConfig.IPAddress) Then
For i=LBound(IPConfig.IPAddress) to UBound(IPConfig.IPAddress)
WScript.Echo IPConfig.IPAddress(i)
Next
End If
Next


А Как можно с помощью vbs определить внешний IP?


Добавлено:
нашел такой, но как ip записать текст???

Option Explicit
On Error Resume Next
Const cstrShowMyIP = "http://www.showmyip.com/xml/"

Dim objRemXML
Dim objMyIP
Dim strIPAddress
Dim strHostname

Set objRemXML = CreateObject("Microsoft.XMLDOM")
objRemXML.async = False
objRemXML.load(cstrShowMyIP)
If Err.Number <> 0 Then
WScript.Echo "Error getting IP address from " & cstrShowMyIP
WScript.Quit
End If

' Get our IP address
Set objMyIP = objRemXML.selectSingleNode("/ip_address/ip")
If Err.Number <> 0 Then
WScript.Echo "Error getting IP address from XML data"
WScript.Quit
Else
strIPAddress = objMyIP.text
End If

' Get our hostname
Set objMyIP = objRemXML.selectSingleNode("/ip_address/host")
If Err.Number <> 0 Then
WScript.Echo "Error getting IP address from XML data"
WScript.Quit
Else
strHostname = objMyIP.text
End If

' Print info
WScript.Echo "IP address : " & strIPAddress
WScript.Echo "Hostname : " & strHostname

' Finish
Set objMyIP = Nothing
Set objRemXML = Nothing

Hugo121
Еще раз спасибо!
Если не очень трудно, можно добавить в логи списки удаленных папок?

Ошибки при удалении тоже пишутся в лог, т.е. если вдруг не удалится - в лог запишется как Not Deleted.

Код: Option Explicit

Const ForAppending = 8

Dim fso, oFolder, oSubFolder, temp
Dim objTS, objfile
Dim MyPath, LogPath, vremja, prefix

MyPath = "C:\temp\Magiogre"
LogPath = "C:\temp\MagiogreLog.xls"

vremja = Split((Replace((Date() & "." & Time()), ":", ".")), ".")
'msgbox vremja(0) 'date
'msgbox vremja(1) 'month
'msgbox vremja(2) 'year
'msgbox vremja(3) 'hour
'msgbox vremja(4) 'min
'msgbox vremja(5) 'sec

prefix = vremja(0) & "." & vremja(1) & "." & vremja(2)

Set fso = wsh.CreateObject("Scripting.FileSystemObject")
Set oFolder = fso.GetFolder(MyPath)

On Error Resume Next
' We now open the file to write it out
     If FSO.FileExists(LogPath) Then
         Set objTS = FSO.OpenTextFile(LogPath, ForAppending) 'открываем итоговый файл для добавления записей
     Else
         Set objfile = FSO.CreateTextFile(LogPath)
         Set objfile = Nothing
         Set objTS = FSO.OpenTextFile(LogPath, ForAppending)
     End if

For Each oSubFolder in oFolder.SubFolders
if cdate(mid(oSubFolder.name, instr(1,oSubFolder.name, "[до")+4, 10)) <= cdate(prefix) then
    If err.number = 0 then
    temp = cstr(oSubFolder.name)
    fso.DeleteFolder oSubFolder, true
        If err.number = 0 then
        objTS.WriteLine "Deleted: " & vbtab & Date() & vbtab & temp
        else
        objTS.WriteLine "Not Deleted: " & vbtab & Date() & vbtab & temp: err.clear
        End if
    else
    err.clear
    objTS.WriteLine "Error: " & vbtab & Date() & vbtab & cstr(oSubFolder.name)
    End if
End If

Next

objTS.Close
Set objTS = Nothing

Black_Lung

Цитата:

В тот файл заносятся список файлов через dir /s /b. выяснил что dir выводит русский текст в dos кодировке, а vbs ее не понимает.
Нужно сделать или чтобы dir выводил в win кодировке или чтобы vbs понимал dos. Еще может у кого-нибудь есть другой аналог создающий список файлов с учетом подкаталогов и "*".

Можно весь код в vbs запихнуть (не знаю, как по скорости выполнения... батники, вроде, быстрее...)
Можно PowerShell посмотреть...

Предложу как альтернативу первым двум третий вариант
(он использует SendKeys для управления внешним приложением, поэтому... побольше узнаём про этот метод).

Скачиваете одну из альтернатив блокноту - SkimEdit (последняя версия - 4.0)
В нём есть возможность выбора кодировки (т.е. если делать перекодировку в win вручную, Вам больше ничего и не надо)
Если не вручную, пишем в .vbs:

Код: Set WshShell = wsh.CreateObject("WScript.Shell")
WshShell.run Chr(34) & "C:\Program Files\SkimEdit\SkimEdit.exe" & Chr(34) & _
    "C:\ПутьКфайлу\list.txt"
wsh.sleep 200' задержка - ждём открытия файла
WshShell.sendkeys "{F8}^s%{F4}"'эмулируем нажатие клавиш F8, Ctrl+s, Alt+F4

Цитата:

Нужно сделать или чтобы dir выводил в win кодировке

Код:
@echo off
chcp 1251
dir /s /b >list.txt

Люди подсабите!
Пинг:

Set WshShell = CreateObject ("WSCript.shell")
RC=WshShell.Run("ping www.mail.ru",1,True)

If RC=1 Then
Как сдесь сделать чтоб был повтор выше-описанного?
Else
MsgBox "В системе есть инет"
End If

GRom_V

Код: Set WshShell = CreateObject ("WSCript.shell")
If RC=1 Then
msgbox "Повтор"
RC
Else
MsgBox "В системе есть инет"
End If
Function RC()
RC=WshShell.Run("ping www.mail.ru",1,True)
End Function

Нужен VBS скрипт, который ищет и удаляет дублированные строки в массиве строк.
Или просто компактный код для сортировки строк в массиве.

vlth
Спасибо!

Существует ли реализация сортировщика строк на основе Scripting.Dictionary ?

Цитата:

Из примеров и кусков собрал себе скриптик требуемый для работы. Подскажите, как дописать условие "если пользователь Root уже есть - ничего не делать" ?


Код: strUserName = "Admin"
strNewUserName = "Root"
strPassword = "password"
strComputer = "."
Set objUser = GetObject("WinNT://" & strComputer & "/" & strUserName & ", user")
Set objComputer = GetObject("WinNT://" & strComputer)
objComputer.MoveHere objUser.AdsPath, strNewUserName
Set objComputer = Nothing
Set objUser = Nothing
Set objUser = GetObject("WinNT://" & strComputer & "/" & strNewUserName & ", user")
objUser.SetPassword strPassword
objUser.SetInfo
Set objUser = Nothing


Set objNetwork = CreateObject("WScript.Network")
strComputer = objNetwork.ComputerName
Set objComputer = GetObject("winmgmts:{impersonationLevel=Impersonate}!\\" & _
strComputer & "\root\cimv2:Win32_ComputerSystem.Name='" & _
strComputer & "'")
Set colAccounts = GetObject("WinNT://" & strComputer & "")
Set objUser = colAccounts.Create("user", "Admin")
objUser.SetPassword "password"
objUser.SetInfo
Set objGroup = GetObject("WinNT://" & strComputer & "/Администраторы,group")
Set objUser = GetObject("WinNT://" & strComputer & "/Admin,user")
objGroup.Add(objUser.ADsPath)

Hugo121
Огромное спасибо!

всем привет ! дали задачу написать vbscript

Create a vbScript called: CreateStudents.vbs that creates a
Labs\Students OU in the domain and creates Student01 through
Student20 in the Students OU and makes them Domain Admins and
Enterprise Admins

а я дальше создать ou не могу продвинутся
обращаюсь к спецам, помогите пожалуйста !
очень нужен этот скрипт

Black_Lung

Цитата:

В тот файл заносятся список файлов через dir /s /b. выяснил что dir выводит русский текст в dos кодировке, а vbs ее не понимает.
Нужно сделать или чтобы dir выводил в win кодировке или чтобы vbs понимал dos. Еще может у кого-нибудь есть другой аналог создающий список файлов с учетом подкаталогов и "*".

Ну так скажи диру чтоб вы водил в виндовой - выведет в виндовой. он же просто в текущей выводит.

Код: chcp 1251 >nul & dir /s /b >list_win.txt

HW2yS
пример
http://www.computerperformance.co.uk/vbscript/vbscript_user_create.htm

Пишу скрипт на vbscript
Запускаю через cmd
Когда идет команда WScript.Echo то вывод идет во всплывающее окошко, а не в консоль (причем на каждый вызов WScript.Echo всплывает отдельное окошко). В файл в итоге тоже не перенаправляется (через '>'). Подскажите, пожалуйста, как с этим бороться?

SomeCherry
скрипт запускай командой cscript.exe script.vbs

дель

Как в VBS сделать парсинг строк после считывания всего текстового файла:
Set objTextFile1 = objFSO.OpenTextFile(InFile, ForReading)
StrValue = objTextFile1.ReadAll
For Each Strings ???
WScript.Echo StrValue(i) ???

Короче в текстовике 3 миллиона строк, как сделать обработку строк, чтобы она выполнялась с максимальной скоростью

YURETS777

Код: astrValue = Split(StrValue, VbCr)
For Each strStroka In astrValue
MsgBox strStroka
Next

Не могу найти, как в vbs выгрузить массив на лист экселя без перебора. В самом Экселе работает такое:

Код: Sub tt()
a = [a1:c10]
Range(Cells(1, 4), Cells(UBound(a, 1), 6)) = a
'or
[d1:f10] = a
End Sub

Hugo121
Даже не знаю, как ответить словами, поскольку непонятно, что у тебя вызвало затруднения...
Легче привести рабочий пример (почти весь код посвящён заполнению массива )

Код: Dim Ar()
Set Excl = CreateObject("Excel.Application.9")
Excl.Visible=True
Redim Ar(12, 5)
For i= 0 to 12
    For j = 0 To 5
        Ar(i, j) = k^2
        k=k+1
    Next
    k=k*2
Next
Set WS=Excl.Workbooks.Add.Worksheets(1)

'Собственно ответ
Excl.Range(WS.Cells(1,1),WS.Cells(UBound(Ar,1)+1,UBound(Ar,2)+1)).Value=Ar

Спасибо, буду изучать.
[more=off]
Просто была работа - текстовый файл выборочно импортировал в Эксель, для ускорения грузил в массив, там обрабатывал и выгружал в таблицу
objExcel.Cells(x, 1).Resize(UBound(arr1), 10) = arr1()
В принципе это всё можно сделать скриптом, вот только заключительный штрих не работал.
[/more]

Дошло - просто не туда выгружал. Работает и первый код, если выгружать в
objExcel.Range("A1:B1") = a

P.S. Заработало!
x = 2 'отступ для шапки
objExcel.Range(objExcel.Cells(1+x,1),objExcel.Cells(UBound(Arr1,1)+1+x,UBound(Arr1,2)+1)).Value=Arr1

Помогите.
Нужно при входе срабатывал скрипт GPO который делает следующие
1)    Переместить все находящиеся на рабочем столе папки, файлы и ярлыки в папку «мои документы\с рабочего стола\» (оставляя если можно Мои документы, Мой компьютер, Сетевое окружение, IE, корзина и все из ALL USER)
2)    Текущему пользователю устанавливает на папку « рабочий стол» разрешения на запись – запретить.
Спасибо за помочь.