Flasher
|
 Posted: Sun Mar 18, 2012 15:12 Post subject: |
 |
|
| Code: | '=========================================================
' Кодировать/декодировать выделенные файлы в/из MIME (b64)
' Параметры: %WL "<путь получателя>" "<упаковывать в zip>"
' Примеры: %WL "%P" | %WL "%T" 1 | %WL C:\Test 1
' Автор: Flasher ©
'=========================================================
With WScript.Arguments
C = .Count : If C = 0 Then WScript.Quit
List = .Item(0) : Path = .Item(1)
End With : L = vbNewLine : Const M = 1
If Right(Path, 1) <> "\" Then Path = Path & "\"
Set XML = CreateObject("MSXml2.DOMDocument")
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Stream = CreateObject("ADODB.Stream") : Stream.Type = 1
If C = 3 Then
Set Shell = CreateObject("Shell.Application")
Exts = "7z|7zip|zip|rar|cab|bzip|bz2|bzip2|arj|tar|gz|tgz"
Temp = CreateObject("WScript.Shell").Environment("Process")("TEMP") & "\"
End If
For Each F in Split(FSO.GetFile(List).OpenAsTextStream(1, -1).ReadAll, L)
If FSO.FileExists(F) Then
If StrComp(FSO.GetExtensionName(F), "b64", 1) = 0 Then
Set OF = FSO.OpenTextFile(F) : Code = OF.ReadAll : OF.Close
LL = InStr(Code, L & L) : NN = InStr(Code, "filename=") + 10
Set DE = XML.CreateElement("tmp") : DE.Text = Mid(Code, LL + 4)
Stream.Open : DE.DataType = "bin.base64" : Stream.Write DE.NodeTypedValue
Name = Mid(Code, NN, LL - NN - 1) : Rename Name
Stream.SaveToFile Path & Name, 2
Stream.Close : Set DE = Nothing : Set OF = Nothing
Else
If C = 3 Then
If InStr(Exts, LCase(FSO.GetExtensionName(F))) = 0 Then
NF = Temp & FSO.GetBaseName(F) & ".zip" : Set ZIP = FSO.CreateTextFile(NF)
ZIP.Close : Set ZIP = Nothing
Set ArchDir = Shell.NameSpace(NF) : ArchDir.CopyHere(F) : WScript.Sleep 50
Size = 0 : Set AF = ArchDir.ParseName(FSO.GetFileName(F))
Do Until Size = FSO.GetFile(F).Size : Size = AF.Size : Loop
WScript.Sleep 10 : Set AF = Nothing : Set ArchDir = Nothing : F = NF
End If
End If
Stream.Open : Stream.LoadFromFile(F)
XML.LoadXML "<Base64Data />" : Set E = XML.documentElement
E.DataType = "bin.base64" : E.NodeTypedValue = Stream.Read
Stream.Close : Name = FSO.GetFileName(F)
FName = FSO.GetBaseName(Name) & ".b64" : Rename FName
Set File = FSO.OpenTextFile(Path & FName, 2, True)
File.Write "MIME-Version: 1.0" & L & _
"Content-Type: application/octet-stream; name=""" & Name & """" & L & _
"Content-Transfer-Encoding: base64" & L & _
"Content-Disposition: attachment; filename=""" & Name & """" & L & L & E.Text
File.Close : Set E = Nothing : If C = 3 Then FSO.DeleteFile F, 1
End If
End If
Next : Set XML = Nothing : Set FSO = Nothing
Set Stream = Nothing : Set Shell = Nothing : WScript.Quit
Sub Rename(FileName)
FN = FileName : n = 0
Do While FSO.FileExists(Path & FileName)
n = n + 1
If l < 10^M Then PFix = Right(String(M, "0") & n, M) Else PFix = n
FileName = FSO.GetBaseName(FN) & " (" & PFix & ")." & FSO.GetExtensionName(FN)
Loop
End Sub |
Минус - кодируется менее сжато, чем с ТС.
Проблем с кириллицей, естественно, нет, как и лишних пустых строк, которые ТС в конец (не понять - зачем) добавляет.
Last edited by Flasher on Tue Mar 20, 2012 00:12; edited 3 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
