
Кликабельно, по ссылке интерактивная открытка.

Мы пережили!

Так что всех с прошедшим Солнцестоянием, aka Йолем!
Солнце взошло!
А ко мне Йольский Кот не пришел, как бы кому не хотелось, тому ще мне таки подарили новую клевую шапку 🙂
И Украинское солнце взойдет! Слава Украине! Медведя похоронят!
Что такое shred? Это опенсорсный «уничтожитель» файлов, т.е. программа затирает (забивает случайными данными) файл на диске, чтобы невозможно было его восстановить средствами восстановления файлов, например, чтобы окончательно удалить конфиденциальные данные, доступ к которым может получить злоумышленник. shred входит во многие дистрибутивы Линукс, но есть версии и под другие ОС. Тут буду экспериментировать и описывать версию для windows.
Друзья попросили перевести на русский краткую справку, а заодно уж я поэкспериментировал с параметрами, чтобы подобрать оптимальные для повседневного использования.
Внимание! Идеальный уничтожитель данных, во всяком случае, с HDD-дисков, это молоток, с последующей обработкой диска в костре на березовых дровах, а всего оставшегося в микроволновке.
Использование: shred.exe [ОПЦИИ] ФАЙЛ1 [ФАЙЛ2 ФАЙЛ3 ...]
Многократное перезаписывание указанных ФАЙЛОВ, для затруднения восстановления данных даже очень дорогим аппаратным обеспечением.
Обязательные аргументы для длинных опций обязательны и для коротких опций.
-f, --force изменить разрешения файловой системы, чтобы разрешить запись, если это необходимо
-n, --iterations=N Перезаписать N раз вместо значения по умолчанию (25)
-s, --size=N затереть указанное количество байтов (допускаются такие суффиксы, как K, M, G)
-u, --remove обрезать и удалить файл после перезаписи
-v, --verbose показать прогресс
-x, --exact не округлять размеры файлов до следующего полного блока; это значение по умолчанию для нестандартных файлов (В Windows он все файлы округляет до полного блока, т.е. кластера на диске - Tolik)
-z, --zero добавить окончательную перезапись нулями, чтобы скрыть затирание файла
--help показать эту справку и выйти
--version вывести информацию о версии и выйти
Если в качестве файла указан -, затирается стандартный вывод.
Удалить ФАЙЛ(ы), если указан --remove (-u). По умолчанию не удалять
файлы, потому что обычно работают с файлами устройств, такими как /dev/hda, и эти файлы обычно не следует удалять. При работе с обычными файлами большинство людей используют параметр --remove. (Лучше так не делать, ниже обьясню почему)
ВНИМАНИЕ: обратите внимание, что shred основывается на очень важном допущении:
что файловая система перезаписывает данные на месте. Это традиционный способ работы, но многие современные файловые системы не удовлетворяют этому предположению.
Ниже приведены примеры файловых систем, в которых уничтожение файлов неэффективно:
* лог-структурированные или журналируемые файловые системы, такие как поставляемые с AIX и Solaris (а также JFS, ReiserFS, XFS, Ext3 и т. д.)
* файловые системы, которые записывают избыточные данные и продолжают работать даже в случае сбоя некоторых операций записи, например, файловые системы на основе RAID
* файловые системы, которые делают моментальные снимки, такие как NFS-сервер Network Appliance
* файловые системы, кэширующие во временных местах, такие как клиенты NFS версии 3
* сжатые файловые системы
Кроме того, резервные копии файловой системы и удаленные зеркала могут содержать копии файла, которые невозможно удалить, что позволит позже восстановить затертый файл.
Сообщайте об ошибках по адресу <bug-coreutils@gnu.org>.
Вместо ФАЙЛ можно использовать маску файлов, если вы хотите затереть группу файлов по маске, например, shred *.txt уничтожит все текстовые файлы в каталоге - Tolik
Разрешения файлов обрабатываются нормально, т.е., например, *.htm и *.html воспринимаются, как разные файлы.- Tolik
Внимание! Под рукой у меня нет лаборатории и оборудования разных там контор, тем более, проводил я их на скорую руку и довольно дилетантски, так что на абсолютную истину не претендую. Используйте все нижесказанное на свой страх, риск и хвост!
Условия:
— Windows 7 Professional x64
— SATA HDD Seagate, 500 GB
— FS: NTFS
— форк shred (ниже дам ссылку)
Проверял работу затиралки WinHex’ом 19.9[https://www.x-ways.net/winhex/] x64, не самым свежим, но даже лицензионным (мне его кто-то подарил), на самом деле, следов мелких файлов я так и не обнаружил, так что сразу говорю, почти все тесты shred прошел, и мне лень делать скрины с WinHex’а, а теперь о параметрах:
Внимание! Не советую использовать опцию -u, т.е. удаление файла. shred его просто удалит, не поменяв ему имя на случайное, как это делают многие «затиралки», потому, если вы затираете файл, например, с именем, путин бомба взрыв бомбас.doc, то понятно кто хоть содержания файла и не увидит, но выводы сделает. Так что после shred файл лучше обработать напильником, т.е. переименовать его случайным набором символов, или неслучайным, например, мой_кот.jpg, а после этого удалять штатными средствами ОС.
Количество итераций:
т.е. опция -n <число> или --iterations=<число>
На ваше усмотрение, я не заметил разницы в WinHex’е между 3, которые выставил я, и 25 по умолчанию, но стоит ли лишний раз насиловать HDD или SSD перезаписями… Не знаю.
Дозапись файла:
опция -s <число> (--size=<число>)
Дозаписывает файл числом байт (случайных). Если использовать после числа без пробела K M или G, то, соответственно -кило -мега или -гига байт. На мой взгляд, это излишне, найдут у вас в директории C:\DOC файл мой_кот.jpg размером в 5Гб и удивятся. Но вообще можно, shred с файловой системой обращается аккуратно и другие файлы не затрет.
Забить все нолями:
Опция -z (--zero)
На последней итерации затирания, shred перезаписывает весь файл символом с кодом 0.
На мой взгляд, довольно полезная опция, при использовании рекомендаций по переименованию файла и удалению, после затирания. «А хрен знает, товарищ майор, что это у меня за файл был с названием dfghuyty.13 в D:\DOC, вирус, наверное.»
(Не)дописывать до кластера:
Опция -x
В Linux’овой версии shred эта опция включает не дописывание до кластера, самое странное, что в Windows-версии наоборот, отключает.
Небольшое пояснение. В стандартных файловых системах файл занимает 1 кластер на диске. Т.е. файл, какого бы размера он не был, займет, как минимум 1 кластер. Размер кластера устанавливается настройками ОС, также его можно изменить при форматировании (иногда). Например, кластер в NTFS при стандартном форматировании равен 4Кб, т.е. 4096 байт, потому, даже если файл фактически занимает 4 байта, например, текстовый файл с содержимым 1234, он все равно будет занимать 1 кластер. Если файл больше одного кластера, то автоматически он займет весь следующий, даже если в файле 4096+1 байт, и т.д.
Если (в Windows-версии shred) применить опцию -x к файлу 3.txt, который содержит 4 байта (текст 1234, например), то shred и запишет 4 случайных байта.
Мое мнение: опцию -x не использовать, пусть уж затирает кластер целиком.
Оптимальный вариант опций для мелких повседневных задач (затереть небольшой файл):
shred -n 3 -z <file_or_mask>
где <file_or_mask> — файл или маска файлов.
Позже напишу батник, который будет затертые файлы рандомно переименовывать и удалять.
Кто просил полный альбом UnsTandarT’а — радуйтесь, получил право на публикацию без всякого провайдерского произвола, чему очень рад!
Full album (direct link on YouTube)
Tracklist:
00:00 — Quadro track
01:20 — Trance Mix Vol. 1
02:59 — Track2 (remastered)
05:21 — My Future
08:11 — Skillz
09:54 — Change The Reality
12:02 — The Final Experiment
15:33 — Love Machine
19:52 — Freedom Is Eternity
23:43 — Research
27:55 — Here Comes New Age
Пессимист собрался учить китайский,
Оптимист — английский, реалист — учить автомат Калашникова.
Но всем пришлось учить украинскую мову!
Припер шеф в офис телевизор, новый здоровый плоский, чтоб клиентам МУЗ-ТВ или какое другое камеди показывать, мол, пусть будет, как в лучших домах города.
Сразу выяснилось, что коаксиал в офисе есть, но это оказалось не кабельное, а какая-то неведомая фигня, которая, в общем, даже неведомое показывать отказалась, хотя по тестам там даже какой-то сигнал есть, но с ним я ночью поэкспериментирую, вдруг какая Бухта Кэндл или Криполе Чудес после полуночи передается.
Оказалось, железячка не венде (какой-то окончательно порезанной и изуродованной 10-ке), так что довольно быстро научил его показывать из расшаренной Самбы видосы, но, поскольку там одни ужастики 80-х («Извне», «Реаниматор», «Фантомы» и.д.), то для клиентов это не включишь, а за ютупом следить надо, вдруг посреди котиков Невзоров вылезет.
В общем, хуй с ним, сказал начальник, и попросил Большие Красивые Часы на весь экран.
Оказалось, что после небольшого шаманства, железке можно скрамливать неподписанные экзешники, и заливать все что хочешь, на доступный пользователю раздел SSD.
Что-ж, сказал я… И немедленно выпил. А потом сделал часы (ну как сделал, сконвертировал в экзешник(и)).

Clock_1.exe — часы в стандартном окне (с кнопками развернуть, свернуть и закрыть)
Clock_Noborder.exe — часы в стандартном окне без заголовка, закрываются ALT+F4 или по щелчку правой кнопкой мыши, выпадет меню с пунктом Exit
Clock_Fullscreen.exe — часы на полный экран без заголовка, закрываются аналогично предыдущему варианту. Идеальны для стационарного показа на мониторе, телевизоре, старом смартфоне под винду или информационном киоске.
swf\Clock_1.swf — оригинал программы.
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-архив
Мне не нравится, потому не конвертировал, кому надо, найдете по тегу flash конвертер в экзешники.
Но оставлю это здесь в рамках сохранения HTML-памятников истории и культуры.

Все сконвертировано в экзешники и запускается на всех виндах, начиная с XP, флэш-плеер/плагин не нужен.
Азартные: 777 - симулятор "Однорукого бандита" naperstok - игра в наперстки ochko - Очко ochko_s_bo - Очко с зайцем Бо Драки: Boks - Бокс kapojero - капоэйра samurai - файтинг Хип-Хоп: ebosh_skrejchi - симулятор диджея Квесты: princeofpercia - римейк досовского "Принца Персии" Логические: krestiki_noliki - Крестики-нолики shakhmaty - Шахматы Спортивные: futbol - футбол kyorling - керлинг motiki - гонки на мотоциклах skejt - скейт tennis - Пинг-понг
Все перекодировано в экзешники, совместимо со всеми Windows от XP до 10.

2 — надо спасать милых шарообразных существ от попадания в кислоту и другие неприятности
8_figur — надо расположить 8 шахматных фигур, чтоб они не стояли на одной прямой или диагонали
bobry_i_futbol — Бобры и футбол
bubble — надо порвести мыльный пузырь по лабиринту
CAT_bowling — боулинг, вместо кеглей коты
cat_kill — стреляем котами (аналог классических «Пингвинов», только с котами)
catjump — аналог динозаврика Google, только с котом
Crazy_Race — гоночный симулятор
cubshoot3 — еще один аналог «Пингвинов», но я не понял, как играть
dead_morozzz — Пьяный Санта
dead_morozzz2 — Пьяный Санта 2
deathjunior3 — ученик Смерти
e-states — Захвати все США (мини-стратегия)
headspace — леталка, надо отбиваться от НЛО
heliattak3 — простенький платформер
hovercraftgame — лабиринт, аналог мыльного пузыря
Immigrant — вы перешли мексиканскую границу, надо свалить от ментов!
lesnik [НЕПОЛИТКОРРЕКТНО] — мочи пидорасов, иначе выебут!
Missile_strike — надо защищать базу от метеоритов
muravji — мочи тараканов, иначе жильцы разбегутся!
nu_pogodi — симулятор игры «Ну, погоди»
Opol4enezIraka — симулятор чмобика
Orbox — головоломка
Panic — симулятор пользователя ПК
pong — Пинг-понг
security — очередной лабиринт, избегайте камер наблюдения
skakalka — симулятор скакалки, садистский и неполиткорректный (можно расчленить негра)
Smehun — логическая игра, надо не взять последний шарик.
Snezhki — замочи снежками российских звезд, политкорректная игра
Strelbishe
xiaoxiao6
xiaoxiao8
xiaoxiao9 — файтинг рисованных человечков
yozh — платформер, играем за ежика
zamok — классический «расстрел замка», есть возможность играть вдвоем
zmeyka — Змейка, почти как на Nokia 3310
zmeyka2 — еще один вариант Змейки
Понадобилось сделать что-то типа такого:
Файл уже существует. Заменить? [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;
Иногда список строк (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();
Результат:

Алгоритм:
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
Обсуждения на Исходниках, но более подробнее и лучше у меня.
Чтоб приплыл к тебе,
Сука-Вовочка…
Синекольчатый осьминог.

Продолжаем бодаться с русским языком в консоли (копия).
Ну не может же быть так, что виндовая консоль и 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.
В 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
1. Понадобятся модули regexpr и fgl:
uses regexpr, fgl;
regexpr нужен для небольшой оптимизации, a fgl — для создания аналога словаря (Dictionary).
2. Создаем тип для будущего словаря:
type TDictTrans=class(specialize TFPGMap<string, string>);
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');
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);
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 — установка кодовой страницы.
Документация по работе со строками
