October 2025
|
|
|
1 |
2 |
3 |
4 |
5 |
6 |
7 |
8 |
9 |
10 |
11 |
12 |
13 |
14 |
15 |
16 |
17 |
18 |
19 |
20 |
21 |
22 |
23 |
24 |
25 |
26 |
27 |
28 |
29 |
30 |
31 |
|
12/5/22 12:27 am
Transren
Translit Renamer - программа, которая заменяет русские буквы в именах файлов на латинские, т.е. транслитерирует имена файлов и каталогов. v 0.0.1b (L) ChaosSoftware 2022.
Использование: transren.exe <-h>|<-m <mask> и/или <-t>>[-d] [-s]
-h - эта помощь
-m <mask> - Маска <mask> , маска для файлов, которые нужно переименовать
-t - переименовать каталоги (по маске каталоги не ищет)
[-d] <directory> - Стартовый каталог. Если не указан, используется текущий каталог.
[-s] - включить в поиск подкаталоги
[-f] - только поиск, показывает файлы для переименования
Примеры:
transren.exe -m *.html - транслитерировать *.html в текущем каталоге
transren.exe -t - переименовать подкаталоги в текущем каталоге
transren.exe -m *.html -s - переименовать *.html в текущей директории и всех подкаталогах
transren.exe -m *.* -s -t - транслитерировать все файлы и все поддиректории в текущей директории
transren.exe -m *.html -d D:\DOC\ - транслитерировать файлы *.html в каталоге D:\DOC
Если файл существует, программа спросит, заменить ли его. Если каталог существует, программа его пропустит.
Скриншоты

Как сделалБыла у меня для этих целей программулина на VB 6.0, но за давностью лет проебалась, вместе с исходниками. Пришлось с ноля переписывать на Трупопаскале FreePascal, в принципе, как написаны основные части, я уже рассказал, по тегу pascal ( копия на LJR) Зато не требует за собой таскать framework и кучу библиотек. Системные требования+ 64 Мб ОП + 800 Kb HDD + OS: Windows XP - Windows 11. СкачатьЭкзешникИнсталлятор (распаковывается в %WINDIR% )ZIP-архивИсходникиНа GitHubЭто репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/12/05/transren/
12/3/22 01:39 am
Lazarus: Crt, WinCrt, русский язык и нажатие клавиши в консоли.
Понадобилось сделать что-то типа такого:
Файл уже существует. Заменить? [Y/N]
Вспомнил, что в Турбопаскале была функция ReadKey из модуля Crt , а вдруг и во FreePascal есть?
Есть, но модуль Crt делает глюк русскому языку:
program TestCrt;
uses Crt;
var Ch:char;
begin
WriteLn('Нажмите любую клавишу...');
Ch:=ReadKey;
end.
 Ладно, пробуем заменить Crt на WinCrt . Глюк с русским языком пропал, но функция ReadKey на нажатие клавиш не реагирует, да пиздец, еб твою мать! В общем, долго плевался, реализовал через TKeyEvent из модуля Keyboard : uses SysUtils,Keyboard;
