Скачать yandex [Windows, Linux]
Allows you to create a new file in the same folder as the current file.
Since the path to the file is taken from the title, the flag for displaying the path in the title must be enabled in the IDE settings.
Command to start operation
AnotherFileNearby.exe "file" [mode [NamePart [Folder]]]
Options:
file - (in quotes) the file for which to make a copy / backup / dummy
The mode flag can be a combination of the following options
1 - creates a New file with an index, otherwise the name of the source file with an index.
The index is incremented until a non-existent file is found.
2 - displays a dialog for changing the name previously calculated
4 - creates a new empty file, otherwise copies the current one
8 - do not open the file when creating a copy, but give a success message
16 - time added to the file name (AnotherFileNearby_2023.04.21-15.20.09)
NamePart is part of the name. If the flag contains 1 then this is the file name, otherwise it is the separator between the source name and the counter
Folder - relative path to make a backup in a separate folder. If the path is absolute, then copies will be created all in one folder.
For example:
Old version (backup)
AnotherFileNearby.exe "%FILE" 8 "" "Old"
New side by side, empty (for feature test, with name prompt)
AnotherFileNearby.exe "%FILE" 7 ""
New copy (for experimenting with a copy of the original)
AnotherFileNearby.exe "%FILE"
Backup
AnotherFileNearby.exe "%FILE" 8 "" "C:\Users\username\AppData\Roaming\PureBasic\бэкап\"
Code: Select all
; AZJIO
; https://www.purebasic.fr/english/viewtopic.php?t=81207
; Плаг для IDE
; Позволяет создать новый файл в той же папке, что и текущий файл.
; Так как путь к файлу берётся из заголовка, то в настройках IDE должен быть включен флаг отображения пути в заголовке.
; AnotherFileNearby.exe "file" [mode [NamePart [Folder]]]
; Параметры:
; file - (в кавычках) файл для которого сделать копию/бэкап/пустышку
; mode - Флаг, может быть комбинацией следующих параметров
; 1 - собственное имя файла указанное в %NamePart, иначе имя исходного файла.
; Индекс увеличивается пока не будет найден несуществующий файл
; 2 - выдаёт диалог для изменения имени, предварительно вычисленного
; 4 - создаёт новый пустой файл, иначе копирует текущий
; 8 - не открывать файл при создании копии, но выдавать сообщение об успешности
; 16 - время к имени файла
; NamePart это часть имени. Если флаг содержит 1 то это имя файла, иначе это разделитель между именем исходника и счётчиком
; Folder - относительный путь, чтобы сделать бэкап в отдельной папке.
; План
; Добавить время к имени файла флагом 16
; For example:
; Старая версия (бэкапирование)
; AnotherFileNearby.exe "%FILE" 8 "" "Old\"
; Новый рядом, пустой (для теста функции, с запросом имени)
; AnotherFileNearby.exe "%FILE" 7 ""
; Новая копия (для экперимента с копией исходника)
; AnotherFileNearby.exe "%FILE"
EnableExplicit
Declare ForceDirectories(Dir.s)
; Определение языка интерфейса и применение
; Определяет язык ОС
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
Global UserIntLang, *Lang
If OpenLibrary(0, "kernel32.dll")
*Lang = GetFunction(0, "GetUserDefaultUILanguage")
If *Lang
UserIntLang = CallFunctionFast(*Lang)
EndIf
CloseLibrary(0)
EndIf
CompilerCase #PB_OS_Linux
Global UserIntLang$
If ExamineEnvironmentVariables()
While NextEnvironmentVariable()
If Left(EnvironmentVariableName(), 4) = "LANG"
; LANG=ru_RU.UTF-8
; LANGUAGE=ru
UserIntLang$ = Left(EnvironmentVariableValue(), 2)
Break
EndIf
Wend
EndIf
CompilerEndSelect
;- Lang
Global Dim Lng.s(4)
Lng(0) = "File name"
Lng(1) = "Name without extension"
Lng(2) = " already exists"
Lng(3) = "Could not create folder"
Lng(4) = "Done"
; Поддержка русского языка
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
If UserIntLang = 1049
CompilerCase #PB_OS_Linux
Define Home$
If UserIntLang$ = "ru"
CompilerEndSelect
Lng(0) = "Имя файла"
Lng(1) = "Имя без расширения"
Lng(2) = " уже существует"
Lng(3) = "Не удалось создать папку"
Lng(4) = "Готово"
EndIf
Define SourceFile$, NewFile$, NewPath$, tmp$, NamePart$, NamePart2$, Folder$, mode, CountParam, datetime$
Define Ext$, i, name$, hint$ = Lng(0)
CountParam = CountProgramParameters()
If CountParam > 0
SourceFile$ = ProgramParameter(0)
NewPath$ = GetPathPart(SourceFile$)
If CountParam > 1
mode = Val(ProgramParameter(1))
If CountParam > 2
NamePart$ = ProgramParameter(2)
; If Not CheckFilename(NamePart$)
; End
; EndIf
EndIf
If CountParam > 3
Folder$ = ProgramParameter(3)
If Asc(Folder$)
If Right(Folder$, 1) <> #PS$
Folder$ + #PS$
EndIf
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
If Left(Folder$, 1) = #PS$
Folder$ = LTrim(Folder$, #PS$)
EndIf
If Mid(Folder$, 2, 2) = ":\"
NewPath$ = Folder$
Folder$ = ""
EndIf
CompilerCase #PB_OS_Linux
; MessageRequester(Left(Folder$, 1), Str(FileSize(Folder$)))
Home$ = GetHomeDirectory()
If Left(Folder$, 1) = #PS$ ; если "/" в начале, то в 99% это считается абсолютный путь
; Если папка существует или начало её пути является домашней директорией или в пути есть "/"
If FileSize(Folder$) = -2 Or Left(Folder$, Len(Home$)) = Home$ Or FindString(Folder$, #PS$, 2)
NewPath$ = Folder$
Folder$ = ""
Else
Folder$ = LTrim(Folder$, #PS$) ; то есть папка в корне диска это не бэкап, хотя ели существует, то да.
EndIf
EndIf
CompilerEndSelect
EndIf
EndIf
EndIf
Else
End
EndIf
Ext$ = GetExtensionPart(SourceFile$)
i = 0
; 1 - создаёт файл New с индексом, иначе имя исходного файла с индексом.
If Not (mode & 1)
NamePart2$ = GetFilePart(SourceFile$, #PB_FileSystem_NoExtension)
EndIf
NewPath$ + Folder$ + NamePart2$ + NamePart$
; 16 - время к имени файла
If mode & 16
datetime$ = FormatDate("%yyyy.%mm.%dd-%hh.%ii.%ss", Date())
NewFile$ = NewPath$ + datetime$ + "." + Ext$
Else
Repeat
i + 1
NewFile$ = NewPath$ + Str(i) + "." + Ext$
Until FileSize(NewFile$) < 0
EndIf
; MessageRequester("", NewFile$)
Repeat
; 2 - выдаёт диалог для изменения имени, предварительно вычисленного
If mode & 2
Repeat
name$ = InputRequester(hint$, Lng(1), GetFilePart(NewFile$, #PB_FileSystem_NoExtension))
If Asc(name$) And CheckFilename(name$)
NewFile$ = GetPathPart(NewFile$) + name$ + "." + Ext$
; Debug name$
Break
Else
End
EndIf
; Until FileSize(NewFile$) < 0
ForEver
EndIf
hint$ = name$ + Lng(2)
Until FileSize(NewFile$) < 0
If Not ForceDirectories(GetPathPart(NewFile$))
MessageRequester("", Lng(3))
End
EndIf
; 4 - создаёт новый пустой файл, иначе копирует текущий
If mode & 4
#File = 0
If CreateFile(#File, NewFile$, #PB_UTF8)
WriteStringFormat(#File, #PB_UTF8)
CloseFile(#File)
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
RunProgram(NewFile$)
CompilerCase #PB_OS_Linux
; RunProgram("xdg-open", Chr(34) + NewFile$ + Chr(34), GetPathPart(NewFile$))
RunProgram("xdg-open", Chr(34) + NewFile$ + Chr(34), "")
CompilerEndSelect
EndIf
Else
If CopyFile(SourceFile$ , NewFile$)
; 8 - не открывать файл при создании копии, но выдавать сообщение об успешности
If mode & 8
MessageRequester(Lng(4) + " (" + StrF(FileSize(NewFile$) / 1024.0, 2) + " kb)", GetPathPart(NewFile$) + #CRLF$ + #CRLF$ + GetFilePart(NewFile$))
Else
CompilerSelect #PB_Compiler_OS
CompilerCase #PB_OS_Windows
RunProgram(NewFile$)
CompilerCase #PB_OS_Linux
; RunProgram("xdg-open", Chr(34) + NewFile$ + Chr(34), GetPathPart(NewFile$))
RunProgram("xdg-open", Chr(34) + NewFile$ + Chr(34), "")
CompilerEndSelect
EndIf
EndIf
EndIf
;==================================================================
;
; Author: ts-soft
; Date: March 5th, 2010
; Explain:
; modified version from IBSoftware (CodeArchiv)
; on vista and above check the Request for "User mode" or "Administrator mode" in compileroptions
; (no virtualisation!)
;==================================================================
Procedure ForceDirectories(Dir.s)
Static tmpDir.s, Init
Protected result
If Len(Dir) = 0
ProcedureReturn #False
Else
If Not Init
tmpDir = Dir
Init = #True
EndIf
If (Right(Dir, 1) = #PS$)
Dir = Left(Dir, Len(Dir) - 1)
EndIf
If (Len(Dir) < 3) Or FileSize(Dir) = -2 Or GetPathPart(Dir) = Dir
If FileSize(tmpDir) = -2
result = #True
EndIf
tmpDir = ""
Init = #False
ProcedureReturn result
EndIf
ForceDirectories(GetPathPart(Dir))
ProcedureReturn CreateDirectory(Dir)
EndIf
EndProcedure