Перейти из форума на сайт.

НовостиФайловые архивы
ПоискАктивные темыТоп лист
ПравилаКто в on-line?
Вход Забыли пароль? Первый раз на этом сайте? Регистрация
Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript

Модерирует : ShIvADeSt

ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1  Версия для печати • ПодписатьсяДобавить в закладки
Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

   

Hugo121

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Ну вот так например, потестите в сети - поменяйте путь в MyPath на сетевой (в конце нет слэша!):

Код:
Option Explicit  
 
Dim fso, oFolder, oSubFolder  
Dim MyPath, vremja, prefix  
 
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)  
 
MyPath = "C:\temp\Magiogre"
Set fso = wsh.CreateObject("Scripting.FileSystemObject")  
Set oFolder = fso.GetFolder(MyPath)  
 
For Each oSubFolder in oFolder.SubFolders  
if cdate(mid(oSubFolder.name, instr(1,oSubFolder.name, "[до")+4, 10)) <= cdate(prefix) then fso.DeleteFolder oSubFolder, true
Next  

Всего записей: 128 | Зарегистр. 14-08-2007 | Отправлено: 15:02 17-05-2010 | Исправлено: Hugo121, 15:05 17-05-2010
magiogre



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Работает! Спасибо!

Всего записей: 104 | Зарегистр. 26-01-2009 | Отправлено: 15:43 17-05-2010 | Исправлено: magiogre, 15:48 17-05-2010
Hugo121

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Ну а пробел добавили после "[до"?
Эта ошибка означает, что выделенные 10 символов не дата.
Принимайте санкции
А вообще-то надо в код добавить "On Error resume next", а то будет ругаться на каждую такую ошибку.
Блин, не добавляйте!!! Удалит всё неспросясь... Счас...
 
Вот, вроде так - внизу замените блок именно удаления:

Код:
 
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
    err.clear
End If
Next  

 
И кстати тут можно добавить лог с именами папок, где случаются ошибки в дате, т.е. если err.number <> 0 то берём на заметку, к кому санкции применять

Всего записей: 128 | Зарегистр. 14-08-2007 | Отправлено: 15:49 17-05-2010 | Исправлено: Hugo121, 16:13 17-05-2010
magiogre



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Hugo121
Огромное спасибо!
Логи вообще штука хорошая!

Всего записей: 104 | Зарегистр. 26-01-2009 | Отправлено: 17:10 17-05-2010
Hugo121

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Ну вот так, что писать - можно и переделать, сейчас пишется дата ошибки и имя папки, пути  
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  

 
Может конечно и зря на каждый еррор заново файл открываю, но я думаю ерроры будут в будущем редко, если за них взяться (за юзеров )
 
P.S. Кстати, если поменять на

Код:
LogPath =  "C:\temp\MagiogreLog.xls"

и

Код:
   objTS.WriteLine Date() & vbtab & cstr(oSubFolder.name)

то получим по сути текстовый файл, но который отлично открывается Экселем со всеми бонусами - сортировка, подсчёт и т.д.

Всего записей: 128 | Зарегистр. 14-08-2007 | Отправлено: 17:17 17-05-2010 | Исправлено: Hugo121, 17:30 17-05-2010
Black_Lung



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

Всего записей: 275 | Зарегистр. 09-10-2008 | Отправлено: 18:17 18-05-2010
vlth

Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
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

 
Добавлено:

Цитата:
Как сделать чтобы скрипт понимал русский текст. У меня вместо русск букв глюки.

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

Всего записей: 258 | Зарегистр. 22-01-2008 | Отправлено: 19:25 18-05-2010
Black_Lung



Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
vlth
Спасибо

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

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

Всего записей: 275 | Зарегистр. 09-10-2008 | Отправлено: 11:00 19-05-2010 | Исправлено: Black_Lung, 12:04 19-05-2010
arr1val

Junior Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Из примеров и кусков собрал себе скриптик требуемый для работы. Подскажите, как дописать условие "если пользователь 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)  

