Серый форум — VBS Копирование текста

Re: VBS Копирование текста

null@example.com (alexii) — Mon, 05 Dec 2011 09:01:26 +0000

Stan, пользуемся поиском: pop3. А вообще — данный вопрос должно было задавать не в этой теме, ибо он с ней никак не связан.

Re: VBS Копирование текста

null@example.com (Stan) — Mon, 05 Dec 2011 08:59:46 +0000

Дайте пожалуйста толчок

Re: VBS Копирование текста

null@example.com (Stan) — Mon, 05 Dec 2011 08:56:49 +0000

Привет Возможно ли с помощью vbs получить почту через протокол pop3?

Re: VBS Копирование текста

null@example.com (KaKTuZ) — Fri, 09 Sep 2011 10:35:24 +0000

ВСЁ ОТЛИЧНО!!
СПАСИБО!!!!
С вашей помощью получился вот такой код:

SAVEFILE "http://*****1/garant.crl", "GE", "certutil -split c:\scriptcheckcrl\GEgarant.crl", objExec1, "GEgarant.txt" 
SAVEFILE "http://*****1/garant2.crl", "GE", "certutil -split c:\scriptcheckcrl\GEgarant2.crl", objExec2, "GEgarant2.txt" 
SAVEFILE "http://*****2/garant.crl", "CA1", "certutil -split c:\scriptcheckcrl\CA1garant.crl", objExec3, "CA1garant.txt" 
SAVEFILE "http://*****2/garant2.crl", "CA1", "certutil -split c:\scriptcheckcrl\CA1garant2.crl", objExec4, "CA1garant2.txt" 
SAVEFILE "http://*****3/garant.crl", "CA2", "certutil -split c:\scriptcheckcrl\CA2garant.crl", objExec5, "CA2garant.txt" 
SAVEFILE "http://*****3/garant2.crl", "CA2", "certutil -split c:\scriptcheckcrl\CA2garant2.crl", objExec6, "CA2garant2.txt" 

 
'__________Процедура на скачивание и на преобразование CRL в TXT 

  
Sub SAVEFILE(URL1, Base_Name, Command, OBJ1, TXT) 
strFileURL = URL1 
URL = Split(StrReverse(strFileURL), "/") 
basename = Base_Name & StrReverse(URL(0)) 

strHDLocation = "C:\scriptcheckcrl\" & basename 
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP") 
objXMLHTTP.open "GET", strFileURL, false 
objXMLHTTP.send() 

  
If objXMLHTTP.Status = 200 Then 
 Set objADOStream = CreateObject("ADODB.Stream") 
 objADOStream.Open 
 objADOStream.Type = 1 'adTypeBinary 
 objADOStream.Write objXMLHTTP.ResponseBody 
 objADOStream.Position = 0 'Set the stream position to the start 
 Set objFSO = Createobject("Scripting.FileSystemObject") 
   If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation 
 Set objFSO = Nothing 
 objADOStream.SaveToFile strHDLocation 
 objADOStream.Close 
 Set objADOStream = Nothing 
End if 

Set objXMLHTTP = Nothing 
Set objShell = CreateObject("WScript.Shell") 
strCommand1 = Command 

Set OBJ1 = objShell.Exec(strCommand1) 
While objExec1.Status = 0 
        WScript.Sleep 20 
Wend 
strOutput = Replace(OBJ1.StdOut.ReadAll, VbCrLf & "CertUtil: -split command completed successfully.", "") 
  
With WScript.CreateObject("Scripting.FileSystemObject").CreateTextFile(TXT, True) 
    .Write strOutput 
    .Close 
End With 

End Sub 

  
'____________________________________________________________________________ 
Dim fName(5) 
Dim objFSO 
Dim i 
Dim txtFile 
Dim ReadLineTXT 
Dim checkLic 
Dim strMsg 
Dim objCDO 
Dim Conf 
Dim DataCrl(5) 
 
