Total Commander

Форум поддержки пользователей Total Commander
https://forum.wincmd.ru/

Отправка файла по почте с записью комментария в буфер

https://forum.wincmd.ru/viewtopic.php?t=13234

Страница 4 из 4

Добавлено: Сб июн 05, 2010 00:45
AVos002
Забыл указать параметры зауска команды меню «Запуск»:
================================================================
Команда: C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs
Параметры: %P%N %L
================================================================

Добавлено: Пн июн 07, 2010 10:09
Batya
AVos002 писал(а):Ошибка: Недопустимое число аргументов или присвоение значения свойства: 'GetExtensionName'
Не знаю, что ты запускаешь, но ни в первом, ни во втором скрипте не используется метод "GetExtensionName".
Покажи мне содержимое файла:
AVos002 писал(а):C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs

Добавлено: Пн июн 07, 2010 11:32
AVos002
Здравствуй Batya!
Как я и предположил, на рабочем компьютере твой скрипт запускается, что за бодяга с домашним компом не понимаю.
Между тем я немного доработал твой скрипт в части перекодировки DOS Windows и получилось вот, что :

Код: Выделить всё

'============================================================== 
' Открытие нового сообщния MS Outlook с вложенными файлами 
' 
' Параметры: 
' {файл для комментария} {файл-список файлов для вложения} 
' 
' Пример параметров при вызове из TC: 
' %P%N %L 
'============================================================== 
Option Explicit 

Dim FSO, MSO, MSG, File, List, F 
Set FSO = CreateObject("Scripting.FileSystemObject") 
File    = WScript.Arguments(0) 
List    = WScript.Arguments(1) 

Set MSO = CreateObject("Outlook.Application") 
Set MSG = MSO.CreateItem(0) 

MSG.Subject = FSO.GetFileName(File) & " [" & GetComment(File) & "]" 
MSG.Body    = "Добрый день!" & vbCrLf & vbCrLf & _ 
              "---"  & vbCrLf & _
	      "С Уважением, AVos002"

For Each F In Split(FSO.OpenTextFile(List).ReadAll, vbNewLine) 
  If F <> "" And FSO.FileExists(F) Then 
    MSG.Attachments.Add F 
  End If 
Next 


MSG.Display 

Set MSG = Nothing 
Set MSO = Nothing 
Set FSO = Nothing 
WScript.Quit 

Function GetComment(pPath) 
  Const CommFile = "descript.ion" 
  Dim lPath, lName, lText, lComm 
  Dim lNameArch
  lPath = FSO.GetParentFolderName(pPath) 				'получить название полного пути
  lName = FSO.GetFile(pPath).Name 					'получить название файла
  lnameArch=lName
  lName = RusDosWin(lName,0)
  If Instr(lName, " ") > 0 Then lName = """" & lName & """" 		'если в наименовании файла есть пробелы, тогда название заключить в кавычки
  If lPath <> "" Then lPath = lPath & "\" 				'если наименование пути не пустое, тогда прибавить в конец слэш
  If FSO.FileExists(lPath & CommFile) Then 				'если файл descript.ion в текущей директории есть, тогда проведем дейстия по поиску комментария
    lText = FSO.OpenTextFile(lPath & CommFile).ReadAll 			'передать в контейнер (переменной) текст файла descript.ion
    lComm = Filter(Split(lText, vbNewLine), lName & " ", True, 1) 	'выбрать строку соответствующую наименованию файла
    If UBound(lComm) > - 1 Then 					'если выбранная строка содержит значение
      GetComment = Replace(Mid(lComm(0), Len(lName) + 2), "В", "") 	'вырезать (Mid) комментарий и заменить (Replace) значение "В" на пустое
      GetComment = Trim(Replace(GetComment, "\n", " ")) 
    Else 
      GetComment = "" 
    End If 
  Else 									'если файл descript.ion в текущей директории отсутствует
    GetComment = "" 							'тогда комментарий пустой
  End If
  GetComment=RusDosWin(GetComment,1) 
End Function 

'=========================================================================================================
Function RusDosWin(TextV, CodeV)
'  Преобразование КИРИЛЛИЦЫ:
'  CodeV = 0 - из DOS в Windows
'        = 1 - обратно
'  D - константа кодов русских символов для DOS (cp866)
'  W - константа кодов русских символов для Windows (cp1251)
'  обе константы содержат такую последовательность символов:
'  АБВ...Яабв...я
'============================================
Const D = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя№"
Const W = "ЂЃ‚ѓ„…р†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—?™љ›њќћџ ЎўЈ¤Ґс¦§Ё©Є«¬­®Їабвгдежзийклмнопь"
'           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^¦
' ============================================
If CodeV = 0 Then
      RusDosWin = SymChange(TextV, W, D)
    Else
      RusDosWin = SymChange(TextV, D, W)