function Ask(FilePath:UnicodeString):boolean;
var K: TKeyEvent;
KS:String;
begin
WriteLn ('File ', FilePath, ' is exists! Replace file? [Y/N]');
InitKeyBoard;
while true do begin
K:=GetKeyEvent;
K:=TranslateKeyEvent(K);
KS:=KeyEventToString(K);
if (KS='Y') or (KS='y') then begin DoneKeyBoard; exit(true); end;
if (KS='N') or (KS='n') then begin DoneKeyBoard; exit(false); end;
end;
DoneKeyBoard;
exit(false);
end; Исходник на PasteBinЭто репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/12/03/lazarus-crt-wincrt-russkij-yazyk-i-nazhatie-klavishi-v-konsoli/
12/2/22 02:22 am
Lazarus, сортировка TStringList.
ПреамбулаИногда список строк ( TStringList ) требуется сортировать, что, как бы, понятно. Но во Freepascal сортировка устроена довольно странно, в C# у аналогичного класса из коробки несколько больше возможностей, во всяком случае, можно поменять направление, по возрастанию или по убыванию. С хитрыми сортировками, конечно, тоже вылезает нетривиальщина, но на то они и хитрые сортировки. Тестовые спискиДля начала сформируем тестовые списки, для русского и английского языков. Там код тривиален, потому не буду загружать заметку, ссылки на PasteBin: Тестовый список для английского языкаТестовый список для русского языкаЗаодно уж и выведем списки в их изначальном виде: Стандартная сортировкаОна же единственная из коробки, является стандартной сортировкой по возрастанию, т.е. список сортируется от меньшего к большему, а об алгоритме будет ниже. Вызов функции простой: lstTest.Sort; Пробуем. Выводим список на экран: WriteLn('Сортировка по возрастанию (по-умолчанию, логическая):'); i:=0; while i < lstTest.Count do begin WriteLn(lstTest[i]); inc(i); end;
Writeln(); WriteLn('Press Enter...'); ReadLn(); Результат:  Как обычно, с поддержкой русского язкы все весело, но чинить эту поддержку в данной заметке не буду. Кому сильно надо - пишите. Стандартный алгоритм сравнения строк во freepascalАлгоритм: 1. Строки сравниваются посимвольно. Например, в словах parrot и puppy первые символы ( p и p ) равны, а далее a меньше u , т.е u в кодовой таблице находится ниже, чем a . 2. На этом сравнение прекращается, строка puppy больше чем parrot . 3. Если начальные символы строк совпадают, то в дело вступает длина, чем строка длиннее, тем она больше, поэтому, зависимая от центра Каталония, все еще больше, чем кот, который гуляет сам по себе: program test;
var
S1:string;
S2:string;
begin
S1:='cat';
S2:='catalonia';
if S1 < S2 then Writeln ('S1 (',S1,') < S2 (',S2,')' );
if S1 = S2 then Writeln ('S1 (',S1,') = S2 (',S2,')' );
if S1 > S2 then Writeln ('S1 (',S1,') > S2 (',S2,')' );
Readln();
end.
Вывод: S1 (cat) < S2 (catalonia) Что, конечно, печально, потому что кот свободнее Каталонии, и явно больше в этом смысле. Пользовательские функции сортировкиОграничение, накладываемое одной функцией сортировки в комплекте класса TStringList легко решается тем, что можно подключить любую пользовательскую сортировку ссылкой на внешнюю функцию. Для этого надо установить пользовательскую функцию сортировки, таким вот образом: lstTest.CustomSort(@MySort); где MySort - имя вашей функции сортировки. Естественно, она должна быть заранее создана, чтобы все откомпилировалось и заработало. Не забудьте про символ @ перед именем функции, в Delphi не надо было его указывать, компилятор сам знал, где вместо имени функции вставить ссылку на ее адрес, в freepascal это надо указывать явно.Формат функции следующий: MySort(List: TStringList; Index1, Index2: Integer): Integer; Т.е. на входе нужна переменная типа TStringList и две переменные типа Integer , для индексов строк в списке, функция должна возвращать значение типа Integer : 1 - Если строка Index1 > Index2 0 - Если строки равны -1 - Если строка Index1 < Index2 Конечно, по мнению пользовательского алгоритма сортировки. Например, можем повторить стандартный метод сортировки: function SortByAsc(List: TStringList; Index1, Index2: Integer): Integer;
begin
if List[Index1]>List[Index2] then
begin
Result := 1;
Exit;
end;
if List[Index1]=List[Index2]
then Result := 0
else Result := -1;
end;
 Внезапно, починился русский язкы :) Сортировка по убываниюfunction SortByDesc(List: TStringList; Index1, Index2: Integer): Integer;
