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

день добрый, столкнулся с проблемой, необходим скрипт эмитирующий нажатие сочетания клавиш win+L
, если данный скрипт где то уже был прошу прощения и ссылку на него если нет то прошу помочь в его реализации,почему то не смог найти как такое сделать заранее благодарен.

KillaJ

Цитата:

Я хочю сделать так, чтобы в папке из которой копирую файлы, брать дату создания файла и переносить в созданную папку имя которой дата создания файла в формате YYYYMMDD.

Код:
Option Explicit

Dim fso, path_1, path_2, ext, file, f, yyyy, mm, dd, path_dest

path_1 = "C:\Folder1"
path_2 = "c:\VB\MyFolder"
ext = "txt"

Set fso = CreateObject("Scripting.FileSystemObject")
CreateDir path_2

For Each file In fso.GetFolder(path_1).Files
If fso.GetExtensionName(file) = ext Then
f = file.DateCreated
yyyy = Year(f)
mm = Month(f)
dd = Day(f)
path_dest = path_2 & "\" & yyyy & _
String(2 - Len(mm), "0") & mm & _
String(2 - Len(dd), "0") & dd & "\"
If Not fso.FolderExists(path_dest) Then _
fso.CreateFolder path_dest
fso.CopyFile file, path_dest & fso.getfilename(file)
End If
Next

Sub CreateDir(strPath)
Dim DirArray, strRoot, i, strTree
DirArray = Split(strPath, "\")
strRoot = Dirarray(0) & "\"
For i = 1 To UBound(DirArray)
strTree = strTree & DirArray(i) & "\"
If Not fso.FolderExists(strRoot & strTree) Then _
fso.CreateFolder strRoot & strTree
Next
End Sub

zavulonx

Цитата:

день добрый, столкнулся с проблемой, необходим скрипт эмитирующий нажатие сочетания клавиш win+L

Rundll32.exe User32.dll,LockWorkStation

Rush, спасибо!Но я уже написал свой.

Вот, если кому пригодится.


Код: Option Explicit

Dim t, n, ext, path_1, path_2, path_3, info, fso, shell, f, file

set fso = createobject("Scripting.FileSystemObject")
set shell = WScript.CreateObject("WScript.Shell")
path_1 = "C:\Folder1"
path_2 = "c:\VB\"
ext = "txt"
n=0
if not fso.folderexists(path_2) then fso.createfolder(path_2)
for each file in fso.getfolder(path_1).files
    f = file.DateCreated

    n=n+1
'info = "Файл " & WScript.ScriptName & " :" & Chr(10)
'info = info & "Создан: " & f & Chr(10)
info = "Количество отчетов: " & n & Chr(10)
t = left(f,10)
path_3 = path_2+right(t,4) & left(right(t,7),2) & left(right(t,10),2)

if not fso.folderexists(path_3) then fso.createfolder(path_3)


if fso.getextensionname(file) = ext then fso.movefile file, path_3 & "\" & fso.getfilename(file)

next

Msgbox info

KillaJ

Цитата:

Вот, если кому пригодится.

1) set shell = WScript.CreateObject("WScript.Shell") совершенно лишнее - объект у тебя не используется.
2) Зачем обрабатывать все файлы - тебе ведь надо только с расширением txt?
3) info = "Количество отчетов: " & n & Chr(10) - здесь у тебя будет не количество отчетов, а количество файлов в папке. И написать это надо было не в цикле, а после. И новая строка там ни к чему.
4) left(right(t,7),2) & left(right(t,10),2) - это, вообще, что-то. Нужно было просто: mid(t,4,2) & left(t,2)
5) Закомментированные строки совершенно не относятся к скрипту, зачем они там?

Рановато тебе еще рекомендовать свои скрипты к использованию - надо бы самому в них понимать как они работают. Без обид, я по дружески.

Rush, спасибо за комментарий!B VBS всего неделю.Поэтому не судите строго за ошибки.Скрипт свой не рекомендовал, а выложил чтоб был пример.Спасибо за пункт 2), пункт 3) в моем случае мне подходит, потому что в папке будут только отчеты.
К сожалению, пока нет времени попробывать твой скрипт.

