» Программирование "удобняшек" на VBScript (Часть 2)

Alex_Piggy
Спасибо.
"{(}TEST{)}"

а вот такая задача - создание текстового файла (*.txt) в активной панели (в открытой директории), с именем взятым из буфера обмена (предварительно скопированная строка), в кодировке UTF-8 и сразу открытого для записи? во как))

Доброе время, Werty666
Если не использовать утилиты типа conclip, то вроде так:

Код:
Set WshShell = CreateObject("Wscript.Shell")
Set FSO = CreateObject("Scripting.FileSystemObject")

Set objHTML = CreateObject("InternetExplorer.Application")
objHTML.Visible=False
objHTML.Navigate ("about:blank")
FileName = objHTML.Document.ParentWindow.ClipboardData.GetData("Text")
objHTML.Quit

CurrDir = WshShell.CurrentDirectory

Set TextStream = FSO.OpenTextFile(CurrDir & "\" & FileName , 8, True, -1)

а в параметрах кнопки чего наваять? и заранее - запросы как раз не хочется. жмакнул на кнопку и готово.

а на утилиту "conclip" ссылочку дадите?

Werty666
ConClip
Параметры кнопки? Я кажется понял... Наверное Вам будет лучше обратится в тему по TC - Total Commander (Часть 8). Там помнится и свой объект регистрировался - что-то вроде TCScript. И открыть - это соответственно не отключить свойство ReadOnly, а открыть TC Lister... Все это спросите там...
Прошу прощения,что не могу помочь большим.

Alex_Piggy

спасибо за скрипт. перетащу его в соседнюю тему, там может кто накидает

Доброго времени суток!
Два вопроса.
1. Есть ли в vbs функция аналогичная preg_match_all (php)?
2. Как с помощью vbs записать значение в следующую за заполненными строку файла excel? то есть есть файл и в нем на странице уже есть значения
1. Значение А1
2. Значение А2
3. Записать значение сюда
естественно количество значений будет нарастать.
или как вариант в базу данных access добавить новое значение. То есть есть файл с таблицей.

Доброе время суток.
1. Есть ли в vbs функция аналогичная preg_match_all (php)?

Цитата:

2. Как с помощью vbs записать значение в следующую за заполненными строку файла excel? то есть есть файл и в нем на странице уже есть значения

Пусть у вас уже есть ссылка на лист pSheet

Код:
pSheet.Cells(pSheet.UsedRange.Row + pSheet.UsedRange.Rows.Count, 1).Value = "New value"
'or
pSheet.Range("A1").Value = "New A1-value"

Доброе время суток.
Подскажите, пожалуйста, есть такая возможность, загрузка txt файлов в html?
Из тхт в ворд есть objWord = CreateObject("Word.Application"), а в штмл??

Добавлено:
А все, нашел.
objIE = CreateObject("InternetExplorer.Application")
objIE.Navigate("about:blank")
sTitle = "Document " '& String.( 80, "." )
objIE.Document.title = sTitle
objIE.MenuBar = True
objIE.ToolBar = True
objIE.AddressBar = True
objIE.Resizable = True
objIE.StatusBar = True
'objIE.Width = 250
'objIE.Height = 280
objIE.Visible = True
With objIE.Document.parentWindow.screen
objIE.Left = (.availWidth - objIE.Width) \ 2
objIE.Top = (.availHeight - objIE.Height) \ 2
End With
А есть возможность конвертации тхт-шного файла в штмл? Чтобы были нарисованы линии графов и строк, там ведь еще разделители должны быть в тхт, с разделителями пофиг.

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

exceptone

Программирование здесь при чем?

[more] Автоматизация мониторинга; Подскажите, как автоматизировать мониторинг инфы в инете?
Уточняю вопрос: на сайте Ген консульства Финляндии для получения визы надо сначала записаться на приём; для этого надо зайти сюда https://www.visaservices.co.in/Finland-visa-application/AppScheduling/AppScheduling.aspx?P=PcqAqEGdf4OMbJ1CZgKHSUN3Je9Uumiy6NGhvmhMab7phBf7hKlWsBQNrNze6jyj+86S93yLA0yGdiqvwB5yZg%3d%3d
там выбрать регион (Питер), в следующем окне, выбрать количество заявителей и вид визы и "отправить"; обычно в ответ видим сообщение об отсутствии свободных мест для записи; и потом всё повторяется снова и так в течение дня периодически надо мониторить : а не появилась ли вакансия? Можно ли автоматизировать эту рутину?
1) полностью : т.е. ват файл сам периодически выполняет всю эту последовательность действий и в случае положительного ответа открывал бы окно для записи на приём
2) частично , т.е. кликнул по ярлыку и вся эта последовательность команд тупо выполнилась и сам смотришь на результат.
Т.е. максимально автоматизировать мониторинг вакансий на запись в Ген консульство на визу. Буду очень благодарен за ответ и любые отзывы на этот вопрос! ) [/more]

