Программирование на Delphi

Возникла необходимость подготовить для Сбербанка список сотрудников нашей компании с указанием написания их фамилий в транслитерации по правилам Сбербанка. Возможно, данный код будет кому-то ещё полезен.

function BankCardTranslit(sFam, sName: string): string;
var
  aChar:array [char] of string;
  stFamE, stNameE: string;
  
  function GetChar(c: char): string;
  begin
    Result := '';
    if (c = 'Ь') or (c = 'Ъ') then Exit;
    Result := c;
    if not (c in ['A'..'Z', '0'..'9']) then
      Result := aChar[c];
  end;
  
  function ToEnglish(ast: string): string;
  var i: integer;
      st: string;
  begin
    i := 1; Result := '';
    while i <= Length(ast) do
    begin
      if i < Length(ast) then
      begin
        st := ast[i] + ast[i+1];
        if (st = 'КС') then begin Result := Result+'X'; i := i + 2; Continue; end;
        if (st = 'ЬЯ') or (st = 'ИЯ') then begin Result := Result + 'IA'; i := i + 2; Continue; end;
        if (st = 'ИЙ') then begin Result := Result + 'Y'; i := i + 2; Continue; end;
        if (st = 'ЫЙ') then begin Result := Result + 'YY'; i := i + 2; Continue; end;
      end;
      Result := Result + GetChar(ast[i]);
      Inc(i);
    end;
  end;
begin
  sFam := Trim(AnsiUpperCase(sFam));
  sName := Trim(AnsiUpperCase(sName));
  aChar['А'] := 'A';
  aChar['Б'] := 'B';
  aChar['В'] := 'V';
  aChar['Г'] := 'G';
  aChar['Д'] := 'D';
  aChar['Е'] := 'E';
  aChar['Ё'] := 'E';
  aChar['Ж'] := 'ZH';
  aChar['З'] := 'Z';
  aChar['И'] := 'I';
  aChar['Й'] := 'Y';
  aChar['К'] := 'K';
  aChar['Л'] := 'L';
  aChar['М'] := 'M';
  aChar['Н'] := 'N';
  aChar['О'] := 'O';
  aChar['П'] := 'P';
  aChar['Р'] := 'R';
  aChar['С'] := 'S';
  aChar['Т'] := 'T';
  aChar['У'] := 'U';
  aChar['Ф'] := 'F';
  aChar['Х'] := 'KH';
  aChar['Ц'] := 'TS';
  aChar['Ч'] := 'CH';
  aChar['Ш'] := 'SH';
  aChar['Щ'] := 'SHCH';
  aChar['Ъ'] := '';
  aChar['Ы'] := 'Y';
  aChar['Ь'] := '';
  aChar['Э'] := 'E';
  aChar['Ю'] := 'YU';
  aChar['Я'] := 'YA';
  // поиск имен
  if sName = 'АЛЕКСАНДР' then stNameE := 'ALEXANDER';
  if sName = 'ВЯЧЕСЛАВ' then stNameE := 'VJATCHESLAV';
  if sName = 'ВИКТОР' then stNameE := 'VICTOR';
  if sName = 'КУЗЬМА' then stNameE := 'KOUZMA';
  if sName = 'ЛЮБОВЬ' then stNameE := 'LIUBOV';
  if sName = 'ЛЮДМИЛА' then stNameE := 'LIUDMILA';
  if sName = 'НАДЕЖДА' then stNameE := 'NADEZDA';
  if sName = 'ФИЛИПП' then stNameE := 'PHILIPP';
  if sName = 'ЮЛИЯ' then stNameE := 'JULIA';
  if sName = 'ЮРИЙ' then stNameE := 'YURI';
  if sName = 'ЯКОВ' then stNameE := 'IAKOV';

  stFamE := ToEnglish(sFam);
  if (stNameE = '') then stNameE := ToEnglish(sName);
  // Проверка допустимой длины: если фамилия длинная, то берем только первую букву имени
  if (Length(stFamE) + Length(stNameE) + 1) > 19 then stNameE := GetChar(sName[1]);
  Result := stFamE + ' ' + stNameE;
end;

Для удаления временных файлов в проектах на Delphi я использую приведённый ниже cmd-файл. Чтобы его создать нужно открыть блокнот и скопировать в него предложенный текст, при сохранении файла указать расширение ".cmd", а можно просто скачать мой файл. Так как часто файлы одного проекта для удобочитаемости размещены в нескольких директориях, то этот метод удобнее, чем перечисление директорий руками, так как сработает на любом проекте, достаточно положить этот файл в корневую папку проекта, и при его запуске все временные файлы будут удалены.

del /s *.~* 
del /s *.ddp  rem /s - для удаления в поддиректориях
pause         rem Для того чтобы увидеть результат удаления

