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

Demon L

Цитата:

Когда скрипт раскидывает файлы по папкам все ок но если там уже есть такой файл - вылазит ошибка

Перезапись осуществляется если местом назначения выбирается файл, а не папка. Поэтому так: [more]

Код:
Option Explicit

Dim CheckFile
Dim SourceDir
Dim OutDir
Dim OutAllDir
Dim FSO
Dim SHA
Dim BaseFile
Dim TextArray
Dim CountArray
Dim FilesArray
Dim i
Dim PathFile
Dim TxtFile
Dim Text
Dim TxsFile
Dim n
Dim TextItem

CheckFile = "C:\base.txt"
SourceDir = "C:\test"
OutDir = "C:\OUT"
OutAllDir ="C:\OUT_ALL"

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SHA = CreateObject("Shell.Application")

Set BaseFile = FSO.OpenTextFile(CheckFile)
TextArray = Split(BaseFile.ReadAll, vbNewLine)
BaseFile.Close

CountArray = UBound(TextArray)

Set FilesArray = SHA.Namespace(SourceDir).Items
FilesArray.Filter 192, "*.tkt"

For i = 0 To FilesArray.Count - 1
PathFile = FilesArray.Item(i).Path
Set TxtFile = FSO.OpenTextFile(PathFile)
Text = TxtFile.ReadAll
TxtFile.Close
TxsFile = FSO.GetBaseName(PathFile) & ".txs"
For n = 0 To CountArray
TextItem = TextArray(n)
If InStr(Text, TextItem) And TextItem <> "" Then
FSO.CopyFile FSO.BuildPath(SourceDir, TxsFile), FSO.BuildPath(OutDir, TxsFile)
FSO.CopyFile PathFile, FSO.BuildPath(OutDir, FSO.GetFileName(PathFile))
Exit For
End If
Next
FSO.CopyFile FSO.BuildPath(SourceDir, TxsFile), FSO.BuildPath(OutAllDir, TxsFile)
FSO.CopyFile PathFile, FSO.BuildPath(OutAllDir, FSO.GetFileName(PathFile))
Next

Rush
не совсем понял что это значит...

Цитата:

Перезапись осуществляется если местом назначения выбирается файл, а не папка

Обьясни плиз...

Demon L
Ну в первом скрипте просто была указана папка, куда копировать файлы. При таком раскладе перезапись файла, если он есть в конечной папке, не делалась.
Во втором скрипте кроме папки назначения указывается еще и имя файла. Перезапись происходит.
Да не бери в голову, это так - мысли вслух. Скрипт ведь переделанный перезаписывает файлы? Остальное лирика.

serg3001
Пути к папке с dbf и к папке вывода задаются константами вручную, на тестовом примере работает
[more]

Код:
Option Explicit

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Const sTitle = "Ошибка"
Const sChar = ":"
'Параметры подключения
Const sDNS1 ="Dsn=Файлы dBASE;dbq="
Const sDEF2 = ";defaultdir="
Const sPARAM3= ";driverid=533;maxbuffersize=2048;pagetimeout=5"
'Путь к папке, содержащей: accounts.dbf, rectranc.dbf, rectranh.dbf
Const sdbPath ="C:\BACKUP"
'Путь к папке, куда выводятся текстовые файлы
Const outPath = "C:\TEMP"

Dim pConn, pNames, pData, errButton, pItem
Dim sQuery, sFile, fso, pWriter, sOut
errButton = vbExclamation +vbOKOnly

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set pConn = CreateObject("ADODB.Connection")
Set pNames = CreateObject("ADODB.Recordset")

On Error Goto 0
Err.Clear
pConn.Open sDNS1 & sdbPath & sDEF2 & sdbPath & sPARAM3
If Err.Number <> 0 Then MsgBox "Ошибка создания подключения", errButton, sTitle: WScript.Quit

pNames.Open "Select accounts.INOUT From accounts Group By accounts.INOUT", _
     pConn, adOpenStatic, adLockOptimistic
If Err.Number <> 0 Then MsgBox "Ошибка чтения таблицы accounts", errButton, sTitle: WScript.Quit

If pNames.RecordCount > 0 Then
    Do Until pNames.EOF
        pItem = CStr(pNames.Fields.Item("INOUT"))
        Set pData = CreateObject("ADODB.Recordset")
        pData.Open "Select rectranh.HEAD2, rectranc.NFACC, rectranc.NAME, accounts.ENDSUM From accounts, rectranc, rectranh Where (accounts.TNUM = rectranc.TNUM) And (rectranc.CODE = rectranh.CODE) And (accounts.INOUT = '" & _
             pItem & "')", pConn, adOpenStatic, adLockOptimistic
        If pData.RecordCount > 0 Then
            sFile = fso.BuildPath(outPath, pItem & ".txt")
            Set pWriter = fso.CreateTextFile(sFile, True)
            Do Until pData.EOF
                sOut = pData.Fields.Item("HEAD2") & sChar
                sOut = sOut & pData.Fields.Item("NFACC") & sChar
                sOut = sOut & pData.Fields.Item("ENDSUM") & sChar
                sOut = sOut & pData.Fields.Item("NAME")
                pWriter.WriteLine sOut
                pData.MoveNext
            Loop
            pWriter.Close
        End If
        pNames.MoveNext
    Loop