End If
'RusDosWin = D
End Function

Function SymChange(TextVal, NewCode, OldCode)
'  Перекодировка символов  OldCode -> NewCode:
'  в переменной TextVal все символы набора OldCode заменяются на соответствующие символы набора NewCode$
'  ВНИМАНИЕ! Должно выполняться условие:  LEN(NewCode)=LEN(OldCode)
Dim Sym, PromText
Dim Ltext
Dim i, k
Sym = "" ' TextVal
Ltext = Len(TextVal)
If Ltext > 0 Then
    For i = 1 To Ltext
        PromText = Mid(TextVal, i, 1) 				'вырезаем символ из первоначальной строки
        If Asc(PromText) > 126 Then   				'если код вырезанного символа больше 126 (т.е. требует расшифровки)
	    k = InStr(OldCode, PromText)  			'ищем порядковый номер вхождения вырезанного символа в таблицу OldCode
            If k > 0 Then             				'тогда, если порядковый номер вхождения более 0 (т.е. найден)
	        Sym = Sym & Mid(NewCode, k, 1) 			'тогда, добавляем к результирующей строке соответствующий символ из NewCode
	    Else 						'если в OldCode соответствующий символ не найден,
		MsgBox "Символ «" & PromText & "не найден"	'тогда показать этот символ
	    end if	
        Else							'если код вырезанного символа меньше 126
            Sym = Sym & PromText				'тогда вставим в результирующкю строку вырезанный символ без изменений
        End If
    Next
End If
SymChange = Sym
End Function
Надеюсь это не возбраняется?

Добавлено: Пн июн 07, 2010 11:53
AVos002
Batya писал(а):Покажи мне содержимое файла:
AVos002 писал(а):C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs
Именно этот текст содержится в Proba.vbs

Добавлено: Пн июн 07, 2010 13:40
Batya
AVos002 писал(а):Именно этот текст содержится в Proba.vbs
А ты сейчас дома?

Добавлено: Пн июн 07, 2010 13:52
AVos002
Сейчас я на работе, но если договоримся по времени, могу быть дома.
З.Ы. Как тебе моя дописка в скрипте?

Добавлено: Пн июн 07, 2010 16:41
Batya
AVos002 писал(а):Сейчас я на работе, но если договоримся по времени, могу быть дома.
А чего договариваться? Покажи код файла "C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs", который дома. Завтра разберёмся.
AVos002 писал(а):З.Ы. Как тебе моя дописка в скрипте?
Главное, чтобы тебя устраивало ;)
У меня в загашнике есть пару методов конвертации. Один похож на твой.

Код: Выделить всё

'Конвертация текста OEM-866 в Win-1251
Function Dos2Win(pDosString)
  Dim i, lStr
  If Len(pDosString) = 0 Then Exit Function
  For i = 1 To Len(pDosString)
    lStr = Asc(Mid(pDosString, i, 1))
    If     lStr >= 128 And lStr <= 175 Then
                                           Dos2Win = Dos2Win & Chr(lStr + 64)
    ElseIf lStr >= 224 And lStr <= 239 Then
                                           Dos2Win = Dos2Win & Chr(lStr + 16)
    ElseIf lStr  = 240                 Then
                                           Dos2Win = Dos2Win & Chr(168)
    ElseIf lStr  = 241                 Then
                                           Dos2Win = Dos2Win & Chr(184)
    ElseIf lStr  = 255                 Then
                                           Dos2Win = Dos2Win & Chr(160)
    Else
                                           Dos2Win = Dos2Win & Chr(lStr)
    End If
  Next
End Function

Код: Выделить всё

Set FSO = CreateObject("Scripting.FilesystemObject")
MsgBox StrConv(FSO.OpenTextFile("dos.txt").ReadAll, "ibm866", "windows-1251")

Function StrConv(Text, SourceCharset, DestCharset)
  With CreateObject("ADODB.Stream")
    .Type = 2
    .Mode = 3
    .Open
    .Charset  = DestCharset
    .WriteText Text
    .Position = 0
    .Charset  = SourceCharset
    StrConv   = .ReadText
  End With
End Function

