| View previous topic :: View next topic |
| Author |
Message |
AVos002
Joined: 04 May 2010
Posts: 47
|
 (Separately) Posted: Sat Jun 05, 2010 00:45 Post subject: |
 |
|
:
================================================================
: C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs
: %P%N %L
================================================================ |
|
| Back to top |
|
 |
Batya
Joined: 15 Dec 2004
Posts: 2236
Location: ,
|
| (Separately) Posted: Mon Jun 07, 2010 10:09 Post subject: |
|
|
| AVos002 wrote: | | : : 'GetExtensionName' |
, , , "GetExtensionName".
:
| AVos002 wrote: | | C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs |
_________________
, . . |
|
| Back to top |
|
|
AVos002
Joined: 04 May 2010
Posts: 47
|
| (Separately) 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
|
? |
|
| Back to top |
|
|
AVos002
Joined: 04 May 2010
Posts: 47
|
| (Separately) Posted: Mon Jun 07, 2010 11:53 Post subject: |
|
|
| Batya wrote: | :
| AVos002 wrote: | | C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs |
|
Proba.vbs |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2236
Location: ,
|
| (Separately) Posted: Mon Jun 07, 2010 13:40 Post subject: |
|
|
?
_________________
, . . |
|
| Back to top |
|
|
AVos002
Joined: 04 May 2010
Posts: 47
|
| (Separately) Posted: Mon Jun 07, 2010 13:52 Post subject: |
|
|
, , .
.. ? |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2236
Location: ,
|
| (Separately) Posted: Mon Jun 07, 2010 16:41 Post subject: |
|
|
? "C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs", . .
, 
. .
| Code: | ' 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 |
| Code: | 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 |
_________________
, . . |
|
| Back to top |
|
|
MVV
Joined: 15 Oct 2009
Posts: 4815
Location: -
|
| (Separately) Posted: Mon Jun 07, 2010 17:07 Post subject: |
|
|
- , , ( 128) , . , , , ( ). 128 , - 128 255 866 1251 - !
| Code: | ---+---L+T+-+LT=+TTLL-++-----v |
( 866->1251, EmEditor; - )
| Code: | ??'?":?%?<?????''""--?T?>??????c<-R+???>???˜- |
( 1251->866, EmEditor; - , , )
, s[i] table[(s[i])-128] ( , s[i]<128) - . .
_________________
TCFS2 + TCFS2Tools: ()
WINCMD.RU: AskParam, CopyTree, NTLinks, Sudo, VirtualPanel |
|
| Back to top |
|
|
AVos002
Joined: 04 May 2010
Posts: 47
|
| (Separately) Posted: Mon Jun 07, 2010 18:10 Post subject: |
|
|
| MVV, VBScript. |
|
| Back to top |
|
|
AVos002
Joined: 04 May 2010
Posts: 47
|
| (Separately) Posted: Wed Jun 09, 2010 22:54 Post subject: |
|
|
Batya, , .
| Batya wrote: | | ? "C:\Program Files\Total Commander\Plugins\tcwhelp_b10\DemoScripts\Proba.vbs", . . |
| 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
|
- >
======================
: 78
: 18
:
======================
- W, - ( ) |
|
| Back to top |
|
|
Volniy
Joined: 15 Dec 2004
Posts: 585
Location:
|
| (Separately) Posted: Thu Jun 10, 2010 02:22 Post subject: |
|
|
WIN2DOS, . VBS . .
PS : DOS2WIN . |
|
| Back to top |
|
|
Batya
Joined: 15 Dec 2004
Posts: 2236
Location: ,
|
| (Separately) Posted: Thu Jun 10, 2010 10:53 Post subject: |
|
|
, - , GetExtensionName?
.
, 2 :
1. - . .
2. descript.ion Windows-. - DOS?
_________________
, . . |
|
| Back to top |
|
|
KarS
Joined: 21 Apr 2006
Posts: 102
Location: .
|
| (Separately) Posted: Sun Nov 27, 2011 14:06 Post subject: |
|
|
Batya
, .
!  Win7, MS Outlook 14.
. |
|
| Back to top |
|
|
|
|
You cannot post new topics in this forum
You cannot reply to topics in this forum
You cannot edit your posts in this forum
You cannot delete your posts in this forum
You cannot vote in polls in this forum
|
Powered by phpBB © 2001, 2005 phpBB Group
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