pConn.Close
MsgBox "Выполнено"
Else
    pConn.Close
    MsgBox "Таблица acconts не содержит записей", errButton, sTitle
End If

AndVGri
Спасибо за код, но призапуске файла vbs выдается сообщение

serg3001
попробуй заменть (может с ODBC проблемы?) у меня работают оба варианта под WinXP32

Цитата:

'pConn.Open sDNS1 & sdbPath & sDEF2 & sdbPath & sPARAM3

на

Код:
Dim strConn

strConn = "Provider=Microsoft.Jet.OLEDB.4.0;Data Source=" & sdbPath
strConn = strConn & ";Extended Properties=dBASE IV;User ID=Admin;Password=;"
pConn.Open strConn

AndVGri
заменил, выполнилось всё, но вот ещё загвозка, кодировка у dbf файлов DOS, необходимо перевести в windows 1251.
Подскажите, а если использовать txt формат файлов, то что необходимо поменять в коде?

Добрый день!

Помогите написать скрипт который:
1)Запускает приложение.
2)Поочередно открывает каждый элемент его проводника в отдельном окне(стать левой клавишей мыши на элемент проводника, после нажать правую клавишу и выбрать "Open in new window")
Вот начало:

Dim WS
Set WS = WScript.CreateObject("WScript.Shell")
WS.run chr(34)+"C:\Program Files\System Center Operations Manager 2007\Microsoft.MOM.UI.Console.exe"+chr(34)
WshShell.SendKeys("My Workspace")

Заранее спасибо!

Rush
да! Все ок. Спасибо.

serg3001
Так у меня dbf (созданы через Access) в DOS кодировке. Скорее всего у тебя dbf в Win1251, если так, то попробуем с другим provider для visual foxpro (его, правда, нужно будет скачать) - он как раз работает с Win1251.
А с текстовыми - попробовал, что то не может выполнить запрос, а времени, да и желания, особо нет. Так что похоже, увы.
Выложи кусочек своих dbf для теста, посмотрю, что можно будет сделать с ними

serg3001
Предположение, по твоим dbf файлам, подтвердилось - кодировка Win1251 (она и в поле кодировки прописана, как показывает xBaseView).
Скачай visual forxpro ole db и установи
[more=А код будет такой]

Код:
Option Explicit

Const adOpenStatic = 3
Const adLockOptimistic = 3
Const adCmdText = &H0001
Const sTitle = "Ошибка"
Const sChar = ":"
'Путь к папке, содержащей: accounts.dbf, rectranc.dbf, rectranh.dbf
Const sdbPath ="C:\BACKUP\"
'Путь к папке, куда выводятся текстовые файлы
Const outPath = "C:\TEMP"

Dim pConn, pNames, pData, errButton, pItem
Dim sQuery, sFile, fso, pWriter, sOut

errButton = vbExclamation + vbOKOnly

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set pConn = CreateObject("ADODB.Connection")
Set pNames = CreateObject("ADODB.Recordset")

On Error Goto 0

Err.Clear
pConn.Open "Provider=vfpoledb;Data Source=" & sdbPath & ";Collating Sequence=russian;"
If Err.Number <> 0 Then MsgBox "Ошибка создания подключения", errButton, sTitle: WScript.Quit

Err.Clear
pNames.Open "Select accounts.INOUT From accounts Group By accounts.INOUT", _
pConn, adOpenStatic, adLockOptimistic
If Err.Number <> 0 Then MsgBox "Ошибка чтения таблицы accounts", errButton, sTitle: WScript.Quit

If pNames.RecordCount > 0 Then
Do Until pNames.EOF
pItem = (CStr(pNames.Fields.Item("INOUT")))
Set pData = CreateObject("ADODB.Recordset")
sQuery = "Select rectranh.HEAD2, rectranc.NFACC, rectranc.NAME, accounts.ENDSUM From accounts, rectranc, rectranh Where (accounts.TNUM = rectranc.TNUM) And (rectranc.CODE = rectranh.CODE) And (accounts.INOUT = '" & pItem & "')"
pData.Open sQuery, pConn, adOpenStatic, adLockOptimistic