Всего записей: 43 | Зарегистр. 01-02-2008 | Отправлено: 13:49 19-05-2010
GRom_V

Full Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Есть такая штука:
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

Всего записей: 466 | Зарегистр. 31-10-2006 | Отправлено: 13:51 19-05-2010 | Исправлено: GRom_V, 15:48 19-05-2010
magiogre



Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Hugo121
Еще раз спасибо!
Если не очень трудно, можно добавить в логи списки удаленных папок?

Всего записей: 104 | Зарегистр. 26-01-2009 | Отправлено: 15:48 19-05-2010
Hugo121

Junior Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Ошибки при удалении тоже пишутся в лог, т.е. если вдруг не удалится - в лог запишется как 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
 

Всего записей: 128 | Зарегистр. 14-08-2007 | Отправлено: 16:46 19-05-2010 | Исправлено: Hugo121, 16:53 19-05-2010
vlth

Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
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

Всё - список перекодирован.

Всего записей: 258 | Зарегистр. 22-01-2008 | Отправлено: 17:18 19-05-2010
igor_andreev

Advanced Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору

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

 

Код:

@echo off
chcp 1251
dir /s /b >list.txt


Всего записей: 1704 | Зарегистр. 08-12-2004 | Отправлено: 02:35 20-05-2010
GRom_V

Full Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
Люди подсабите!
Пинг:
 
Set WshShell = CreateObject ("WSCript.shell")  
RC=WshShell.Run("ping www.mail.ru",1,True)  
 
If RC=1 Then  
   Как сдесь сделать чтоб был повтор выше-описанного?
 Else  
   MsgBox "В системе есть инет"  
End If

Всего записей: 466 | Зарегистр. 31-10-2006 | Отправлено: 08:20 20-05-2010
vlth

Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
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

 
Добавлено:
igor_andreev

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

 
Вот чего выдаёт:

Цитата:
C:\Docunents and Settings\...>chcp /? "chcp" не является внутренней или внешней
командой, исполняемой программой или пакетным файлом.
Решение

Всего записей: 258 | Зарегистр. 22-01-2008 | Отправлено: 11:03 20-05-2010
YURETS777



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Нужен VBS скрипт, который ищет и удаляет дублированные строки в массиве строк.
Или просто компактный код для сортировки строк в массиве.

Всего записей: 2161 | Зарегистр. 29-04-2005 | Отправлено: 15:19 20-05-2010
GRom_V

Full Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору
vlth
Спасибо!

Всего записей: 466 | Зарегистр. 31-10-2006 | Отправлено: 16:04 20-05-2010
YURETS777



Silver Member
Редактировать | Профиль | Сообщение | Цитировать | Сообщить модератору
Существует ли реализация сортировщика строк на основе Scripting.Dictionary  ?

Всего записей: 2161 | Зарегистр. 29-04-2005 | Отправлено: 17:25 20-05-2010
arr1val

Junior Member
Редактировать | Профиль | Сообщение | ICQ | Цитировать | Сообщить модератору

Цитата:
Из примеров и кусков собрал себе скриптик требуемый для работы. Подскажите, как дописать условие "если пользователь 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)  

 
Методом "на ошибке работай дальше" первый вопрос решил. Подскажите второй, приведенный скрипт не работает на win2k. Что заменить на что ?

Всего записей: 43 | Зарегистр. 01-02-2008 | Отправлено: 20:46 20-05-2010
   

Страницы: 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112

Компьютерный форум Ru.Board » Компьютеры » Прикладное программирование » Программирование "удобняшек" на VBScript
ShIvADeSt (12-07-2011 15:12): http://forum.ru-board.com/topic.cgi?forum=33&topic=11963#1


Реклама на форуме Ru.Board.

Powered by Ikonboard "v2.1.7b" © 2000 Ikonboard.com
Modified by Ru.B0ard
© Ru.B0ard 2000-2024

BitCoin: 1NGG1chHtUvrtEqjeerQCKDMUi6S6CG4iC

Рейтинг.ru