begin
if List[Index1]<List[Index2] then
begin
Result := 1;
Exit;
end;
if List[Index1]=List[Index2]
then Result := 0
else Result := -1;
end;
Вообще просто, достаточно заменить знак > на < в операторе сравнения. Другие пользовательские сортировкиВозможности пользовательских сортировок не ограничены практически ничем. Покажу, как обычно, самое простое - сортировка строк по длине. Сортировка по возрастанию: function SortByLenAsc(List: TStringList; Index1, Index2: Integer): Integer;
begin
if Length(List[Index1])>Length(List[Index2]) then
begin
Result := 1;
Exit;
end;
if Length(List[Index1])=Length(List[Index2])
then Result := 0
else Result := -1;
end;
Т.е. просто применяем функцию Length в операторе сравнения: Length(List[Index1])  Тот же вариант, но по убыванию: function SortByLenDesc(List: TStringList; Index1, Index2: Integer): Integer;
begin
if Length(List[Index1])<Length(List[Index2]) then
begin
Result := 1;
Exit;
end;
if Length(List[Index1])=Length(List[Index2])
then Result := 0
else Result := -1;
end;
Тестовые программыПример для английского языка на GitHubПример для русского языка на GitHubПо мотивамОбсуждения на Исходниках, но более подробнее и лучше у меня. Это репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/12/02/lazarus-sortirovka-tstringlist/
11/28/22 02:31 pm
Lazarus. Поддержка Unicode в консоли Windows.
Продолжаем бодаться с русским языком в консоли (копия).
Ну не может же быть так, что виндовая консоль и Unicode (UTF-8) не поддерживает, подумал я. У меня и функции, которые, собственно, в программе нужны, UTF8 требуют, и с русским языком, если исходник не в UTF-8 работают криво, и в документации по Lazarus написано, что он поддерживает вывод на консоль в UTF-8, и в документации по винде написано, что она тоже нежно любит UTF-8, хотя может и в OEM(которая CP866).
Хинт оказался небольшим, неочевидным, и вообще был обнаружен чисто случайно, кодировку исходника надо поменять на на CP866, как я делал по ссылке выше, а на UTF-8 с BOM!
И нигде в документации (не в виндовой, не в Лазарувской) об этом не сказано, ну или закопано в такие бездны Варпа, что не докопался.
До (исходник в UTF-8):
 После (исходник в UTF-8 с BOM):  program Project1;