If pData.RecordCount > 0 Then
sFile = fso.BuildPath(outPath, pItem & ".txt")
Set pWriter = fso.CreateTextFile(sFile, True)
Do Until pData.EOF
sOut = Trim(pData.Fields.Item("HEAD2")) & sChar
sOut = sOut & Trim(pData.Fields.Item("NFACC")) & sChar
sOut = sOut & Trim(pData.Fields.Item("ENDSUM")) & sChar
sOut = sOut & Trim(pData.Fields.Item("NAME"))
pWriter.WriteLine sOut
pData.MoveNext
Loop
pData.Close
pWriter.Close
End If
pNames.MoveNext
Loop
pNames.Close
pConn.Close
MsgBox "Выполнено"
Else
pNames.Close
pConn.Close
MsgBox "Таблица acconts не содержит записей", errButton, sTitle
End If

Подскажите, как в VBS получить доступ к IDLE таймеру в винде (ХР), по которому, в т.ч. запускается хранитель экрана?

Т.е. нужно отследить начало простоя и окончание...

Хотя Windows Media Player может обнулять IDLE таймер... тогда, наверное лучше контролировать напрямую INPUT (клава+мышь)

Добрый день!
подскажите пожалуйста, есть ли скрипт который меняет вход в домен по умолчанию?
а то после миграции компьютер со старого домена на новый люди по привычке заходят в старый...
компы с windows xp

Цитата:

Добрый день!
подскажите пожалуйста, есть ли скрипт который меняет вход в домен по умолчанию?
а то после миграции компьютер со старого домена на новый люди по привычке заходят в старый...
компы с windows xp

Тут даже скрипт не нужен:
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon]
"DefaultDomainName"="Domain"

на каждом ПК. Как внедрять reg-файл скриптом думаю объяснять не надо.

Цитата:

Тут даже скрипт не нужен:
[HKEY_LOCAL_MACHINE\SOFTWARE\Microsoft\Windows NT\CurrentVersion\Winlogon]
"DefaultDomainName"="Domain"

на каждом ПК. Как внедрять reg-файл скриптом думаю объяснять не надо.

Спасибо большое! решил внедрить через psexec -s \\* c:\windows\regedit.exe /s \\share\files\reg.reg >>log.log

Средствами vbs можно запускать процесс родственный только первому ядру?

Как можно из скрипта vbs передать в звуковую карту (на колонки) тон зуковой частоты определенной частоты и длительности.

Проигрывать файл не предлагать - частота тона, длительность и время между посылками будет меняться в цикле, в достаточно больших пределах.

Нужно для подбора служебного сигнала Отбой одной очень специфичной железяки с подключенным телефонным интерфейсом.

Заранее спасибо

Товарищи, подскажите!!!Хочю переименовать папки и чтобы новое название папки содержало ГГГГММДД файла которого я до этого копирую.

txtFileCreationDate и f обьявилены в public. f - дата создания файла (f = file.DateCreated)


Код: Function Rename

Dim fso, folderRename, path_1, path_2, path_3, path_4, path_01
set fso = createobject("Scripting.FileSystemObject")
Set folderRename = CreateObject("Scripting.FileSystemObject")
path_01 = "C:\New"
'path_02 =
txtFileCreationDate = left(f,10)
path_3 = "C:\Yo"
path_4 = path_3 + right(txtFileCreationDate,4) & left(right(txtFileCreationDate,7),2)& left(right(txtFileCreationDate,10),2)

folderRename.MoveFolder path_01, path_4
folderRename.MoveFolder "C:\1" , "C:\2"



if not fso.folderexists(path_1) then folderRename.MoveFolder "C:\New" , path_4
if not fso.folderexists(path_2) then folderRename.MoveFolder "C:\1" , "C:\2"
End Function

KillaJ
Вот функция возвращает
Цитата:

ГГГГММДД

по переданной дате

Код:
Function DateToStr(thisDate)
    Dim sPart
    DateToStr = CStr(Year(thisDate))
    sPart = Month(thisDate)
    If Len(sPart) < 2 Then sPart = "0" & sPart
    DateToStr = DateToStr & sPart
    sPart = CStr(Day(thisDate))
    If Len(sPart) < 2 Then sPart = "0" & sPart
    DateToStr = DateToStr & sPart
End Function

AndVGri
Как сделать дату ГГГГММДД я знаю.Не могу понять почему не получается ГГГГММДД прибавить к названию папки которую переименовываю.
То есть у меня есть папка "C:\Yo" а я хочю ее переименовать в "C:\Yo ГГГГММДД"(и чтобы обязательно был пробел между названием папки и датой).

Вот как я делаю и не получается:


Код: path_01 = "C:\New"
txtFileCreationDate = left(f,10)
path_3 = "C:\Yo"
path_4 = path_3 + right(txtFileCreationDate,4) & left(right(txtFileCreationDate,7),2)& left(right(txtFileCreationDate,10),2)

folderRename.MoveFolder path_01, path_4

KillaJ

Цитата:

path_4 = path_3 + right(txtFileCreationDate,4) & left(right(txtFileCreationDate,7),2)& left(right(txtFileCreationDate,10),2)

Ты все также продолжаешь упорствовать в этой дурацкой конструкции?
Ведь еще месяц назад сказано было:

Цитата:

left(right(t,7),2) & left(right(t,10),2) - это, вообще, что-то. Нужно было просто: mid(t,4,2) & left(t,2)

Чтобы задать пробел, его надо обозначить.

Код: path_4 = path_3 & " " &

Цитата:

То есть у меня есть папка "C:\Yo" а я хочю ее переименовать в "C:\Yo ГГГГММДД"

Кстати, почему тогда ты переименовываешь не папку "C:\Yo", а какую-то папку "C:\New"?

Добрый день, Rush!


Код: Ты все также продолжаешь упорствовать в этой дурацкой конструкции?

Здравствуйте! Помогите написать скрипт для бэкапа =)

Имеется сетевая папка на сервере Windows и сетевое хранилище NAS.
Нужен скрипт, который будет запускаться планировщиком Windows и копировать эту папку (и всё её содержимое) на NAS по следующему алгоритму:

1. Монтируем сетевой диск:
Dim net
Set net = CreateObject("Wscript.Network")
net.MapNetworkDrive "L:","\\192.168.1.20\backup", "true", "login", "password"

2. Ждём:
WScript.Sleep(30000)

3. Копируем с заменой:
???

4. Отключаем сетевой диск:
net.RemoveNetworkDrive "L:","true", "true"

Также было бы не плохо усложнить задачу (если это возможно реализовать средствами VBS).
Перед началом выполнения предыдущей задачи, проверить, имеются ли пользователи, работающие с исходной папкой, её подпапками, вложенными в папку и подпапки файлами. Если такие пользователи есть, то:
-В первом случае, прекращаем дальнейшую работу скрипта,
-А во втором случае, отключаем ("кикаем") их всех и выполнить скрипт с п1.

Заранее благодарствую=)

KillaJ

Цитата:

Как сделать дату ГГГГММДД я знаю.Не могу понять почему не получается ГГГГММДД прибавить к названию папки которую переименовываю.

Ну так и переименовывай

Код:
Dim fso, pFolder
Set fso = WScript.CreateObject("Scripting.FileSystemObject")
If fso.FolderExists("C:\needFolder") Then
Set pFolder = fso.GetFolder("c:\needFolder")
pFolder.Name = pFolder.Name & " " & DateToStr(Now)
End If

Добрый день!
Помогите написать скрипт который:
1)Запускает приложение.
2)Поочередно открывает каждый элемент его проводника в отдельном окне(стать левой клавишей мыши на элемент проводника, после нажать правую клавишу и выбрать "Open in new window")
Вот начало:

Dim WS
Set WS = WScript.CreateObject("WScript.Shell")
WS.run chr(34)+"C:\Program Files\System Center Operations Manager 2007\Microsoft.MOM.UI.Console.exe"+chr(34)
WshShell.SendKeys("My Workspace")

Заранее спасибо!

adminchik2010

Сходи сюда Autoit3 с горячими клавишами и с работой окон, это больше подойдет имхо.

Спасибо!

Есть задача: в текстовом файле в начале каждой строки удалить два символа, сократив её таким образом. Проблема в том, что не понятно на чём это писать(не умею, пытался разобраться с VBS - но что-то пока никак), и второе - в середине строки есть ещё один символ перевода, который не понимает Notepad, но зато понимают более продвинутые текстовые редакторы.
VBS для такой задачи подойдёт?

XMMS

Цитата:

VBS для такой задачи подойдёт?

Подойдет.

Цитата:

в середине строки есть ещё один символ перевода, который не понимает Notepad, но зато понимают более продвинутые текстовые редакторы.

Видимо, или юниксовый - из одного символа chr(10), или маковский - chr(13).

Код: Option Explicit

Dim fso
Dim FileName
Dim TextFile
Dim Text

FileName = "x:\file.ext" ' Заменить на свой файл

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set TextFile = fso.OpenTextFile(FileName)
Text = TextFile.ReadAll
TextFile.Close

Text = ReplaceText(Mid(Text, 3), "\r\n.{2}", VbCrLf)
Text = ReplaceText(Text, "([^\r])\n*", "$1")
Text = ReplaceText(Text, "\r*([^\n])", "$1")

Set TextFile = fso.OpenTextFile(FileName, 2)
TextFile.Write Text
TextFile.Close

Function ReplaceText(Txt, Mask, Out)
Dim RegExp
Set RegExp = WScript.CreateObject("VBScript.RegExp")
RegExp.Pattern = Mask
RegExp.Global = True
ReplaceText = RegExp.Replace(Txt, Out)
Set RegExp = Nothing
End Function