Flasher
|
 Posted: Sat Nov 12, 2011 02:04 Post subject: |
 |
|
Не знаю, кому это тут пригодится. Есть виртуальные панели, есть переменные окружения. Всё проще и удобней.
Ярлыки для Проводника, Рабочего стола и т.п., но не для ТС, IMO.
И уж если приводить ссылки, чтобы помогали, то не на результаты поискового запроса, а туда, где было прочитано. Да и скрывать за текстом их не помешало бы.
И в данном случае надо понимать, что файлы, на которые вешаются эти ярлыки, должны лежать в структуре тех каталогов, в которых находятся сами ярлыки. Поэтому абы где их помещать не выйдет.
В 7-ке и Висте можно только через explorer.
| Code: | '••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
' Создание ярлыков (с относительными путями) для выделенных файлов,
' связанных с каталогом-получателем одной путевой цепью в дереве
' Параметры: %L "<Путь назначения>"
' Пример: %L "%T"
' Автор - Flasher ©
'••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••••
With WScript.Arguments
If .Count = 0 Then WScript.Quit
File = .Item(0)
Path = .Item(1)
End With
If Right(Path, 1) <> "\" Then Path = Path & "\"
For Each S in GetObject("winmgmts:{impersonationLevel=impersonate}!\\.\root\cimv2")_
.ExecQuery("Select * from Win32_OperatingSystem")
OS = Mid(S.Caption, 19, 3)
Next
L = vbNewLine
Set FSO = CreateObject("Scripting.FileSystemObject")
For Each F in Split(FSO.OpenTextFile(File, 1).ReadAll, L)
If F > vbNullString Then
PF = FSO.GetParentFoldername(F)
FN = FSO.GetFileName(F)
NP = Left(Path, Len(PF))
If Path = Left(F, Len(Path)) Then
RP = "." & Mid(F, Len(Path))
ElseIf PF = NP Then
For i = 2 To UBound(Split(Mid(Path, Len(NP)), "\"))
Parent = Parent & "..\"
Next
RP = Parent & FN
Else
Count W, L, FN
Do While W = 4
Count W, L, FN
Loop
End If
If W <> 5 Then
If InStr(RP, " ") > 0 Then RP = """" & RP & """"
With CreateObject("WScript.Shell").CreateShortcut(Path & FN & ".lnk")
If InStr(OS, "7") Or InStr(OS, "V") Then
.TargetPath = "%WINDIR%\explorer.exe"
.Arguments = RP
Else
.TargetPath = "%WINDIR%\system32\RunDll32.exe"
.Arguments = "shell32.dll,ShellExec_RunDLL " & RP
End If
.Save
End With
End If
End If
Next
Quit
Sub Count(W, N, NF)
Ln = Len(NF)
Sp = InStrRev(NF, " ")
If Ln > 33 Then
If Ln < 55 Then
A = CInt(Ln-15)
ElseIf Sp < 33 Then
A = Cint(36 - Sp)
Else A = CInt(Sp-15)
End If
Else
A = 17
End If
B = A + 10
W = MsgBox("Отсутствует структурная связь" & N & _
"между получателем и файлом " & N & """" & NF & """" & N & _
N & Space(A) & "Отклонено!", 50, Space(B) & "Создание ярлыков")
If W = 3 Then Quit
End Sub
Sub Quit
Set FSO = Nothing
WScript.Quit
End Sub |
Last edited by Flasher on Mon Nov 14, 2011 00:19; edited 9 times in total |
|
Rules
Search
FAQ
Memberlist
Usergroups
Register
Profile
Log in to check your private messages
Log in