[more] ВСЕМ привет!
парни закинул данный код в блокнот.

$form = send_request('http://maps.yandex.ru');
preg_match_all("/'secret-key':'(.+)'/Ui", $form, $matches);
$key = $matches[1][0];
$result = send_request('http://maps.yandex.ru/?text=Органы+власти&where=&sll=30.31349700000001,59.93853099999101&sspn=1.0848999023437322,0.16951489115989204&source=catalog&key=' . $key . '&output=json');
var_dump($result);

function send_request($url)
{
$headers = array(
"User-Agent: Mozilla/5.0 (Windows NT 6.1; rv:2.0.1) Gecko/20100101 Firefox/4.0.1",
"Accept: */*",
"Accept-Language: en-US,en;q=0.8,ru;q=0.6",
"Accept-Encoding: gzip, deflate,sdch",
"Connection: keep-alive",
);

$ch = curl_init($url);
curl_setopt_array($ch, array(
CURLOPT_HEADER => 1,
CURLOPT_HTTPHEADER => $headers,
CURLOPT_RETURNTRANSFER => true,
CURLOPT_VERBOSE => true,
CURLOPT_ENCODING => "gzip",
CURLOPT_COOKIESESSION => true,
CURLOPT_COOKIEJAR => 'cookie.txt',
CURLOPT_COOKIEFILE => 'cookie.txt'
));
$output = curl_exec($ch);
curl_close($ch);
return $output;
}

сохранил с волшебной надписью ".vbs". Запускаю ..... бац! пишет
Строка 1
Символ 1
Ошибка недопустимый знак
Код 800A0408

че делать? [/more]

Nillis86
Кодировка неправильная. Скорее всего юникод, хотя должен быть ANSI.

Здравствуйте.

Есть VBS скрипт, который позволяет изменять настройки на сетевых адаптерах со статического IP на DHCP (и обратно). На компьютере присутствует несколько сетевых адаптеров, а производить изменение настроек нужно только на одном адаптере.

Как мне встроить проверку и выполнять изменения только на указанном сетевом адаптере ?


Код: strcomputer = "."
Set objWMIService = GetObject("winmgmts:" _
& "{impersonationLevel=impersonate}!\\" & strComputer & "\root\cimv2")

Set colItems = objWMIService.ExecQuery _
("Select * From Win32_NetworkAdapterConfiguration Where IPEnabled = True")

strCount = 1

For Each objitem in colitems
If strCount = 1 Then
strIPAddress = Join(objitem.IPAddress, ",")
IP = stripaddress
strCount = strCount + 1
Else
End If

next

strAnswer=msgbox ("Are you at work?", vbYesNoCancel)

if strAnswer = vbYes then

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colNetAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")

strIPAddress = Array("192.168.1.108")
strSubnetMask = Array("255.255.255.0")
strGateway = Array("10.0.10.1")
strGatewayMetric = Array(1)
strDNSServers = Array("208.67.222.222","208.67.220.220")

For Each objNetAdapter in colNetAdapters
errEnable = objNetAdapter.EnableStatic(strIPAddress, strSubnetMask)
errGateways = objNetAdapter.SetGateways(strGateway, strGatewaymetric)
objNetAdapter.SetDNSServerSearchOrder(strDNSServers)
Next

elseif strAnswer = vbNo then

Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colNetAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration where IPEnabled=TRUE")
For Each objNetAdapter in colNetAdapters
errEnable = objNetAdapter.EnableDHCP()
objNetAdapter.SetDNSServerSearchOrder(null)
Next

else

end if

Roboder

Цитата:

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

where IPEnabled=TRUE
Заменить на WHERE Description = 'Имя адаптера'
нет?

2loban_ser

Спасибо, код без ошибок выполняется, правда DHCP всё равно не включается.

Код:
Set objWMIService = GetObject("winmgmts:\\" & strComputer & "\root\cimv2")
Set colNetAdapters = objWMIService.ExecQuery _
("Select * from Win32_NetworkAdapterConfiguration WHERE Description = 'Ethernet_1Gbs'")
For Each objNetAdapter in colNetAdapters
errEnable = objNetAdapter.EnableDHCP()
objNetAdapter.SetDNSServerSearchOrder(null)
Next