То есть числа до 26 переводятся в соответствующие латинские буквы, а большие в две буквы. Использовал при "общении" с Excel для ввода значений калькулируемых полей (например, "=Sum(A1:A7)").

function IntToABC(const aValue:Integer):string;
var n: integer;
begin
  n := aValue; Result := '';
  if n >= 676 then 
  begin 
    Result:='XX'; 
    Exit; 
  end;
  if n >= 26  then 
  begin 
    Result := Chr(Ord('A') + (n div 26) - 1); 
    n := n mod 26; 
  end;
  Result := Result + Chr(Ord('A') + n);
end;

Из строки содержащей номер телефона выкидываются все посторонние символы: скобки, дефисы пробелы - всё кроме цифр.

function PhoneNumberSkobkiRemove(ast: string): string;
var i: integer;
    st: string;
begin
  st := '';
  for i := 1 to Length(ast) do
    if (ast[i] in ['0'..'9']) then st := st + ast[i];
  Result := st;
end;

Работа организована на стандартных компонентах (TOpenDialog, TComboBox, TButton). TComboBox можно заменить TEdit, но тогда возможно отобразить только имя последнего открытого файла, в то время как ComboBox позволяет выбрать из списка.
Моменты связанные с сохранением списка имён открытых файлов здесь не рассматриваются.

Пример использования:

Ниже приведён код обработчика события OnClick для кнопки. Обозначения: dlgOpen: TOpenDialog (не забудьте добавить Dialogs в секцию Uses), CBFile:TComboBox.

procedure TForm1.btnOpenDlgClick(Sender: TObject);
var st: string;
begin
  // dlgOpen.FilterIndex := 1; // устанавливаем фильтр если надо
  if FileExists(CBFile.Text) then // если файл введенный в ComboBox существует
  begin
    // настраиваем OpenDialog по нему
    dlgOpen.InitialDir := ExtractFilePath(CBFile.Text);
    dlgOpen.FileName := CBFile.Text;
  end
  else
  begin
    // если файл не найден, то пытаемся установить имя директории из него
    dlgOpen.FileName := '';
    st := CBFile.Text;
    // в цикле удаляем с конца строки текст, до момента нахождения такого пути на диске
    while not ((DirectoryExists(st)) or (Length(st) = 3) or (st = '')) do
    st := ExtractFileDir(st);
    if not DirectoryExists(st) then st := '';
    // если пути такого на диске нет, то указываем в качестве начального путь к программе
    if st = '' then st := ExtractFilePath(Application.ExeName);
    // указываем имя начальной директории для OpenDialog
    dlgOpen.InitialDir := st;
  end; // if
  // Открываем OpenDialog. Если нажали OK - записываем имя файла в ComboBox
  if dlgOpen.Execute then
    CBFile.Text := dlgOpen.FileName;
end;

Алгоритм: если нашли файл введённый "руками" в ComboBox, то открываем диалог выбора файла с выбранным этим файлом, если не нашли выбираем ближайшую существующую на диске "родительскую" директорию и открываем диалог. Если пути введённого в ComboBox на диске нет, или ComboBox.Text пустой, то в качестве начальной директории используем путь к программе.

В список ComboBox я добавляю имя нового файла в момент начала работы с файлом. Это позволяет не сохранять пользовательские "блуждания" по диску. Сохранять рекомендую в INI-файлы (не зачем реестр Windows забивать своим хламом) - запись при закрытии окна, чтения при создании.

PS: знаю, что некоторые скажут, есть же библиотеки компонентов, в которых схожие функции реализованы, например, JVCL. Но мне кажется правильнее не использовать "сторонних" компонентов в приложениях, тем более в крупных, т.к. простая перекомпиляция на новом компьютере может занять у вас массу сил и времени.

Добавляем процедуру аналогичную нижеследующей, где stCompName - имя компьютера, stUserName - имя пользователя программы, или Windows, если необходимо указываем другие параметры. Файл с описанием ошибок создаётся в директории с программой, с расширением ".err". Не забудьте прописать её в любой из секций (например, private) объявления формы.

procedure TForm1.LogException(Sender: TObject; E: Exception);
var FileName: string;
    F: TextFile;
begin
  FileName := ChangeFileExt(Application.ExeName,'.err');
  AssignFile(f, FileName);
  if FileExists(FileName) then Append(f) 
    else Rewrite(f);
  try
    Writeln(f, #09, stCompName, #09, stUserName, #09, DateTimeToStr(now), #09, e.ClassName, #09, e.message);
  finally
    CloseFile(f);
  end;
  Application.ShowException(E);
end;

В процедуру создания главной формы приложения (onCreate) добавляем следующую строку (лучше в начале):

  Application.OnException := LogException;