fName(0) = "c:\scriptcheckcrl\GEgarant.txt" 
fName(1) = "c:\scriptcheckcrl\GEgarant2.txt" 
fName(2) = "c:\scriptcheckcrl\CA1garant.txt" 
fName(3) = "c:\scriptcheckcrl\CA1garant2.txt" 
fName(4) = "c:\scriptcheckcrl\CA2garant.txt" 
fName(5) = "c:\scriptcheckcrl\CA2garant2.txt" 

  
Set objFSO= WScript.CreateObject("Scripting.FileSystemObject") 

'_____________!!!!!!!!НАХОЖДЕНИЕ СТРОКИ С ДАТОЙ 
For i = 0 To UBound(fName) 
  Set txtFile = objFSO.OpenTextFile(fName(i)) 
  Do While Not txtFile.AtEndOfStream 
    If InStr(txtFile.ReadLine, "Следующая публикация CRL") Then 
      ReadLineTXT = txtFile.ReadLine 
      checkLic = checkLic + SMS(ReadLineTXT) 
  DataCrl(i) = ReadLineTXT 
      Exit Do 
    End If 
  Loop 
  txtFile.Close 
Next 
 
'_____________!!!!!!!!ФУНКЦИЯ СРАВНЕНИЯ ДАТЫ В ФАЙЛЕ С ТЕКУЩЕЙ 

Function SMS(STR) 
  If DateDiff("n", CDate(Replace(STR, "г.", "")), Now) > 9 Then 
    SMS = 0 
  Else 
    SMS = 1 
  End If 
End Function 
  
'_____________!!!!!!!!СРАВНЕНИЕ СТАТУСОВ КАЖДОГО ФАЙЛА 
 
If checkLic = 6 Then 
  strMsg = "Не просрочена" 
Else 
  strMsg = "Просрочена" 
End If 

'_____________!!!!!!!!СООБЩЕНИЕ НА ПОЧТОВЫЙ ЯЩИК 
  
Set objCDO = WScript.CreateObject("CDO.Message") 
objCDO.From = "ОТ КОГО"     
objCDO.To = "КОМУ" 
objCDO.Subject = "Проверка CRL" 

objCDO.HTMLBody = strMsg & "
" & "
" & "GEgarant.txt" & DataCrl(0) & "
" &  "GEgarant2.txt" & DataCrl(1) & "
" &  "CA1garant.txt" & DataCrl(2) & "
" &  "CA1garant2.txt" & DataCrl(3) & "
" &  "CA2garant.txt" & DataCrl(4) & "
" &  "CA2garant2.txt" & DataCrl(5) 