Доброго времени суток, ребят.
Я уже как-то сидел тут с этим кодом.. В общем, нужно мне его допилить, я как бы скачал порекомендованные тут книги Владимира Баталия, поизучаю. Но может кто сможет по-быстрому помочь подшлифовать.
[more]
Код: 'VBS
Set objShellApp = CreateObject("Shell.Application") ' создаем объект оболочки
Set FSO = CreateObject("Scripting.FileSystemObject") ' создаем объект файловой системы
FileChangedCount = 0 ' Количество обработанных файлов

Main ' Поиск файлов

Sub Main '""""""""""""""""" Поиск файлов
On error Resume Next ' Если файлы открыты приложением, будут пропущены
Set OpenDialog = CreateObject("MSComDlg.CommonDialog") ' Microsoft Common Dialog Control
With OpenDialog
.DialogTitle = "Откройте нужный Вам файл(ы)"
.InitDir = "C:\"
.Filter = "Модели Solidworks (*.sldlfp,*.sldasm)|*.sldlfp;*.sldasm" ' Расширения файлов
.FilterIndex = 1
.Flags = 2621952
.MaxFileSize =32000
.ShowOpen
Filename = .Filename
End With

If (Len(OpenDialog.FileName)= 0) Then
msgbox "Файлы не выбраны!"
Exit Sub
End If

files = Split(OpenDialog.Filename, vbNullChar)
count_files = UBound(files)
If count_files > 0 Then
path = files(0) + "\" ' в ХР работает этот вариант path = files(0), в W7 почему то в окончании \ отсутствует
For i = 1 To count_files
PropertySearch path + files(i) ' Если выбрано несколько файлов
Next
Else
PropertySearch path + files(0) ' Если выбран один файл
End If
Msgbox "Выполнено." &chr(13)& "Количество обработанных файлов: "& FileChangedCount, vbInformation
End Sub

Sub PropertySearch (FilePath) '""""""""""""""""" поиск свойств файла
'msgbox "FilePath = " & FilePath
Set Cprop = CreateObject("DSOFile.OleDocumentProperties") ' создаем объект подключения к свойствам файла
Cprop.Open FilePath, false ' Открываем текущий файл
IsHere = "" ' Наличие свойства Наименование, если останется "" то нету
if Cprop.CustomProperties.count > 0 then ' Если у файла есть свойства
for iprop=0 to Cprop.CustomProperties.count-1 ' цикл по свойствам
if Cprop.CustomProperties.item(iprop).Name = "Наименование" then ' если Наименование есть
IsHere = 1 ' делаем отметку
Exit For
End if
Next
End if
If IsHere = "" then ' если Наименование нету
AddCustomProperty Cprop ' назначение свойств для файла
else
AddCustomPropertyEx Cprop, iprop ' если есть
End if
Cprop.close ' закрываем файл
End Sub

Sub AddCustomProperty(Cprop) '""""""""""""""""" назначение свойств для файла
key = "Наименование" ' Имя свойства
valueForKey = "Круг" ' Значение свойства
Cprop.CustomProperties.Add key, valueForKey ' Добавляем новое свойство с
Cprop.Save ' Сохранить изменения
FileChangedCount = FileChangedCount + 1 ' Инкрементация счетчика обработанных
End Sub

Sub AddCustomPropertyEx(Cprop,iprop) '""""""""""""""""" назначение свойств для файла
valueForKey = "Круг" ' Значение свойства
Cprop.CustomProperties.Item(iprop).value = valueForKey ' изменяем свойство
Cprop.Save ' Сохранить изменения
FileChangedCount = FileChangedCount + 1 ' Инкрементация счетчика обработанных
End Sub

'""""""""""""""""" Освобождаем память
Set objShellApp = Nothing
Set FSO = Nothing
Set Cprop = Nothing
Set OpenDialog = Nothing

У меня есть скрипт для запуска окна с сообщением при пуске определённой проги, но хотелось бы, что-бы это окно было поверх всех! Возможно ли отредактировать существующий скрипт?

stvol333
В самой операционной системе "поверх всех" трактуется весьма по-разному, особенно если окон с режимом "поверх всех" больше одного. И это еще не считая всякие directx и opengl, у которых вообще собственное представление о том, кто должен быть поверх всех, при чем у каждого свое.