begin
WrileLn('Какая-то фигня с русскими буквами');
WrileLn('А, уже не фигня');
Readln();
end. Это репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/11/28/lazarus-podderzhka-unicode-v-konsoli-windows/
11/27/22 12:04 am
Lazarus, встроенный парсер командной строки.
ПреамбулаВ Lazarus есть довольно неплохой парсер командной строки, который (почти) работает из коробки. Для его использования нужно создать приложение на базе класса TCustomApplication , который обладает таким функционалом. Готовый шаблон проекта имеется в комплекте. Проект --> Создать проект... и в появившемся окне выбрать тип проекта Консольное приложение:  Можно ввести параметры для генерации кода:  Основной код приложения размещается в процедуре DoRun , например, в procedure TMyApplication.DoRun; Решил расширить пример с поиском файла по маске ( копия), заодно поэкспериментировать с парсером командной строки. Параметры будут такие: Использование: smallfinder.exe <аргументы> -h - эта помощь -m <маска> - маска файла для поиска. Обязательный параметр -d <директория> - Начальняя директория, если параметр не указан, используется текущая. -s - включить в поиск подкаталоги Анализ параметров командной строкиПримечание: весь код в процедуре TSmallfinder.DoRun . Почему-то способ проверки из документации, случая, когда параметров нет вообще, у меня сработал криво, так что пришлось вспоминать более старый: // check if no parameters - способ из документации нихуя не сработал
if ParamCount=0 then begin
WriteHelp;
Terminate;
Exit;
end; Но далее все вроде бы пошло как надо, единственное, что параметры регистрозависимые (т.е. -d и -D программа воспринимает как разные параметры), пока не стал с этим разбираться, может после, если сильно надо будет. Длинные имена параметров не использовал, только короткие. Вывод помощи: //help
if HasOption('h', '') then begin
WriteHelp;
Terminate;
Exit;
end;
Процедуру WriteHelp можно создать при создании нового проекта, а потом только запомнить, примерно так: procedure TSmallfinder.WriteHelp;
begin
writeln('Usage: ',ExtractFileName(ExeName), ' <arguments>');
WriteLn('-h - this help');
WriteLn('-m <mask> - file mask for search. Parameter must be!');
WriteLn('-d <directory> - start directory. If not, use current dir.');
WriteLn('-s - include subdirs');
end;
Маска файла: //mask
if HasOption('m','') then begin
Mask:=GetOptionValue('m','');
if Mask = '' then begin
WriteHelp;
Terminate;
Exit;
end;
end;
Стартовый каталог: //start directory
StartDir:=GetOptionValue('d','');
if StartDir='' then begin
StartDir:=GetCurrentDir();
end;
Искать в подкаталогах: //Include subdirs
IncludeSubdirs:=HasOption('s','');
Ну и сам процесс поиска, до кучи: WriteLn('Start directory: ',StartDir);
lstFiles := TStringList.Create;
FindAllFiles(lstFiles, StartDir, Mask, IncludeSubdirs);
i:=0;
while i < lstFiles.Count do begin
WriteLn(lstFiles[i]);
inc(i);
end;
lstFiles.Free();
Естественно, все нужные переменные перечисляем в секции var процедуры TSmallfinder.DoRun var
Mask, StartDir:string;
IncludeSubdirs:boolean;
i:LongInt;
lstFiles:TStringList; Примеры работыsmallfinder.exe -m *.exe -d C:\Windows  smallfinder.exe -m *.exe -d C:\Windows -s  smallfinder.exe -m *.exe СсылкиМануал по обработке параметров командной строкиПример целиком на GitHubЭто репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/11/27/lazarus-vstroennyj-parser-komandnoj-stroki/
11/26/22 03:45 am
Lazarus: Транслит строки (в консоли)
1. Понадобятся модули regexpr и fgl :
uses regexpr, fgl;
regexpr нужен для небольшой оптимизации, a fgl - для создания аналога словаря (Dictionary ).
2. Создаем тип для будущего словаря:
type
TDictTrans=class(specialize TFPGMap<string, string>);
Документация по TFPGMap
3. Сделаем функцию для транслитерации, с одним параметром, входной строкой с русскими буквами:
function Translit(Str:string):string; //тут будет код end;
4. Заводим внутренние переменные функции:
var Regex:TRegExpr; Dict:TDictTrans; Ch,oStr,oTrans:string; I:LongInt;
Regex - экземпляр класса для работы с регулярным выражением.
Dict - словарь для транслитерации.
Ch - транслитерируемый символ
oStr - выходная строка
oTrans - сюда будем возвращать результат транслита отдельного символа.
I - счетчик цикла, в котором будем анализировать строку.
Небольшая оптимизацияСоздаем новое регулярное выражение для кириллицы (и пробела) и проверяем входную строку на наличие русских букв. Если их нет - возвращаем исходную строку и выходим из функции: Regex:=TRegExpr.Create;
Regex.Expression:='[А-Я]|[а-я]|\s';
if not Regex.Exec(Str) then begin
exit(Str);
end;
5. Заполняем словарь (транслит взят из старого армейского учебника времен СССР, можете сделать свой): Dict:=TDictTrans.Create; Dict.Add(' ','_'); Dict.Add('А','A'); Dict.Add('а','a'); ... Dict.Add('Я','JA'); Dict.Add('я','ja'); Словарь целиком на PasteBin6. Инициализируем переменные, используемые в цикле: Ch:=''; oStr:=''; 7. Заводим цикл for , нумерация символов в строке идет с 1 , длина строки получается функцией Length(Str) : for I:=1 to Length(Str) do begin ... end; 8. В цикле получаем символ из строки: Ch:=Copy(Str,I,1); 9. Пробуем получить данные из словаря по ключу, которым является русская буква. Если это удалось, присоединяем результат транслита к выходной строке, если нет - это не русская буква, присоединяем исходный символ к выходной строке: if Dict.TryGetData(Ch, oTrans) then begin
oStr:=oStr+oTrans; //russkaya bukva - transliteriruem
end
else begin
oStr:=oStr+Ch; //nerusskaya bukva, ostavlaem v pokoe
end;
10. Освобождаем память словаря после цикла: Dict.Free; 11. Возвращаем результат работы функции: exit(oStr); Функция целиком на PasteBin12. Код основной программы: var
strInput, strOutput:string;
...
begin
Write('Input string:'); ReadLn(strInput);
strOutput:=Translit(strInput);
WriteLn(strOutput);
WriteLn('Press Enter...'); ReadLn();
end.
Для совместимости с русским языком в консоли необходимо добавить директивы компилятора, иначе словарь будет работать неправильно: program translit; {$mode objfpc} {H+} {$codepage CP866} ... $mode objfpc H+ - чтоб строки по умолчанию не были ShortString 'ами$codepage CP866 - установка кодовой страницы. Документация по работе со строкамиПроверка Исходник примера на GitHubЭто репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/11/26/lazarus-translit-stroki-v-konsoli/
11/25/22 11:55 pm
Lazarus, поддержка русских букв в консоли (Windows 7)
Из коробки русские буквы в консоли поддерживаются через жопу:
 Это потому что Lazarus по умолчанию создает файл в UTF8, а консоль Windows 7 поддерживает CP 866 (кодировку DOS/OEM), достаточно перекодировать файл: 1. Щелкаем по пустому месту в исходнике в редакторе. 2. Выбираем Параметры файла --> Кодировка 3. В выпадающем списке выбираем CP866:  4. В появившемся окне нажимаем кнопку Изменить файл:  5. ФАНФАРЫ! ИсточникТестовый пример на GitHubЭто репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/11/25/lazarus-podderzhka-russkih-bukv-v-konsoli-windows-7/
