Total Commander

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

'=================================================== 
' Копирование файлов\папок (в т.ч. из ярлыков) 
' 
' Параметры: 
' {файл-список} {целевая папка} 
' 
' Пример параметров при вызове из TC: 
' %L "%T" 
'=================================================== 
Sub xCopy (Path, TargetPath) 
	Dim lnkName, xFolder, colFiles, objFile, colFolders, objFolder, res

	if Canceled then Exit Sub

	If LCase(FSO.GetExtensionName(Path)) = "lnk" Then 
		lnkName = Replace(FSO.GetFileName(Path), ".lnk", "") 
		Path = WSH.CreateShortcut(Path).TargetPath 

		If FSO.FileExists(Path) then lnkName = lnkName & "." & FSO.GetExtensionName(Path)
	End If 

	If Right(Path, 1) = "\" Then Path = Left(Path, Len(Path) - 1)

	If FSO.FileExists(Path) Then 
		if lnkName = "" then lnkName = FSO.GetFile(Path).Name

		If FSO.FileExists(TargetPath  & lnkName) and not ReplaceAll Then 
			res = msgbox ("File " & FSO.GetFile(Path).Name & " already exists", vbYesNoCancel, "Replase all")

			Select Case res
			Case 6 ' Yes
				ReplaceAll = true
				FSO.CopyFile Path, TargetPath  & lnkName
			Case 2 ' Cancel
				Canceled = true
				Exit Sub
			End Select
		else
			FSO.CopyFile Path, TargetPath  & lnkName
		End If 
	End If	

	If FSO.FolderExists(Path) Then 
		Set xFolder = FSO.GetFolder(Path)
		Set colFiles = xFolder.Files
		Set colFolders = xFolder.subFolders

		if lnkName = "" then  lnkName = FSO.GetFolder(Path).Name & "\"
		if  Not FSO.FolderExists(TargetPath & lnkName) then FSO.CreateFolder(TargetPath & lnkName)

		For Each objFolder in colFolders
			xCopy objFolder, TargetPath &  lnkName & "\"
		Next

		For Each objFile in colFiles
		    xCopy objFile, TargetPath &  lnkName & "\"
		Next

		Set colFolders  = Nothing 
		Set colFiles  = Nothing 
		Set xFolder = Nothing  
	End If 

End Sub


Dim WSH, FSO, FF, ReplaceAll, Canceled

if WScript.Arguments.count < 2 then WScript.Quit 1

Set FSO = CreateObject("Scripting.FileSystemObject") 
Set WSH = CreateObject("WScript.Shell") 
Set FF  = FSO.OpenTextFile(WScript.Arguments(0), 1)
ReplaceAll = false
Canceled = false

Do While Not FF.AtEndOfStream 
	xCopy FF.ReadLine, WScript.Arguments(1)
Loop 

FF.Close 
Set FF  = Nothing 
Set WSH = Nothing 
Set FSO = Nothing 

WScript.Quit 0

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

'•••••••••••••••••••••••• VBS ••••••••••••••••••••••••
' Копирование/перемещение выбранного по заданному пути
' с последующей заменой lnk-ярлыков на целевые объекты

' Условие:    путь запуска — пустой
' Примечание: в пути достаточно правильной буквы диска
'
' Параметры: %WF "<путь назначения>" <copy/move>
' Ключ системного автопереименования объектов: /r

' Примеры:   %WF "%PMy Folder" copy /r
'            %WF D:\New\New2\New3\New4\New5 move
'•••••••••••••••••••••••••••••••• Автор: Flasher © •••

Option Explicit : Dim A, FSO, REx, Rgx, T, Ren,_
D, Dic, Col, ShA, oFolder, oList, List, Folders,_
N, Items, F, Nm, Targ, Lnk, i, FPath, FlEx, FdEx

Set A = WSH.Arguments : If A.Count = 0 Then WSH.Quit
Set FSO = CreateObject("Scripting.FileSystemObject")
Set REx = New RegExp : REx.Pattern = "([.+[\(){$^])"
Set Rgx = New RegExp : Rgx.IgnoreCase = True
T = Timer: If A.Named.Exists("r") Then Ren = 8
REx.Global = True : D = FSO.GetDriveName(A(1))
Set Dic = CreateObject("Scripting.Dictionary")
Set Col = CreateObject("Scripting.Dictionary")
Set ShA = CreateObject("Shell.Application")