Set Conf = objCDO.Configuration 
  Conf("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2     
  Conf("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp сервер" 
' Conf("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1 
  Conf("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 0 
' Conf("http://schemas.microsoft.com/cdo/configuration/sendusername") = "Login" 
' Conf("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "Pass" 
  Conf("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25 
Conf.Fields.Update 
  
objCDO.Send 

Set objFSO = Nothing 
Set objCDO = Nothing 
 
WScript.Quit

!!! Объясните только, почему создается в папке ещё Blob0_0.crl ????

Re: VBS Копирование текста

null@example.com (KaKTuZ) — Thu, 08 Sep 2011 07:26:23 +0000

Спасибо!!)))
А если мне не надо выбирать, а надо чтоб автоматически он заходил по специальному folder`у и брал там файлы?
Правильно ли понимаю, что вместо

'выбираем каталог
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Выбор каталога", &h200, &h11)
If Not objFolder Is Nothing Then
    strPath = objFolder.Self.Path
Else
    MsgBox "Каталог не выбран",vbExclamation
    WScript.Quit
End If

я тупо пишу

strPath = c:\scriptcheckcrl\

И ещё вопрос!!!

Когда делал сам, решил сделать процедуру одну

fName_1 = "c:\scriptcheckcrl\GEgarant.txt" 
fName_2 = "c:\scriptcheckcrl\GEgarant2.txt" 
fName_3 = "c:\scriptcheckcrl\CA1garant.txt" 
fName_4 = "c:\scriptcheckcrl\CA1garant2.txt" 
fName_5 = "c:\scriptcheckcrl\CA2garant.txt" 
fName_6 = "c:\scriptcheckcrl\CA2garant2.txt" 

Set objFSO= WScript.CreateObject("Scripting.FileSystemObject") 

'_____________!!!!!!!!ФУНКЦИЯ НАХОЖДЕНИЯ СТРОКИ С ДАТОЙ 

 Function ReadLineTXT(FileName) 
   Set txtFile = objFSO.OpenTextFile(FileName) 
       Do While Not txtFile.AtEndOfStream 
          If InStr(txtFile.ReadLine, "Следующая публикация CRL") Then 
              ReadLineTXT = txtFile.ReadLine 
       Exit Do 
          End If 
       Loop 
   txtFile.Close 
End Function 

STR1=ReadLineTXT(fName_1) 
STR2=ReadLineTXT(fName_2) 
STR3=ReadLineTXT(fName_3) 
STR4=ReadLineTXT(fName_4) 
STR5=ReadLineTXT(fName_5) 
STR6=ReadLineTXT(fName_6) 

'_____________!!!!!!!!ФУНКЦИЯ СРАВНЕНИЯ ДАТЫ В ФАЙЛЕ С ТЕКУЩЕЙ 

Function SMS(STR) 
    If DateDiff("n", CDate(Replace(STR, "г.", "")), Now) > 9 Then  ' ТУТ выдает ОШИБКУ! ОБЪЯСНИТЕ! 
     SMS = "Просрочена" 
   Else 
     SMS = "Не просрочена" 
 End If 

End function 

strMsg_1=SMS(STR1) 
strMsg_2=SMS(STR2) 
strMsg_3=SMS(STR3) 
strMsg_4=SMS(STR4) 
strMsg_5=SMS(STR5) 
strMsg_6=SMS(STR6)

В функции SMS выдает ошибку на if.
Хотя если делать вот так, ошибки не выдает. (Потому что без функции 6 раз прогоняю отдельно)

If DateDiff("n", CDate(Replace(strLine_1, "г.", "")), Now) > 9 Then 
  strMsg_1 = "Просрочена" 
Else 
  strMsg_1 = "Не просрочена" 
End If 

If DateDiff("n", CDate(Replace(strLine_2, "г.", "")), Now) > 9 Then 
  strMsg_2 = "Просрочена" 
Else 
  strMsg_2 = "Не просрочена" 
End If 

If DateDiff("n", CDate(Replace(strLine_3, "г.", "")), Now) > 9 Then 
  strMsg_3 = "Просрочена" 
Else 
  strMsg_3 = "Не просрочена" 
End If 

If DateDiff("n", CDate(Replace(strLine_4, "г.", "")), Now) > 9 Then 
  strMsg_4 = "Просрочена" 
Else 
  strMsg_4 = "Не просрочена" 
End If 

If DateDiff("n", CDate(Replace(strLine_5, "г.", "")), Now) > 9 Then 
  strMsg_5 = "Просрочена" 
Else 
  strMsg_5 = "Не просрочена" 
End If 

If DateDiff("n", CDate(Replace(strLine_6, "г.", "")), Now) > 9 Then 
  strMsg_6 = "Просрочена" 
Else 
  strMsg_6 = "Не просрочена" 
End If

Re: VBS Копирование текста

null@example.com (dab00) — Tue, 06 Sep 2011 14:53:04 +0000

Так пойдет?

Dim fName_1
Dim objFSO_1
Dim txtFile_1
Dim strLine_1
Dim strMsg_1
Dim objCDO_1
Dim Conf_1

'fName_1 = "c:\scriptcheckcrl\GEgarant.txt"

Set objFSO_1= WScript.CreateObject("Scripting.FileSystemObject")

'*************************************************************
'выбираем каталог
Set objShell = CreateObject("Shell.Application")
Set objFolder = objShell.BrowseForFolder(0, "Выбор каталога", &h200, &h11)
If Not objFolder Is Nothing Then
    strPath = objFolder.Self.Path
Else
    MsgBox "Каталог не выбран",vbExclamation
    WScript.Quit
End If

Set f = objFSO_1.GetFolder(strPath)
Set fc = f.Files
For Each fl In fc
    qqq fl.Path
Next

Sub qqq(fName_1)
'*************************************************************

Set txtFile_1 = objFSO_1.OpenTextFile(fName_1)

Do While Not txtFile_1.AtEndOfStream
    If InStr(txtFile_1.ReadLine, "Следующая публикация CRL") Then
      strLine_1 = txtFile_1.ReadLine
      Exit Do
    End If
Loop

txtFile_1.Close

If DateDiff("n", CDate(Replace(strLine_1, "г.", "")), Now) > 9 Then
  strMsg_1 = "Просрочена"
Else
  strMsg_1 = "Не просрочена"
End If

Set objCDO_1 = WScript.CreateObject("CDO.Message")

objCDO_1.From = "test1@test2.ru"    
objCDO_1.To = "test2@test2.ru"
objCDO_1.Subject = "Проверка CRL"
objCDO_1.HTMLBody = strMsg_1

Set Conf_1 = objCDO_1.Configuration
  Conf_1("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2    
  Conf_1("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-np.test2.ru"
  Conf_1("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
  Conf_1("http://schemas.microsoft.com/cdo/configuration/sendusername") = "testname"
  Conf_1("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
  Conf_1("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Conf_1.Fields.Update

'*************************************************************
End Sub
'*************************************************************

objCDO_1.Send

'*************************************************************
Set fc = Nothing
Set f = Nothing
Set objFolder = Nothing
Set objShell = Nothing
'*************************************************************

Set objFSO_1 = Nothing
Set objCDO_1 = Nothing

WScript.Quit

Добавленные блоки кода выделил.
Сначала появляется диалог выбора каталога, потом с каждым файлом в каталоге отрабатывает процедура.

Re: VBS Копирование текста

null@example.com (KaKTuZ) — Tue, 06 Sep 2011 10:09:33 +0000

Спасибо Огромное.

С вашей помощью мы с коллегой немного доделали и вот что получилось:

'Выше указанный код, вплоть до вывода в файл. Далее вводим вот это:
______________________

Dim fName_1
Dim objFSO_1
Dim txtFile_1
Dim strLine_1
Dim strMsg_1
Dim objCDO_1
Dim Conf_1

fName_1 = "c:\scriptcheckcrl\GEgarant.txt"

Set objFSO_1= WScript.CreateObject("Scripting.FileSystemObject")
Set txtFile_1 = objFSO_1.OpenTextFile(fName_1)

Do While Not txtFile_1.AtEndOfStream
    If InStr(txtFile_1.ReadLine, "Следующая публикация CRL") Then
      strLine_1 = txtFile_1.ReadLine
      Exit Do
    End If
Loop

txtFile_1.Close

If DateDiff("n", CDate(Replace(strLine_1, "г.", "")), Now) > 9 Then
  strMsg_1 = "Просрочена"
Else
  strMsg_1 = "Не просрочена"
End If

Set objCDO_1 = WScript.CreateObject("CDO.Message")

objCDO_1.From = "test1@test2.ru"    
objCDO_1.To = "test2@test2.ru"
objCDO_1.Subject = "Проверка CRL"
objCDO_1.HTMLBody = strMsg_1

Set Conf_1 = objCDO_1.Configuration
  Conf_1("http://schemas.microsoft.com/cdo/configuration/sendusing") = 2    
  Conf_1("http://schemas.microsoft.com/cdo/configuration/smtpserver") = "smtp-np.test2.ru"
  Conf_1("http://schemas.microsoft.com/cdo/configuration/smtpauthenticate") = 1
  Conf_1("http://schemas.microsoft.com/cdo/configuration/sendusername") = "testname"
  Conf_1("http://schemas.microsoft.com/cdo/configuration/sendpassword") = "password"
  Conf_1("http://schemas.microsoft.com/cdo/configuration/smtpserverport") = 25
Conf_1.Fields.Update

objCDO_1.Send

Set objFSO_1 = Nothing
Set objCDO_1 = Nothing

WScript.Quit

Как вы уже знаете, в одной папке лежат 6 файлов.
В своей vbs я пишу вышеуказанный кусок кода 6 раз

Как мне сократить до процедур?

Re: VBS Копирование текста

null@example.com (dab00) — Fri, 02 Sep 2011 14:40:10 +0000

KaKTuZ пишет:

Вопрос: У меня же Перед следущей публикацией стоит 4 пробела?
Мне лучше писать Const strFlag = " Следующая публикация CRL"

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

Следующая публикация CRL 
        1 сентября 2011 г. 13:50:00

сохранил в один каталог с моим кодом, и мой код отработал нормально.
Если положите этот код в тот же каталог, что и Ваши файлы, то можете попробовать запустить скрипт, просто добавив в код строку:
strFilePath = Имя_Вашего_Файла

KaKTuZ пишет:

Мне лучше писать Const strFlag = " Следующая публикация CRL"

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

Re: VBS Копирование текста

null@example.com (KaKTuZ) — Fri, 02 Sep 2011 14:25:04 +0000

Хорошо хоть программирование знаю Буду разбираться Спасибо!
Вопрос: У меня же Перед следущей публикацией стоит 4 пробела?
Мне лучше писать Const strFlag = " Следующая публикация CRL"

Re: VBS Копирование текста

null@example.com (dab00) — Fri, 02 Sep 2011 14:18:29 +0000

Как то так:

Const strFlag = "Следующая публикация CRL"
Const strYear = "г."

Set fso = CreateObject("Scripting.FileSystemObject")    

'открываем файл для чтения, strFilePath = Путь_К_Вашему_Файлу
'т.к у Вас их несколько - эту строчку должен предварять цикл :)
Set objFile = fso.OpenTextFile(strFilePath,1)

'флаг - нашли строку strFlag
bFlag = True

Do 'читаем файл по-строчно, ищем strFlag    
    If InStr(objFile.ReadLine, strFlag) Then bFlag = False    
Loop While bFlag

'читаем следующую строку - обрежем начальные и конечные пробелы, 
'заменим strYear, чтобы преобразовать строку в дату
strDate = Replace(Trim(objFile.ReadLine),strYear,vbNullString)
'закрываем файл
objFile.Close
'проверяем разницу - если больше 9 минут
If DateDiff("n",CDate(strDate), Now()) > 9 Then MsgBox "Время И Стекло :)"

Re: VBS Копирование текста

null@example.com (KaKTuZ) — Fri, 02 Sep 2011 13:16:51 +0000

Есть текстовый файл.
(Таких текстовых файлов- 6 штук)
Надо найти строки :

    Следующая публикация CRL 
        1 сентября 2011 г. 13:50:00

Строчка - "Следующая сертификация" выступает как ключ, от которого следующая строка и будет являться проверяемой.
Сравнить дату и время с нынешней.
(Брать 10 минут с запасом)
(Т.е. если в 13:59 - то нормально.Если 14:00 - то пишем, что просрочена)
(Придётся переводить текстовый формат даты в дату - не знаю как)
Если не просрочена или просрочена - отсылать соответствующее уведомление на почту.
(Скрипт будет запускаться каждые полчаса/час через планировщик задач).

(В данном случае такая строка в файле только одна)

Re: VBS Копирование текста

null@example.com (KaKTuZ) — Tue, 30 Aug 2011 13:34:47 +0000

Получилось.
Огромное спасибо!
Теперь буду работать с регулярными функциями vbs для вытягивания и сравнения даты.
Как будут вопросы - напишу!

Re: VBS Копирование текста

null@example.com (alexii) — Tue, 30 Aug 2011 11:34:36 +0000

Хочу вытянуть весь текст из strOutput и положить его в файл garant.txt.

Если я правильно понял, то примерно так:

With WScript.CreateObject("Scripting.FileSystemObject").CreateTextFile("garant.txt", True)
    .Write strOutput
    .Close
End With

VBS Копирование текста

null@example.com (KaKTuZ) — Tue, 30 Aug 2011 10:14:37 +0000

Мужики.
Проблема (собственно и задача).
Нужно Проверять дату следующего обновления списка отзыва сертификатов. (таких сертификатов 6 штук)
Если же все нормально, то отсылать на почту сведение о том, что список обновлен и все тип топ.
Если же нет, то отсылать имя списка отзыва.

Сейчас планировал:
1 - Скопировать *.crl на компьютер.
2 - С помощью команды CERTUTIL прочитать сертификат.
3 - Перенести данные в текстовый формат *.txt
4 - Специальными командами (пока не знаю какими в VBS) найти это место в текстовом файле.
5 - Сравнить с нынешней датой.
6 - Осуществить отправление сообщения на почту.

N.B. Но рассматриваю такой вариант, что с помощью специализированных операций под действием команды CERTUTIL можно вытянуть дату (Для того чтобы не использовать пункты 3 и 4).

Сохраняю на компьютере *.crl - список отзыва.
Вот таким кодом вытягиваю файл из интеренета:

'wget functionality in vbscript
strFileURL = "http://**************/garant.crl"
URL = Split(StrReverse(strFileURL), "/")
basename = StrReverse(URL(0))
wscript.echo "Downloadin1g " & basename

strHDLocation = "C:\" & basename
Set objXMLHTTP = CreateObject("MSXML2.XMLHTTP")
objXMLHTTP.open "GET", strFileURL, false
objXMLHTTP.send()

If objXMLHTTP.Status = 200 Then
 Set objADOStream = CreateObject("ADODB.Stream")
 objADOStream.Open
 objADOStream.Type = 1 'adTypeBinary
 objADOStream.Write objXMLHTTP.ResponseBody
 objADOStream.Position = 0 'Set the stream position to the start
 Set objFSO = Createobject("Scripting.FileSystemObject")
   If objFSO.Fileexists(strHDLocation) Then objFSO.DeleteFile strHDLocation
 Set objFSO = Nothing
 objADOStream.SaveToFile strHDLocation
 objADOStream.Close
 Set objADOStream = Nothing
End if
Set objXMLHTTP = Nothing

'The following code executes the downloaded file from a command shell '(cmd.exe)
'Set objShell = CreateObject("WScript.Shell")
'Set objScriptExec = objShell.Exec("%comspec% /" & "c:\crl1.vbs ")
'cmdOutput = objScriptExec.StdOut.ReadAll
'cmdErrOutput = objScriptExec.StdErr.ReadAll

Далее открываю его:

Set objShell = CreateObject("WScript.Shell")
strCommand1 = "certutil -split c:\garant.crl "
Set objExec = objShell.Exec(strCommand1)
While objExec.Status = 0
        WScript.Sleep 600
Wend
strOutput = Replace(objExec.StdOut.ReadAll, VbCrLf & "CertUtil: -split command completed successfully.", "")
MsgBox strOutput

Осталась проблема:

Хочу вытянуть весь текст из strOutput и положить его в файл garant.txt. Грубо говоря - копирование.
Какой командой лучше воспользоваться и как вытянуть текст из strOutput?