Так что краткий ответ - нет.

miwa

Цитата:

Так что краткий ответ - нет.

Ну, на "нет" и суда нет! Спасибо за разъяснение!

Всем привет!
Пожалуйста, помогите.
Есть небольшой скрипт, который добавляет в начало текстового файла первую пустую строку. Как его переделать, чтобы наоборот, из текстового файла удалялись все пустые строки, в том числе и конечные пустые строки? Есть условие: нужно перезаписать этот же файл, а не создавать или плодить новые.

Код: Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("e.txt",1,True,0)
If Not f.AtEndOfStream Then filedata = f.ReadAll
f.Close
Set f = fs.OpenTextFile("e.txt",2,True,0)
f.WriteLine(vbCrLf & filedata)
f.Close

Laserje18

Код: 'remove blank lines
'remblanklines.vbs
Set fs = CreateObject("Scripting.FileSystemObject")
Set f = fs.OpenTextFile("e.txt",1,True,0)
Str = vbNullString
tmp = vbNullString
number = 0
While Not f.AtEndOfStream
    tmp = f.ReadLine()
    If tmp = "" Then
        number = number + 1
    Else
        If Str = "" Then
            Str = tmp
        Else
            Str = Str & vbCrLf & tmp
        End If
End If
Wend
f.Close
Set f = fs.OpenTextFile("e.txt",2,True,0)
f.WriteLine(Str)
f.Close
MsgBox "removed " & number & " blank lines."

В общем, всё касательно моего вышенаписанного письма. Проблема такая.. Полистал рекомендованные тут книги Владимира Баталия. Не найдя ответа, списался с ним лично. Благо ответил очень быстро, за что спасибо ему огромное. сделал вот такую строку, благодаря его письму


Код: valueForKey = "Круг " & Chr(34) & "D1@Эскиз 1@" & Filename & ".SLDPRT" & Chr(34) & " ГОСТ ZZ"

Parazitif
В такие специфичные простыни вряд ли кто захочет вникать. тем более файлы специфичные "Модели Solidworks (*.sldlfp,*.sldasm)|*.sldlfp;*.sldasm"
У меня например даже диалог выбора файла не открывает. (нет Comdlg32.ocx на w7)
Set OpenDialog = CreateObject("MSComDlg.CommonDialog") ' Microsoft Common Dialog Control
msgbox OpenDialog 'здесь пустой диалог у меня

если хотите помощи, то надо определить в каком месте не работает так, как Вы хотите (msgbox в помощь), и сделать маленький тестовый скрипт, где проявляется эта ошибка. Тогда наверно Вам помогут.

в последнем посте я вообще не понял задачу. название файла Вы нашли сами, вставлять в скрипт умеете сами. Счетчик не работает?


Код: Set fs = CreateObject("Scripting.FileSystemObject")
name = fs.GetBaseName("C:\Windows\notepad.exe")
dim str
str = str & name
valueForKey = "Круг " & Chr(34) & "D1@Эскиз 1@" & str & ".SLDPRT" & Chr(34) & " ГОСТ ZZ"
MsgBox valueForKey

Tilks
Сделал как вы сказали, вот текст скрипта:

[more]
Код: 'VBS
Set objShellApp = CreateObject("Shell.Application") ' создаем объект оболочки
Set FSO = CreateObject("Scripting.FileSystemObject") ' создаем объект файловой системы
FileChangedCount = 0 ' Количество обработанных файлов

Main ' Поиск файлов

Sub Main '""""""""""""""""" Поиск файлов
On error Resume Next ' Если файлы открыты приложением, будут пропущены
Set OpenDialog = CreateObject("MSComDlg.CommonDialog") ' Microsoft Common Dialog Control
With OpenDialog
.DialogTitle = "Откройте нужный Вам файл(ы)"
.InitDir = "C:\"
.Filter = "Модели Solidworks (*.sldlfp,*.sldasm)|*.sldlfp;*.sldasm" ' Расширения файлов
.FilterIndex = 1
.Flags = 2621952
.MaxFileSize =32000
.ShowOpen
Filename = .Filename
End With

If (Len(OpenDialog.FileName)= 0) Then
msgbox "Файлы не выбраны!"
Exit Sub
End If