ShA.NameSpace(D).NewFolder Mid(A(1), Len(D) + 2)
Set oFolder = ShA.NameSpace(FSO.GetAbsolutePathName(""))
List = FSO.OpenTextFile(A(0),,,-1).ReadAll
oList = Split(List, vbNewLine)
For Each N in Filter(oList, ";")
  Nm = N
  If StrComp(FSO.GetExtensionName(N), "lnk", 1) _
  = 0 Then N = oFolder.ParseName(N).GetLink.Target
  Set Items = oFolder.Items
  Items.Filter 78064, Replace(N, ";", "?")
  Rgx.Pattern = "(^|\n)" & REx.Replace(N, "\$1") & "(\r|$)"
  For Each F in Items
    If Not F.IsLink Then N = "" Else N = F.GetLink.Path
    F = FSO.GetFileName(F.Path)
    If InStr(F, ";") Then Dic.Add F, N : Exit For
  Next : List = Rgx.Replace(List, "$1")
Next

Rgx.Pattern = "\r\n$" : List = Rgx.Replace(List, "")
Folders = Left(List, InStrRev(List, "\"))
For Each N in Filter(oList, ".lnk", 1, 1)
  If InStr(N, ";") = 0 Then
  With oFolder.ParseName(N)
    If .IsLink Then _
    Col.Add N, .GetLink.Path : Rgx.Pattern = "(^|\n)" &_
    REx.Replace(FSO.GetBaseName(N),"\$1") & "\.lnk(\r|$)":_
    List = Rgx.Replace(List, "$1" & .GetLink.Target & "$2")
  End With
  End If
Next : Set Items = oFolder.Items
Rgx.Pattern = "(^|\n)" & FSO.GetFileName(A(1)) & "\\(\r|$)"
List = Rgx.Replace(List, "$1") : If List = "" Then WSH.Quit

Set Targ = ShA.NameSpace(A(1)) : Items.Filter 78064,_
Replace(Replace(List, "\", ""), vbCrLf, ";")
Execute "Targ." & A(2) & "Here Items, 4112 + Ren"

For Each D in Array(Dic, Col)
  If D.Count Then
    For Each F in D
      FPath = D(F) : FlEx = FSO.FileExists(FPath)
      FdEx = FSO.FolderExists(FPath)
      If FlEx Or FdEx Then
        If LCase(A(2)) = "move" Then _
        If FlEx Then FSO.DeleteFile F, 1 Else FSO.DeleteFolder F, 1
        Targ.CopyHere FPath, 4112 + Ren
      End If
    Next
  End If : Set D = Nothing : i = 1
Next
For Each F in Split(Folders, vbCrLf) : FFolder FSO.BuildPath(A(1), F) : Next
T = Timer - T
If T > 3 Then
  Dim Sec, Title : If T < 10 Then Sec = 2 Else If T < 30 Then Sec = 4
  Title = "Копирование": If LCase(A(2)) = "move" Then Title = "Перемещение"
  CreateObject("WScript.Shell").Popup "Выполнено!", Sec, " " & Title, 4160
End If

Sub FFolder(Folder)
  Dim oFold, File, Fold
  Set oFold = ShA.NameSpace(Folder)
  Set Items = oFold.Items : Items.Filter 78032, "*"
  For Each File in Items
    If File.IsLink And LCase(FSO.GetExtensionName(File.Path)) <> "url" Then _
    oFold.CopyHere File.GetLink.Path, 4112 + Ren : FSO.DeleteFile File.Path, 1
  Next : Items.Filter 78000, "*"
  For Each Fold in FSO.GetFolder(Folder).SubFolders
    If FSO.FolderExists(Fold) Then FFolder Fold.Path
  Next
End Sub

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

TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy
C:\Windows\System32\WScript.exe,2
ReadMe


-1

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

Сценарий:	C:\ReadMe.vbs
Строка:	0
Символ:	1
Ошибка:	Недопустимый вызов или аргумент процедуры
Код:	800A0005
Источник: 	Ошибка выполнения Microsoft VBScript

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

1992.10 - Out Of Space (Elektra 2-66346).LNK
1992.11 - Out Of Space (XLS 35CD).LNK
2009.11 - Invaders Must Die (HOSPCDS06).LNK
2012.09.04 - 7th Mini Album - Mirage.LNK

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

TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy /r
C:\Windows\System32\WScript.exe,2
ReadMe


-1

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

— копия

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

Сценарий:	C:\ReadMe.vbs
Строка:	33
Символ:	5
Ошибка:	Требуется объект
Код:	800A01A8
Источник: 	Ошибка выполнения Microsoft VBScript

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

01 mka dvd-audio araw;24bit,96000hz,4608kbs.mka

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

TOTALCMD#BAR#DATA
C:\ReadMe.vbs
%WF "%T" copy /r
C:\Windows\System32\WScript.exe,2
ReadMe


-1