AVos002
|
 Posted: Mon Jun 07, 2010 11:32 Post subject: |
 |
|
Batya!
, , .
DOS Windows , : | Code: |
'==============================================================
' 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
|
? |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