посоветуйте как из vbs скрипта пропроверить установленность конкретного принтера?

или хотя бы как ключик в регистри почитать...

wolf0425
Поскольку принтера у меня нет - правильность работы скрипта не проверить никак.
Название взял первое попавшееся в гугле.

Код: Set objWMI = GetObject _
("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")
Set objPrinters = objWMI.ExecQuery _
("Select * from Win32_Printer Where DeviceID = 'Samsung SCX-3200'")
If objPrinters.Count > 0 Then
For Each objPrinter in objPrinters
If objPrinter.Availability = 11 Then
Wscript.Echo "Принтер ""Samsung SCX-3200"" не установлен"
End If
Next
Else
Wscript.Echo "Принтер ""Samsung SCX-3200"" не установлен"
End If

Есть такая задача:
В одной папке лежит файл. В другой - его резервная копия. Мне надо сделать скриптик, который проверял бы размер файла исходника и если он больше 50 килобайт, то копировал бы его с перезаписью и без вопросов в папку резервной копии, а если меньше, то перезаписывал бы исходник файлом из резервной копии (тоже без подтверждений). Поможете?

abz

Код: Option Explicit

Dim fso, SourFile, DestFile

SourFile = "source file path"
DestFile = "backup file path"

Set fso = CreateObject("Scripting.FileSystemObject")

If fso.GetFile(SourFile).Size > 52100 Then
fso.CopyFile SourFile, DestFile
Else
fso.CopyFile DestFile, SourFile
End If

Rush

Спасибо. Всё как требовалось!

как седлать ветвление (прекратить скрипт) если пользователь залогинен не локально на компе, а куда-то терминалом зашел?

Ребята, пожалуйста, помогите решить такую задачу. Хотелось бы создать скрипт позволяющий копировать файлы находящиеся в одной папке со скриптом в произвольный каталог (т.е. с выбором целевого каталога). При совпадении имен копируемых файлов с именами файлов в директории назначения, должно выполняться резервное копирование последних в папку Backup. Буду очень благодарен Вашей помощи!

Добрый день!
Помогите написать скрипт который:
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")

Заранее спасибо!
http://img508.imageshack.us/i/30329188.jpg/

Здравствуйте! Помогите пожалуйста. Нужна програмка, которая могла брать информацию о архивах из определенной папки (что бы можно было указывать путь в программе/скрипте или же из той папке, где находится исполняемый файл) в текстовый документ. А именно информацию о количестве архивов, размере архива (лучше в МБ, но можно в чём угодно) и название архива. Сохраняло это всё в текстовый документ, разделяя запятыми.
Архивы как .RAR так и .ZIP (можно разные программы для разных архивов).
Пример:

Код: nero6.rar,31,87.65
iaud.zip,98,0.31

Artem_Butenko
[more]

