Толик Панков
hex_laden
............ .................. ................
  Viewing 0 - 10  
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/

Tags: ,
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/

Tags: ,
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/

Tags: ,
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/

Tags: ,
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/

Tags: ,
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');


Словарь целиком на PasteBin

6. Инициализируем переменные, используемые в цикле:

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);

Функция целиком на PasteBin

12. Код основной программы:
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/

Tags: ,
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/

Tags: ,
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.




Документация
Пример на Киберфоруме

Этот пример на GitHub

UPD: Более лучшая регулярка для поиска кириллицы (и пробела).

[А-Я]|[а-я]|\s

Первая ([а-я]|\s) нормально работает, если формат файла исходника UTF-8, и текст в UTF-8, а вот с консолью в Win7 она работает только на строчных буквах, на заглавных не работает. А консоль требует CP866.

О других косяках кириллицы в консоли - в следующих выпусках нашего журнала.

Это репост с сайта http://tolik-punkoff.com
Оригинал: https://tolik-punkoff.com/2022/11/25/lazarus-regulyarnye-vyrazheniya/

Tags: ,
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/

Tags: ,
Поигрался с 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.


Пример и каталог с тестовыми файлами на GitHub

UPD: Ссылка на мануал

Это репост с сайта http://tolik-punkoff.com
Оригинал: https://tolik-punkoff.com/2022/11/24/poigralsya-s-freepascal-lazarus/

Tags: ,
  Viewing 0 - 10