'==================================================================== ' AJPapps - Add to App Paths ' Линда Кайе 2012. Посвящается Ариэль ' ' Это крошечный скрипт, который прописывает программу в App Paths, ' позволяя запускать её через START или Пуск -> Выполнить. Задача ' не очень героическая, но руками это делать иногда довольно ' утомительно. ' ' • 4.12.2012 ' Первая версия ^^ ' '==================================================================== ' Маленький копирайт ' ' 1. Программа и исходный код распространяются бесплатно. ' 2. Вы имеете право распространять их на тех же условиях. ' 3. Вы не имеете права использовать имя автора после модификации ' исходного кода. ' 4. При этом желательно указывать ссылку на автора оригинальной ' версии исходного кода. ' 5. Вы не имеете права на платное распространение исходного кода, ' а также программных модулей, содержащих данный исходный код. ' 6. Программа и исходный код распространяются как есть. Автор не ' несёт ответственности за любые трагедии или несчастные случаи, ' вызванные использованием программы и исходного кода. ' 7. Для любого пункта данного соглашения может быть сделано ' исключение с разрешения автора программы. ' 8. По любым вопросам, связанным с данной программой, обращайтесь ' по адресу lindaoneesama@gmail.com ' ' Загружено с http://purl.oclc.org/Linda_Kaioh/Homepage/ '==================================================================== Option Explicit Const AppTitle = "AJPapps - Add to App Paths" Const REG_BASE = "HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\App Paths\" If WScript.Arguments.Count <> 1 Then MsgBox "Использование: AddToAppPaths.VBS EXEFileName", _ vbInformation, AppTitle WScript.Quit End If Dim WSH Dim FSO Dim File Dim RegKey On Error Resume Next Set WSH = CreateObject("WScript.Shell") If Err.Number <> 0 Then ErrorDisplayAndQuit "Не удаётся создать объект WScript.Shell." Set FSO = CreateObject("Scripting.FileSystemObject") Set File = FSO.GetFile(WScript.Arguments(0)) If Err.Number <> 0 Then ErrorDisplayAndQuit "Не удаётся получить объект файла. Файл не существует, заблокирован или доступ к нему закрыт." If UCase(Right(File.Name, 4)) <> ".EXE" Then If MsgBox(File.Name & vbCrLf & vbCrLf & _ "Файл программы должен иметь расширение EXE." & vbCrLf & _ "Другие файлы регистрировать не рекомендуется. " & _ vbCrLf & vbCrLf & "Продолжить?", _ vbExclamation + vbOkCancel, AppTitle) = vbCancel Then WScript.Quit End If End If RegKey = REG_BASE & File.Name & "\" WSH.RegWrite RegKey, File.Path, "REG_SZ" If Err.Number <> 0 Then ErrorDisplayAndQuit RegKey & vbCrLf & vbCrLf & "Не удалось записать значение в реестр." RegKey = REG_BASE & File.Name & "\Path" WSH.RegWrite RegKey, File.ParentFolder.Path, "REG_SZ" If Err.Number <> 0 Then ErrorDisplayAndQuit RegKey & vbCrLf & vbCrLf & "Не удалось записать значение в реестр." MsgBox File.Name & " успешно зарегистрирован.", vbInformation, AppTitle '==================================================================== Private Sub ErrorDisplayAndQuit(ByVal Description) Dim TXT TXT = "" If Description <> "" Then TXT = Description & vbCrLf & vbCrLf TXT = TXT & "Ошибка " & Err.Number & ": " & Err.Description MsgBox TXT, vbCritical, AppTitle WScript.Quit End Sub