Код:
Option Explicit
''' Путь к папке резервного копирования
Const backupPath = "c:\backup"

Dim curPath, destPath, sScript
Dim destFile, backupFile, sName
Dim fso, pShell, pFolder, pItem, pFile

Set fso = WScript.CreateObject("Scripting.FileSystemObject")
Set pShell = WScript.CreateObject("Shell.Application")

Set pFolder = pShell.BrowseForFolder(0,"Выбор папки для копирования",0)

If Not pFolder Is Nothing Then
    Set pItem = pFolder.ParentFolder.ParseName(pFolder.Title)
    destPath = pItem.Path: sScript = WScript.ScriptFullName
    curPath = fso.GetParentFolderName(sScript)
    Set pFolder = fso.GetFolder(curPath)
    If pFolder.Files.Count > 0 Then
        For Each pFile In pFolder.Files
            If StrComp(pFile, sScript, vbTextCompare) <> 0 Then
                sName = fso.GetFileName(pFile)
                destFile = fso.BuildPath(destPath, sName)
                backupFile = fso.BuildPath(backupPath, sName)
                If fso.FileExists(destFile) Then
                    If fso.FileExists(backupFile) Then fso.DeleteFile(backupFile)
                    fso.MoveFile destFile, backupFile
                End If
                fso.CopyFile pFile, destFile
            End If
        Next
        MsgBox "Скопировано файлов: " & CStr(pFolder.Files.Count), vbInformation + vbOKOnly, "Завершено"
    End If
End If

Добрый день!
Подскажите как реализовать, сортировку файлов по папкам (по <b>ВРЕМЕНИ</b> создания, не по дате, т.е чтобы скрипт создавал новые папки по формату ЧЧ-ММ и туда сортировал файлы).

Есть готовый скрипт "Сортирование файлов по папкам" by Petya V4sechkin. Можно его доработать?


Dim FSO, FldN, Fls, Fl, D, DtN, FlN
Set FSO = WScript.CreateObject("Scripting.FileSystemObject")

If WScript.Arguments.Count = 0 Then
MsgBox "Не задано имя папки для распределения файлов по датам. ", vbExclamation, "Ошибка"
WScript.Quit
End If

FldN = WScript.Arguments(0)
If Not FSO.FolderExists(FldN) Then
MsgBox "Папка """ & FldN & """ не существует. ", vbExclamation, "Ошибка"
WScript.Quit
End If

Set Fls = FSO.GetFolder(FldN).Files
For Each Fl In Fls
D = GetDateName(Fl.DateLastModified)
DtN = FSO.BuildPath(FldN, D)
If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN

FlN = FSO.BuildPath(DtN, Fl.Name)
If FSO.FileExists(FlN) Then
If MsgBox("Файл """ & Fl.Name & """ уже существует в папке """ & D & """. " & vbCr & "Перезаписать?", vbQuestion + vbOKCancel, "Внимание") = vbOK Then
FSO.DeleteFile FlN, True
Fl.Move FlN
End If
Else
Fl.Move FlN
End If
Next

MsgBox "Скрипт завершен. ", vbInformation, "Финиш"
WScript.Quit

Private Function GetDateName(Dt)
Dim M, D

M = Month(Dt)
D = Day(Dt)
If M < 10 Then M = "0" & M
If D < 10 Then D = "0" & D

GetDateName = Year(Dt) & "-" & M & "-" & D
End Function

Suprus
Поменяй

Цитата:

Private Function GetDateName(Dt)

на
[more]

Код:
Private Function GetTimeName(Dt)
    Dim H, M
    H = Hour(Dt)
    If H < 10 Then H = "0" & H
    M = Minute(Dt)
    If M < 10 Then M = "0" & M
    GetTimeName = CStr(H) & "-" & CStr(M)
End Function

AndVGri, спасибо за быстрый отклики.

При выполнение ошибка: Windows Script Host
Строка: 17 Символ: 3 Ошибка: Несоответствие типа 'GetDateName' Код: 800A000D Источник: Ошибка выполнения Microsoft VBScript

Добавлено:

Цитата:

Set Fls = FSO.GetFolder(FldN).Files
For Each Fl In Fls
D = GetDateName(Fl.DateLastModified)
DtN = FSO.BuildPath(FldN, D)
If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN

Может D = GetDateName(Fl.DateLastModified) стоит заменить на что-то другое?
что то вроде D = GetTimeName (параметр).

P.s: VBScript не знаю, сразу извиняюсь если глупости пишу..

Добавлено:

Цитата:

Set Fls = FSO.GetFolder(FldN).Files
For Each Fl In Fls
D = GetTimeName(Fl.DateLastModified)
DtN = FSO.BuildPath(FldN, D)
If Not FSO.FolderExists(DtN) Then FSO.CreateFolder DtN

Заменил значение GetDateName на GetTimeName, параметр оставил Fl.DateLastModified и все заработало.

Здравствуйте.
В vbs я новичок, не взыщите...
Есть батник из которого будет создаваться и запускаться vbs.
Код: @Echo Off
SetLocal EnableDelayedExpansion
Set pass=gora
Del iPass.txt 2>Nul

(Echo iPass = InputBox^("Введите пароль для шифрования архива","Шифрование архива","%pass%"^)
Echo If iPass = "" Then WScript.Quit
Echo Hder = MsgBox^("Шифровать имена файлов?",4,"Шифрование архива"^)
Echo Set FSO = CreateObject^("Scripting.FileSystemObject"^)
Echo Set f = FSO.OpenTextFile^("iPass.txt", 2, True^)
Echo f.WriteLine Hder ^& "," ^& iPass
Echo f.Close)>inPass.vbs

CSCRIPT inPass.vbs //NOLOGO
If Exist iPass.txt (
    For /F "tokens=*" %%i In (iPass.txt) Do (
        Set ti=%%i
        Set passAr=-p"!ti:~2!"
        If "!ti:~0,1!"=="6" Set passAr=!passAr! -mhe
    )
)
Echo Switch    %passAr%
Pause>Nul

подскажите, можно ли с помощью скрипта экспортировать раздел реестра? нужна кодировка именно UTF-8 а не простой Unicode

да можно.

bomzzz
ммм... а каким макаром?

жди кто нибудь ответит. у меня винт слетел сижу на абсолютно пустом винте никаких записей нету.... нелодлго надеюсь.
ну ты в принципе правельна к вбс скриптам обращаешьсяо ни появились в винде как альтернатива батникам. только все равно лучше сразу нормальный язык учить

нашел только RegWrite, RegRead, RegDelete. а как сделать экспорт раздела в файл?

ну не помню - погугли все в инете есть с примерами. я так и нашел, не сам же придумал.

Господа – гуру помогите решить задачку:
Есть папка (C:\test) в нее падают текстовые файлики парами (123456789.tkt и 123456789.txs) и файл «C:\base.txt» в нем в столбик перечислено, что нужно искать (одно значение на одну строку).
Примерно так:
Hdbjdmk
Hgj49cdkrp0
Hsdey568dmk
123445566
итд
Требуется проверить содержимое одного файла (скажем 123456789.tkt) выяснить есть ли там что либо из «base.txt». И если есть – скопировать этот файл и его пару в папку C:\OUT а также все обработанные файлы переместить в C:\OUT_ALL
Таким образом в C:\OUT_ALL должны быть все файлы а в C:\OUT только те в которых есть значения из C:\base.txt

Заранее спасибо за помощь !!

Уважаемые программисты, подскажите, возможно ли средствами VBS решить следующую задачу.

Есть три DBF файла:

accounts.dbf
rectranc.dbf
rectranh.dbf

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

Приведу подробный пример с описанием задачи:

из файла accounts.dbf извлекаются следующие данные:

TNUM   INOUT        ENDSUM
Б00043        АВБ         1000.000
Б00313        АВВ         1000.000
Б00354        Б2         3335.220


из файла rectranc.dbf:

CODE        TNUM        NAME             NFACC
127        Б00043        Иванов Иван Иванович     42307810312487525410
046        Б00313        Петров Петр Петрович     42358796510477456321
111        Б00354        Сидоров Сидор Сидорович   42325895448752223655


из файла rectranh.dbf:

CODE     HEAD2
127        0163
046        0105
111        0049


нужно связать данные из этих файлов и составить три txt файла с именами АВБ, АВВ и Б2 соответственно, в виде:
АВБ.txt
0163:42307810312487525410:1000.00:Иванов:Иван:Иванович:

АВВ.txt
0105:42358796510477456321:1000.00:Петров:Петр:Петрович:

Б2.txt
0049:42325895448752223655:3335.22:Сидоров:Сидор:Сидорович:

P.S.В этой теме мне помогли решить данную задачу при помощи BAT, но данных очень много в файле, возникают тормоза при обработке.Посоветовали напрямую работать с dbf файлами через реляционные операции SQL, но я в программировании не силён.

Demon L

Код: 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 MaskName
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
MaskName = SourceDir & "\" & FSO.GetBaseName(PathFile) & ".*"
For n = 0 To CountArray
TextItem = TextArray(n)
If InStr(Text, TextItem) And TextItem <> "" Then
FSO.CopyFile MaskName, OutDir
Exit For
End If
Next
FSO.CopyFile MaskName, OutAllDir
Next

Rush

Огромное спасибо !! то что доктор прописал !!
и не большая проблема:
Когда скрипт раскидывает файлы по папкам все ок но если там уже есть такой файл - вылазит ошибка "файл уже существует"... как сделать так чтоб он без вопросов перезаписывал фал новым ?

Еще раз спасибо !! Вы меня спасли !