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

OSADJAN
например, так:
Код: Set objArgs = WScript.Arguments

If objArgs.Count <> 1 Then
WScript.Echo "Не указан файл-список."
WScript.Quit 1
Else
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(objArgs(0), ForReading)

ParseListFile

Set objFile = Nothing
Set objFSO = Nothing
End If

'функция валидации папки - чтобы не писать по многу
'раз конструкции If... Then...
Function ValidateFolder(fName)
If Not objFSO.FolderExists(fName) Then
objFSO.CreateFolder(fName)
End If
End Function

Sub ParseListFile
Do Until objFile.AtEndOfStream
'с Trim можно не церемониться
strLine = Trim(objFile.ReadLine)

arrLines = Split(strLine, "\")
strFolder1 = arrLines(0)
strFolder2 = arrLines(1)
strFolder3 = arrLines(2)

ValidateFolder strFolder1
ValidateFolder strFolder1 & "\" & strFolder2
ValidateFolder strFolder1 & "\" & strFolder2 & "\" & strFolder3
Loop
End Sub

ComradG, очень признателен за пример.
Спасибо, буду эксперементировать...

Цитата:

мелкие косяки предлагаю доразобрать самостоятельно

Код: Set objFSO=CreateObject("Scripting.FileSystemObject")

If WScript.Arguments.Count = 1 Then
strFile = WScript.Arguments.Item(0)
Else
WScript.Echo "Не указан файл-список."
WScript.Quit
End If

Set objFile=objFSO.OpenTextFile(strFile)
PathName = objFSO.GetParentFolderName(strfile)

ParseListFile

Function ValidateFolder(fName)
If Not objFSO.FolderExists(fName) Then
objFSO.CreateFolder(fName)
End If
End Function

Sub ParseListFile
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
If Len(strLine) > 0 Then
strNewLine= strLine & "\" & vbCrLf
End If
arrLines = Split(strNewLine, "\")

strFolder1 = arrLines(0)
strFolder2 = arrLines(1)
strFolder3 = arrLines(2)

ValidateFolder PathName & "\" & strFolder1
ValidateFolder PathName & "\" & strFolder1 & "\" & strFolder2
ValidateFolder PathName & "\" & strFolder1 & "\" & strFolder2 & "\" & strFolder3
Loop
End Sub

OSADJAN
что-то ты заэксперементировался. по-моему куда короче один раз записать
Код: Set objArgs = WScript.Arguments

ComradG, не получилось у меня через

Код: Set objArgs = WScript.Arguments

OSADJAN
каждый пишет код, конечно, по своему усмотрению, но япона-мать! в таком коде ковыряться не охота, и без бутылки ничего не сообразить постороннему. ладно, от критики по существу. с чего вдруг у тебя не устанавливается ссылка на аргументы?
Код: Set objArgs = WScript.Arguments

ComradG
Цитата:

с чего вдруг у тебя не устанавливается ссылка на аргументы?

Уже разобрался... Нужно было добавить путь для создания папок.
Код: Set objArgs = WScript.Arguments

If objArgs.Count <> 1 Then
WScript.Echo "Не указан файл-список."
WScript.Quit 1
Else

strRoot = Replace(WScript.ScriptFullName, WScript.ScriptName, "")

Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objFile = objFSO.OpenTextFile(objArgs(0))

ParseListFile

Set objFile = Nothing
Set objFSO = Nothing
End If

Function ValidateFolder(fName)
If Not objFSO.FolderExists(fName) Then
objFSO.CreateFolder(fName)
End If
End Function

Sub ParseListFile
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.ReadLine)
If Len(strLine) > 0 Then
strNewLine = strLine & "\" & vbCrLf
End If

arrLines = Split(strNewLine, "\")
strFolder1 = arrLines(0)
strFolder2 = arrLines(1)
strFolder3 = arrLines(2)

ValidateFolder strRoot & strFolder1
ValidateFolder strRoot & strFolder1 & "\" & strFolder2
ValidateFolder strRoot & strFolder1 & "\" & strFolder2 & "\" & strFolder3
Loop
End Sub

Цитата:

но что сразу бросается в глаза: написано много лишнего и перехват исключений подавляется On Error'ом

ComradG Критику принял.
Код: Set objFSO=CreateObject("Scripting.FileSystemObject")
strRoot = Replace(WScript.ScriptFullName, WScript.ScriptName, "")

If WScript.Arguments.Count = 1 Then
strFile = WScript.Arguments.Item(0)
Else
WScript.Echo "Не указан файл-список."
WScript.Quit 1
End If

Set objFile=objFSO.OpenTextFile(strFile)

ParseListFolder

Sub ParseListFolder
Do Until objFile.AtEndOfStream
strLine = Trim(objFile.Readline)
If Len(strLine) > 0 Then CreationFolders(strRoot & strLine)
Loop
End Sub

Function CreationFolders(strPath)
Set objFolder=objFSO.GetFolder(strRoot)
Set colFolders=objFolder.SubFolders
strParentPath = objFSO.GetParentFolderName(strPath)
If Not objFSO.FolderExists(strParentPath) Then CreationFolders strParentPath
If Not objFSO.FolderExists(strPath) Then objFSO.CreateFolder strPath
End Function

Здравствуйте!
Нужно в MS Outlook 2007 организовать автоматическую отправку писем с вложениями. Для этого собираюсь в планировщик засунуть батник, который каждые 5 минут проверяет наличие файла в папке с вложениями (готовыми к отправке) и если такие есть, то запускает Outlook с ключом запуска на выполнение VBA проекта. Имеется скрипт, который умеет отправлять одно письмо с вложением из папки (C:\temp\3):
Код: Function GetAttach()
Dim strPath
Dim arrFiles
strPath = "C:\temp\3"
Set arrFiles = CreateObject("Shell.Application").NameSpace(strPath).Items
arrFiles.Filter 64, "*.txt"
Select Case arrFiles.Count
Case 0
MsgBox "Отчет для отправки не найден.", 48, "Отправка файла"
WScript.Quit 1
Case 1
GetAttach = arrFiles.Item(0).Path
Case Else
MsgBox "Найдено несколько файлов.", 48, "Отправка файла"
WScript.Quit 1
End Select
End Function

Sub SendReports()
Dim myOlApp As New Outlook.Application
Dim myItem As Outlook.MailItem
Dim myAttachments As Outlook.Attachments

Set myItem = myOlApp.CreateItem(olMailItem) myItem.To = "ivanov@mail.ru"
myItem.Subject = "отчет"
myItem.Body = "С уважением, Иванов Иван"
Set myAttachments = myItem.Attachments
myAttachments.Add GetAttach, _
olByValue
myItem.Send
On Error GoTo 0
Set OutMail = Nothing
Set OutApp = Nothing
End Sub

orze
в принципе, если имеется жестко прописанный путь и при этом в качестве аттачей выступают текстовые файлы, то можно (и нужно) обойтись и без Shell.Application:
Код: Set objFSO = CreateObject("Scripting.FileSystemObject")
Set colFiles = objFSO.GetFolder("C:\temp\3").Files

For Each colFile In colFiles
If UCase(objFSO.GetExtensionName(colFile)) = "TXT" Then
Set objMessage = CreateObject("CDO.Message")
Set objConfig = CreateObject("CDO.Configuration")
Set colFields = objConfig.Fields

colFields.Item("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2
colFields.Item("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp.mail.ru"
colFields.Item("http://schemas.microsoft.com/cdo/configuration/smtpconnectiontimeout") = 10
colFields.Update

objMessage.Configuration = objConfig
objMessage.To = "soap@mail.ru"
objMessage.From = "my_soap@mail.ru"
objMessage.Subject = "Отчет"
objMessage.TextBody = "Текст основного сообщения."
objMessage.AddAttachment colFile
objMessage.Send

Set colFields = Nothing
Set objConfig = Nothing
Set objMessage = Nothing
End If
Next

Set colFiles = Nothing
Set objFSO = Nothing

ComradG
спасибо за помощь , но нужно без использования schemas.microsoft.com, только посредством Outlook, этот компьютер подсоединен к спецсвязи и выход в интернет не имеет. В качестве аттачей выступают файлы с расширением .888, которое впринципе не меняется.

Привет.

Диспозиция:

- Почтовый сервер: MS Exchange 10 Sp1 rolup3 (записано на слух, т.е. могут быть неточности);
- ОС клиента: Microsoft Windows [Version 5.2.3790] (M$ w2k3 server Standard Edition SP2);
- MAPI: ExchangeMapiCdo v.6.5.8211.0;
- Инструмент: Microsoft (R) Windows Script Host Version 5.6.

Нужно:

Получить локальную копию письма в виде ‘text dump’ (т.е. в том виде, в каком это письмо пересылается между почтовыми серверами). С помощью VBScript.

NB. Я без проблем могу получать тело письма, вложенные в письмо файлы и т.п.
Но как получить именно ‘text dump’ – не знаю.

Подскажите, pls. Или хотя бы укажите "где спросить".

Помогите добавить в реестр значение:
[more]
[HKEY_CURRENT_USER\Software\Microsoft\Windows\CurrentVersion\Explorer\Streams\Desktop]
"TaskbarWinXP"=hex:0c,00,00,00,08,00,00,00,02,00,00,00,00,00,00,00,aa,4f,28,68,\
48,6a,d0,11,8c,78,00,c0,4f,d9,18,b4,08,03,00,00,40,0d,00,00,00,00,00,00,28,\
00,00,00,00,00,00,00,00,00,00,00,28,00,00,00,00,00,00,00,01,00,00,00,01,00,\
00,00,8b,8a,0d,54,3f,1c,32,4e,81,32,53,0f,6a,50,20,90,1c,00,00,00,40,05,00,\
00,00,00,00,00,1a,00,00,00,00,00,00,00,00,00,00,00,28,00,00,00,00,00,00,00,\
01,00,00,00
"Upgrade"=dword:00000001
[/more]

orze
CDO - часть Outlook'а, так что...

NvvLazyTiger
что ты разумеешь под text dump'ом то? содержание письма или чего? можно более подробно, а то без бутылки не разобраться.

00D
в реестр можно писать либо через WSHShell, либо так:
Код: Const HKEY_CURRENT_USER = &H80000001

Set objRegistry = GetObject("winmgmts:\\.\root\default:StdRegProv")

strKeyPath = "Software\Microsoft\Windows\CurrentVersion\Explorer\Streams\Desktop"
strValueName = "Upgrade"
dwValue = 1

objRegistry.SetDWORDValue HKEY_CURRENT_USER, strKeyPath, strValueName, dwValue

ComradG
Цитата:

что ты разумеешь под text dump'ом то? содержание письма или чего? можно более подробно

Я подразумеваю:
Цитата:

в том виде, в каком это письмо пересылается между почтовыми серверами

Но могу и уточнить - мне нужно (в виде текста) письмо с сервера, которое я бы получил по POP3 (со служебкой и всем остальным).
Но мне нужно это получить именно средствами ExchangeMapiCdo.
Т.к. обустраивать (для одного письма) сразу два сеанса с сервером (dump через POP3 + остальное через ExchangeMapiCdo) - мне таки не с руки.
(это будет работать, но будет таки "криво")

ComradG

Цитата:

в реестр можно писать либо через WSHShell, либо так:

таке скрипты можно прицепить на логон в AD для пользователей?JS,VBA скрипты прицепляются без проблем, а вот .reg файлы не уверен

NvvLazyTiger

Цитата:

в том виде, в каком это письмо пересылается между почтовыми серверами

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

OOD
каэшна можно. про reg'и речи не было вовсе.

ComradG
Цитата:

Цитата: в том виде, в каком это письмо пересылается между почтовыми серверами

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

Цитата:

в виде текстов (0x0A, 0x0D, 0x20..0x7E)

дык это же хекс, а не текст. то есть тебе нужен хекс-дамп?

Гм-м-м,.. ComradG
Цитата:

Цитата: в виде текстов (0x0A, 0x0D, 0x20..0x7E)

дык это же хекс, а не текст. то есть тебе нужен хекс-дамп?

NvvLazyTiger

Цитата:

Я без проблем могу получать тело письма, вложенные в письмо файлы и т.п.

то есть, так же vbs'кой, надо полагать? можно глянуть? и кстати, какая кодировка используется?

ComradG
Цитата:

то есть, так же vbs'кой, надо полагать? можно глянуть?

Что именно тебя интересует? У меня скрипт за 20 Kb и я не готов его публиковать. В т.ч. и потому, что там используются чужие know-how. Но на конкретный вопрос могу попробовать ответить. У тебя есть конкретная проблема касаемо?

Цитата:

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

Где? В письмах - чего только не встретишь. У меня - 866/1251. На Exchange - 1251 (для кириллицы - Россия, как-никак).

NvvLazyTiger

Цитата:

и я не готов его публиковать.

есть личка, да и потом здесь вряд ли кто-то станет смеяться: что постыдного в том, чтобы тянуться к новым знаниям? если более конкретно, то меня интересует каким образом получается именно тело письма.

Цитата:

У меня - 866/1251. На Exchange - 1251

хм, а однабайтовая дососвкая кодировка для чего? может все таки 1251?

ComradG
Цитата:

меня интересует каким образом получается именно тело письма

Просто.
Цитата:

Set objSession = WScript.CreateObject("MAPI.Session")
objSession.Logon ,,,,,,strMailHost & vbLf & strMailUser
Set objInboxFolder = objSession.Inbox
Set objInMessagesCollection = objInboxFolder.Messages
' [...]
Set objOneMsg = objInMessagesCollection.GetFirst
strTemp = objOneMsg.Text

Вот в strTemp и будет тело первого письма (из наличных в п/я).

Цитата:

хм, а однабайтовая дососвкая кодировка для чего? может все таки 1251?

У меня (и в серверных, и в клиентских решениях) основная кодировка именно 866. В технически обоснованных случаях использую перекодирование 866 <=> 1251.

Цитата:

здесь вряд ли кто-то станет смеяться: что постыдного в том, чтобы тянуться к новым знаниям

А я-то здесь причём? ;)
Да и не заботит меня чей-то смех в мой адрес. :-|

Друзья, прошу помощи в решении такой задачи: Требуется создать в домене 200 пользователей с заранее известными паролями и с установленными "флагами" - "Запретить смену пароля пользователем" и "Срок действия пароля не ограничен". Для этой цели я решил взять за основу следующий скрипт для одного пользователя:

Dim department
Dim name
Dim Login
Dim pswr
Const ADS_UF_DONT_EXPIRE_PASSWD = &h10000
department = "ou=бухгалтерия"
name = "TestUser"
Login = "Юзер"
pswd = "12345"

Set objOU = GetObject("LDAP://"&department&",ou=Пользователи,dc=test,dc=local")
Set objUser = objOU.Create("user", "cn=" & name)
objUser.sAMAccountName = Login 'Login
objUser.GivenName = Login 'name
objUser.userPrincipalName = "" & Login & "@test.local" 'Учетная запись
objUser.displayName = Login 'Выводимое имя
objUser.SetInfo

'Задаем пароль и включаем акаунт
objUser.SetPassword pswd 'Пароль
objUserFlags = objUser.Get("UserAccountControl")
objPasswordExpirationFlag = objUserFlags OR ADS_UF_DONT_EXPIRE_PASSWD
objUser.Put "UserAccountControl", objPasswordExpirationFlag
objUser.SetInfo

пользователь создается и стоит галочка "Срок действия пароля не ограничен"
Добавляю строки:
Const ADS_UF_PASSWD_CANT_CHANGE = &H40 'Вначале
objUser.Put "UserAccountControl", ADS_UF_PASSWD_CANT_CHANGE ' в третьем блоке
и флаги не устанавливаются. ((

И еще пара вопросов: на форумах встретил такую запись вызова состояния флагов: "objUser.Get("userFlags")" - это тоже самое, что и "objUser.Get("UserAccountControl")"?
и не совсем понятно зачем вообще нужна запись, точнее логическая операция:
objPasswordExpirationFlag = objUserFlags OR ADS_UF_DONT_EXPIRE_PASSWD?
Понимаю, что вопросы может и глупые, да и я не силен в программировании, а после гугла вопросов стало больше, чем ответов.

Господа программисты,

напишите пожалуйста пару строк скрипта для включения\отключения WiFi модема Zyxel через Telnet.

На вход нужен только пароль, комманды вкл\откл выглядят следующим образом

Wlan active 1
Wlan active 0

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

zolivan
То логическая операция для установки флага Эта статья может будет полезна


А уменя такой вопрос: бывает что скрипт запускаемый на удаленном компе зависает на часа 2 из-за проблемы с этим компом. Обычно на команде GetObject. что сделать чтобы подключение завершалась сразу автоматически если в чем-то ошибка?

Black_Lung
On Error Resume Next или GoTo метка, как минимум, как максимум попробовать перехватить исключение, т.е. что-то вроде
Код: If Err.Count <> 0 Then
WScript.Echo "An error has been occured while processing."
WScript.Quit 1
End If

Помогите пожалуйста с парсингом!
Есть общий отчет по 100 объектам и есть список необходимых объектов.
Как выдрать из этого общего отчета только блоки/секции по объектам из имеющегося списка (тоесть название нужного обекта и текст под ним)?
Общий отчет в виде:

Объект 1
Текст

Объект 2
Текст

......

Объект 100
Текст

litestayer
Так, а то что нужно разобрать как выглядит (по блокам/секциям)? Или телепатия;)