files = Split(OpenDialog.Filename, vbNullChar)
count_files = UBound(files)
If count_files > 0 Then
path = files(0) + "\" ' в ХР работает этот вариант path = files(0), в W7 почему то в окончании \ отсутствует
For i = 1 To count_files
PropertySearch path + files(i) ' Если выбрано несколько файлов
Next
Else
PropertySearch path + files(0) ' Если выбран один файл
End If
Msgbox "Выполнено." &chr(13)& "Количество обработанных файлов: "& FileChangedCount, vbInformation
End Sub

Sub PropertySearch (FilePath) '""""""""""""""""" поиск свойств файла
'msgbox "FilePath = " & FilePath
Set Cprop = CreateObject("DSOFile.OleDocumentProperties") ' создаем объект подключения к свойствам файла
Cprop.Open FilePath, false ' Открываем текущий файл
IsHere = "" ' Наличие свойства Наименование, если останется "" то нету
if Cprop.CustomProperties.count > 0 then ' Если у файла есть свойства
for iprop=0 to Cprop.CustomProperties.count-1 ' цикл по свойствам
if Cprop.CustomProperties.item(iprop).Name = "Наименование" then ' если Наименование есть
IsHere = 1 ' делаем отметку
Exit For
End if
Next
End if

If IsHere = "" then ' если Наименование нету
AddCustomProperty Cprop ' назначение свойств для файла
else
AddCustomPropertyEx Cprop, iprop ' если есть
End if
Cprop.close ' закрываем файл
End Sub

Sub AddCustomProperty(Cprop) '""""""""""""""""" назначение свойств для файла
key = "Наименование" ' Имя свойства
Set fs = CreateObject("Scripting.FileSystemObject")
name = fs.GetBaseName(FilePath)
dim str
str = str & name
valueForKey = "Круг " & Chr(34) & "B@Эскиз 1@" & str & ".SLDPRT" & Chr(34) ' Значение свойства
MsgBox valueForKey
Cprop.CustomProperties.Add key, valueForKey ' Добавляем новое свойство с
Cprop.Save ' Сохранить изменения
FileChangedCount = FileChangedCount + 1 ' Инкрементация счетчика обработанных
End Sub

Sub AddCustomPropertyEx(Cprop,iprop) '""""""""""""""""" назначение свойств для файла
Set fs = CreateObject("Scripting.FileSystemObject")
name = fs.GetBaseName(FilePath)
dim str
str = str & name
valueForKey = "Круг " & Chr(34) & "B@Эскиз 1@" & str & ".SLDPRT" & Chr(34) ' Значение свойства
MsgBox valueForKey
Cprop.CustomProperties.Item(iprop).value = valueForKey ' изменяем свойство
Cprop.Save ' Сохранить изменения
FileChangedCount = FileChangedCount + 1 ' Инкрементация счетчика обработанных
End Sub

'""""""""""""""""" Освобождаем память
Set objShellApp = Nothing
Set FSO = Nothing
Set Cprop = Nothing
Set OpenDialog = Nothing

Tilks
Спасибо! Работает идеально.

Parazitif
постите свои простыни под тегом MORE (Скрывает текст и генерирует линк...)
Я же говорил, не могу проверить как работает, т.к. нету Comdlg32.ocx на w7
я проверил бы:

Код: Sub AddCustomProperty(Cprop) '""""""""""""""""" назначение свойств для файла
key = "Наименование" ' Имя свойства
Set fs = CreateObject("Scripting.FileSystemObject")
name = fs.GetBaseName(FilePath)

Хорошо, попробую.
_____________

Проверил. Путь к файлам берет правильно. Пишет: Path = C:\Users\Shilcev\Desktop\Новая папка\
Затем проверка пишет FilePath = C:\Users\Shilcev\Новая папка\_Белиберда.SLDLFP
Затем сообщение name = _Белиберда
Затем результат Круг "B@Эскиз1@.SLDPRT

И так же для второго выбранного файла, только с его именем. То есть и счётчик работает нормально.

А значит не работает что-то на этапе вписания name в свойство.. То есть назначения


Код: valueForKey = "Круг " & Chr(34) & "B@Эскиз 1@" & str & ".SLDPRT" & Chr(34)

Parazitif
я запустил кое как на virtual xp, с изменениями выбора файла, чтобы вообще работало.

у меня вообще не проходит Cprop

Код: Sub PropertySearch (FilePath) '""""""""""""""""" поиск свойств файла
msgbox "FilePath in PropertySearch() = " & FilePath ' тут показывает
Set Cprop = CreateObject("DSOFile.OleDocumentProperties") ' создаем объект подключения к свойствам файла
msgbox "Cprop object = " & Cprop ' !!! а тут уже не доходит !!!