Добавлено: Пн июн 07, 2010 17:07
MVV
Самый быстрый способ перекодировки - составить таблицу, где на позиции, соответствующей индексу (коду за вычетом 128) исходного символа будет стоять символ, на который его нужно заменить. Тогда отпадет необходимость в поиске символа в строке, а также в конкатенации строк, нужно будет лишь один раз пройтись по строке и исправить каждый ее символ на символ, указанный в массиве (если скрипт позволяет модифицировать строки). А таблица будет всего на 128 элементов, и строить ее проще простого - пишем в бинарник коды от 128 до 255 и перекодируем в любом редакторе файл из 866 в 1251 - таблица готова!

Код: Выделить всё

АБВГДЕЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдежзийклмноп---¦+¦¦¬¬¦¦¬---¬L+T+-+¦¦Lг¦T¦=+¦¦TTLL-г++----¦¦-рстуфхцчшщъыьэюяЁёЄєЇїЎў°•·v№¤¦ 
(таблица для перекодировки 866->1251, перекодировано в EmEditor; один символ форум передал неверно - неразрывный пробел)[size=0][/size]

Код: Выделить всё

??'?":ЕШ?%?<?????''""--?T?>????яцч?э?ірcт<ї-Rфш+???зъсьу>???хЂЃ‚ѓ„…†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—˜™љ›њќћџ ЎўЈ¤Ґ¦§Ё©Є«¬-®Їабвгдежзийклмноп
(таблица для перекодировки 1251->866, перекодировано в EmEditor; три символа форум передал неверно - для букв Ш, а, н)[size=0][/size]

Таким образом, для каждого символа s исходной строки новый символ равен table[код(s)-128] (или самому себе, если s<128) - небольшой циклик. А таблицу перекодировки лучше передавать в функцию как параметр.

Добавлено: Пн июн 07, 2010 18:10
AVos002
Спасибо MVV, сейчас переварю и попробую сделать на VBScript.

Добавлено: Ср июн 09, 2010 22:54
AVos002
Привет Batya, прошу прощения за паузу, не было возможности зайти на форум.
Batya писал(а):А чего договариваться? Покажи код файла "C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs", который дома. Завтра разберёмся.

Код: Выделить всё

'============================================================== 
' Открытие нового сообщния MS Outlook с вложенными файлами 
' 
' Параметры: 
' {файл для комментария} {файл-список файлов для вложения} 
' 
' Пример параметров при вызове из TC: 
' %P%N %L 
'============================================================== 
Option Explicit 

Dim FSO, MSO, MSG, File, List, F 
Set FSO = CreateObject("Scripting.FileSystemObject") 
File    = WScript.Arguments(0) 
List    = WScript.Arguments(1) 

Set MSO = CreateObject("Outlook.Application") 
Set MSG = MSO.CreateItem(0) 

MSG.Subject = FSO.GetFileName(File) & " [" & GetComment(File) & "]" 
MSG.Body    = "Добрый день!" & vbCrLf & vbCrLf & _ 
              "---"  & vbCrLf & _ 
         "С Уважением, AVos002" 

For Each F In Split(FSO.OpenTextFile(List).ReadAll, vbNewLine) 
  If F <> "" And FSO.FileExists(F) Then 
    MSG.Attachments.Add F 
  End If 
Next 


MSG.Display 

Set MSG = Nothing 
Set MSO = Nothing 
Set FSO = Nothing 
WScript.Quit 

Function GetComment(pPath) 
  Const CommFile = "descript.ion" 
  Dim lPath, lName, lText, lComm 
  Dim lNameArch 
  lPath = FSO.GetParentFolderName(pPath)             'получить название полного пути 
  lName = FSO.GetFile(pPath).Name                'получить название файла 
  lnameArch=lName 
  lName = RusDosWin(lName,0) 
  If Instr(lName, " ") > 0 Then lName = """" & lName & """"       'если в наименовании файла есть пробелы, тогда название заключить в кавычки 
  If lPath <> "" Then lPath = lPath & ""             'если наименование пути не пустое, тогда прибавить в конец слэш 
  If FSO.FileExists(lPath & CommFile) Then             'если файл descript.ion в текущей директории есть, тогда проведем дейстия по поиску комментария 
    lText = FSO.OpenTextFile(lPath & CommFile).ReadAll          'передать в контейнер (переменной) текст файла descript.ion 
    lComm = Filter(Split(lText, vbNewLine), lName & " ", True, 1)    'выбрать строку соответствующую наименованию файла 
    If UBound(lComm) > - 1 Then                'если выбранная строка содержит значение 
      GetComment = Replace(Mid(lComm(0), Len(lName) + 2), "В", "")    'вырезать (Mid) комментарий и заменить (Replace) значение "В" на пустое 
      GetComment = Trim(Replace(GetComment, "\n", " ")) 
    Else 
      GetComment = "" 
    End If 
  Else                            'если файл descript.ion в текущей директории отсутствует 
    GetComment = ""                      'тогда комментарий пустой 
  End If 
  GetComment=RusDosWin(GetComment,1) 