11/25/22 08:39 pm
Lazarus, регулярные выражения.
Из коробки доступен мощный класс TRegExpr , вполне себе работает с регулярками. Сожрал даже C#-овскую, без изменения синтаксиса вообще. Пример регулярки для обнаружения русских букв:
program regexptest;
uses regexpr;
var Regex:TRegExpr;
begin
Regex:=TRegExpr.Create;
Regex.Expression:='[а-я]|\s';
Writeln(Regex.Exec('АБВГ'));
Writeln(Regex.Exec('ABCD'));
ReadLn();
end.
ДокументацияПример на КиберфорумеЭтот пример на GitHubUPD: Более лучшая регулярка для поиска кириллицы (и пробела). [А-Я]|[а-я]|\s Первая ( [а-я]|\s ) нормально работает, если формат файла исходника UTF-8, и текст в UTF-8, а вот с консолью в Win7 она работает только на строчных буквах, на заглавных не работает. А консоль требует CP866. О других косяках кириллицы в консоли - в следующих выпусках нашего журнала. Это репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/11/25/lazarus-regulyarnye-vyrazheniya/
11/25/22 01:34 pm
Lazarus, список каталогов с подкаталогами
Плохо, что по маске не умеет каталоги искать. А в остальном все просто.
 program alldirs;
uses Classes, SysUtils, FileUtil;
var
lstDirs:TStringList;
i: Integer;
begin
lstDirs := TStringList.Create;
FindAllDirectories(lstDirs,'C:\Windows',true);
i:=0;
while i < lstDirs.Count do begin
WriteLn(lstDirs[i]);
inc(i);
end;
WriteLn ('Found: ',lstDirs.Count);
WriteLn ('Press Enter');
lstDirs.Free();
ReadLn();
end. Ссылка на GitHubЭто репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/11/25/lazarus-spisok-katalogov-s-podkatalogami/
11/24/22 09:58 pm
Поигрался с Freepascal/Lazarus
Больше по служебной необходимости, и воле случая, чем по собственному желанию. Инет отсутствовал, компы нормальные все заболели, а утилиту писать надо. Ще було, на том и писали.
Поиск файлаНаконец-то нормальный поиск файла, где маска файла работает как надо (как в DOS) и не принимает, например, расширение *.htm и *.html за одно и то же. C# мне не удалось этому очевидному решению научить, конечно, можно потом по выборке прогнать регулярное выражение, но оно тоже плохо срабатывает, упускает некоторые случаи, например, если имя файла начинается с расширения (т.е. на файл .html оно не сработает): В Lazarus все работает из коробки:  program testfind;
uses Classes, SysUtils, FileUtil;
var
lstFiles:TStringList;
i: Integer;
begin
lstFiles := TStringList.Create;
FindAllFiles(lstFiles, 'C:\Temp\Test', '*.htm', true);
i:=0;
while i < lstFiles.Count do begin
WriteLn(lstFiles[i]);
inc(i);
end;
WriteLn ('Found: ',lstFiles.Count);
WriteLn ('Press Enter');
ReadLn();
lstFiles.Free();
end. Пример и каталог с тестовыми файлами на GitHubUPD: Ссылка на мануалЭто репост с сайта http://tolik-punkoff.com Оригинал: https://tolik-punkoff.com/2022/11/24/poigralsya-s-freepascal-lazarus/
|