End Function 

'========================================================================================================= 
Function RusDosWin(TextV, CodeV) 
'  Преобразование КИРИЛЛИЦЫ: 
'  CodeV = 0 - из DOS в Windows 
'        = 1 - обратно 
'  D - константа кодов русских символов для DOS (cp866) 
'  W - константа кодов русских символов для Windows (cp1251) 
'  обе константы содержат такую последовательность символов: 
'  АБВ...Яабв...я 
'============================================ 
Const D = "АБВГДЕЁЖЗИЙКЛМНОПРСТУФХЦЧШЩЪЫЬЭЮЯабвгдеёжзийклмнопрстуфхцчшщъыьэюя№" 
Const W = "ЂЃ‚ѓ„…р†‡€‰Љ‹ЊЌЋЏђ‘’“”•–—?™љ›њќћџ ЎўЈ¤Ґс¦§Ё©Є«¬­®Їабвгдежзийклмнопь" 
'           ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^¦ 
' ============================================ 
If CodeV = 0 Then 
      RusDosWin = SymChange(TextV, W, D) 
    Else 
      RusDosWin = SymChange(TextV, D, W) 
End If 
'RusDosWin = D 
End Function 

Function SymChange(TextVal, NewCode, OldCode) 
'  Перекодировка символов  OldCode -> NewCode: 
'  в переменной TextVal все символы набора OldCode заменяются на соответствующие символы набора NewCode$ 
'  ВНИМАНИЕ! Должно выполняться условие:  LEN(NewCode)=LEN(OldCode) 
Dim Sym, PromText 
Dim Ltext 
Dim i, k 
Sym = "" ' TextVal 
Ltext = Len(TextVal) 
If Ltext > 0 Then 
    For i = 1 To Ltext 
        PromText = Mid(TextVal, i, 1)             'вырезаем символ из первоначальной строки 
        If Asc(PromText) > 126 Then               'если код вырезанного символа больше 126 (т.е. требует расшифровки) 
       k = InStr(OldCode, PromText)           'ищем порядковый номер вхождения вырезанного символа в таблицу OldCode 
            If k > 0 Then                         'тогда, если порядковый номер вхождения более 0 (т.е. найден) 
           Sym = Sym & Mid(NewCode, k, 1)          'тогда, добавляем к результирующей строке соответствующий символ из NewCode 
       Else                   'если в OldCode соответствующий символ не найден, 
      MsgBox "Символ «" & PromText & "не найден"   'тогда показать этот символ 
       end if    
        Else                     'если код вырезанного символа меньше 126 
            Sym = Sym & PromText            'тогда вставим в результирующкю строку вырезанный символ без изменений 
        End If 
    Next 
End If 
SymChange = Sym 
End Function
При запуске ошибка следующая - >
======================
Строка: 78
Символ: 18
Ошибка: Недопустимый знак
======================
Я посчитал координату ошибки - это строка в которой объявляется константа W, символ - р (возможно форум не передает должной кодировки)

Добавлено: Чт июн 10, 2010 02:22
Volniy
Вот тут у меня была функция WIN2DOS, уж проще некуда. Так вот в том посте есть ссылка на VBS файл с этой функой. Это чтобы без ошибок с форумными перекодировками.

PS Если вдруг кто не догадается: для версии DOS2WIN нужно лишь поменять местами значения перменных с наборами символов.

Добавлено: Чт июн 10, 2010 10:53
Batya
AVos002 писал(а):Ошибка: Недопустимый знак
Слушай, я всё-таки не понял, а где же ошибка с GetExtensionName?

Проверь сначала работу скрипт без перекодировки.
Если работает, то далее возможны 2 варианта:
1. Использовать какую-нибудь другую функцию перекодирования. Их уже тебе дали достаточно.
2. Перекодировать все descript.ion в Windows-кодировку. Тебе зачем-нибудь ещё нужно в DOS?

Добавлено: Вс ноя 27, 2011 14:06
KarS
Batya
Установил скрипт, выложенный на предыдущей странице топика.
Работает! :D У меня Win7, MS Outlook 14.
Большое спасибо за помощь в автоматизации. :D
Часовой пояс: UTC+03:00
Страница 4 из 4

Создано на основе phpBB® Forum Software © phpBB Limited

Русская поддержка phpBB