Примеры простых программ на Lazarus под Win32 (Часть 1)

Довольно долго не было повода написать что-нибудь про Lazarus. Программированием последнее время я не занимался, но тут, что называется, “приперло”. Надо было сделать быстро, просто и без заморочек. Соответственно, качать пробную XE2 не стал, а решил положиться на бесплатный инструмент.

Задачи были следующие: выполнить форматирование нескольких тысяч финских телефонных номеров, лежащих в dbf, и выкачать из удаленной БД MySQL некоторую информацию, выгрузив ее в формат CSV.

Обо всех этих затеях

На самом деле тема форматирования телефонных номеров, в общем, не то чтобы новая. Навскидку можно извлечь из гугловской выдачи например вот такие ссылки:

Форматирование телефонных номеров на PHP (Хабр)

libphonenumber - Java, C++ and Javascript library

Последний пример взят с code.google.com, что само по себе уже говорит о том, что решение достойно того, чтобы с ним ознакомиться. Библиотека действительно форматирует номера, но делает это вроде бы по достаточно простому алгоритму: в телефонном номере выделяется код страны, и известный этой библиотеке дополнительный код (префикс оператора или код города). В оставшуюся часть номера изменений никаких не вносится. Это возможно правильно с точки зрения мирового стандарта форматирования, однако не совсем устраивает меня, поскольку читать такие телефонные номера не слишком удобно.

Теперь собственно к делу. А дело в том, что в Финляндии длина номера может составлять от пяти до девяти цифр. Код города может включать в себя одну или две цифры (а с учетом так называемого trunk prefix) – от одной до трех цифр. Дополнительно все усложняет тот факт, что телефонные номера в исходной dbf появились из публичного источника. То есть финны сами вводили свои номера, при том делали это без учета какого-то единого правила (например, в каких то номерах trunk prefix присутствует, в каких то – нет).

Далее ссылки по теме:

Краткое описание формата телефонных номеров в Финляндии

Статья в WikiPedia

Короткий список телефонных кодов городов Финляндии

Список кодов городов и префиксов операторов

Список кодов городов и префиксов операторов 2

Наиболее полный список телефонных кодов городов на русскоязычном ресурсе

Наиболее полный список кодов городов на финском ресурсе

Страницы с сайта FICORA (Finnish Communication Regulatory Authority)

Префиксы разных телефонных операторов могут начинаться с цифр кода города. А значит, отличить префикс оператора от кода города можно только зная, к какому городу относится этот номер (и зная код этого города). В моей dbfке присутствует название города и даже название провинции, к которой относится этот город. И это уже кое-что, поскольку вот тут есть список кодов по провинциям. Только по ссылке присутствует карта со старыми провинциями Финляндии (они менялись, было дело), а у меня – новые. И они редко пересекаются. Плюс ко всему, один и тот же населенный пункт может иметь два кода (видимо, в одну половину города нужно звонить по одному коду, в другую – по другому).

Короче говоря, задача непростая, но в общем, решаемая. К слову сказать, целью этого поста не является нахождение способа форматирования номеров, а изучение возможностей Lazarus. Окончательный вариант своей программы я приводить не стану, а выложу только основные моменты, чтобы было понятно, какими средствами и за счет чего было достигнуто приемлемое для меня решение.

Итак, мы имеем dbf файл с такой структурой:

phone: string
city: string
province:string

Собираем со всех источников коды городов в электронную таблицу (ну, например, OpenOffice Calc). В результате получится примерно следующее:

Город	Код
Aanekoski	14
Aanekoski	14
Aetsa	3
Ahtari	6
Ahtari	6
Akaa	3
Alaharma	6
Alajarvi	6
Alajarvi	6
Alastaro	2
Alavieska	8
Alavieska	8
Alavus	6
Alavus	6
Anjalankoski	5
Anttola	15
...	...

Города в списке дублируются, но в этом ничего страшного нет, поскольку повторяющиеся варианты мы сможем удалить потом автоматически. Сохраняем таблицу в формате CSV (разделители – точки с запятой – ;).

Создаем новое приложение Lazarus, сохраняем его и помещаем в папку с проектом наш файл CSV. Для его разбора мы воспользуемся экземпляром класса TStringList, для этого объявим переменную соответствующего типа, в обработчик события OnCreate основной формы проекта впишем создание экземпляра, а в обработчик события OnDestroy – его разрушение.

var
  Form1: TForm1;
  CityCodes:TStringList; 

implementation 

{$R *.lfm} 

{ TForm1 } 

procedure TForm1.FormCreate(Sender: TObject);
begin
  CityCodes:=TStringList.Create;
end; 

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(CityCodes);
end;                    

TStringList всем хорош и в Lazarus. Добавляем на форму кнопку и в обработчике OnClick устанавливаем значение разделителя в ‘;’ , запрещаем дублирование данных в списке, загружаем наш CSV и тут же выгружаем его в новый файл, который уже не содержит дубликатов.

procedure TForm1.Button1Click(Sender: TObject);
begin
  CityCodes.Delimiter:=';';
  CityCodes.Duplicates:=dupIgnore;
  CityCodes.Sorted:=true;
  try
    CityCodes.LoadFromFile('citycodes.csv');
    CityCodes.SaveToFile('citycodes1.csv');//сохраняем результат
  except on E:Exception do
     ShowMessage(E.Message);
  end;
end;  

Замечание. Будьте внимательны! Режим dupIgnore не включается при Sorted = false.

Теперь надо догрузить двойные коды городов, которые фигурируют в этом списке (например, Hartola - 03/014). Для этого сложим такие коды в отдельный CSV, отключим режим dupIgnore у нашего списка и догрузим города с двойным кодом. Необходимо заметить, что метод LoadFromFile перед загрузкой очищает свой список, то есть, выполнив код

CityCodes.LoadFromFile('citycodes1.csv');
CityCodes.LoadFromFile('citycodes2.csv');
CityCodes.SaveToFile('citycodes3.csv');

мы в получим в файле 'citycodes3.csv' только содержимое файла 'citycodes2.csv'. Таким образом, для добавления в список новых кодов из файла можно завести дополнительную процедуру:

procedure AddFromFile(TSL: TStringList; FN: string);
  var
    TS: TStringList;
  begin
    TS := TStringList.Create;
    try
      TS.LoadFromFile(FN);
    except on E:Exception do
      ShowMessage(E.Message);
    end;
    TSL.AddStrings(TS);
    FreeAndNil(TS);
end;   

Теперь поменяем код Button1Click следующим образом:

procedure TForm1.Button1Click(Sender: TObject);
begin
  CityCodes.Delimiter:=';';
  //CityCodes.Duplicates:=dupIgnore; дубликаты теперь не отбрасываются
  CityCodes.Sorted:=true;
  try
    //загружаем основные коды из полученного на предыдущем шаге списка 
    CityCodes.LoadFromFile('citycodes1.csv'); 
    AddFromFile(CityCodes,'citycodes2.csv');//загружаем дополнительные коды
    CityCodes.SaveToFile('citycodes3.csv'); //сохраняем результат
  except on E:Exception do
     ShowMessage(E.Message);
  end;
end;

На самом деле, конечно, дополнительные коды можно добавить и при помощи Calca (или другого редактора CSV). Просто в контексте текущей задачи подгружать дополнительные коды мне приходилось неоднократно и иногда в довольно значительных объемах. Короче говоря, я решил, что загрузка таким способом облегчит мне жизнь и, возможно, не ошибся.

Теперь удалим ноли в начале кодов (trunk prefix). Код того же самого обработчика поменяем так:

procedure TForm1.Button1Click(Sender: TObject);
var
  i: integer;
  S: string;
begin
  CityCodes.Delimiter := ';';
  CityCodes.NameValueSeparator := ';';
  CityCodes.Sorted := False;
  try
    CityCodes.LoadFromFile('citycodes3.csv');
    for i := 0 to CityCodes.Count - 1 do
    begin
      S := CityCodes.ValueFromIndex[i];
      if Pos('0', S) = 1 then
      begin
        Delete(S,1,1);
        CityCodes.ValueFromIndex[i] := S;
      end;
    end;
    CityCodes.SaveToFile('citycodes4.csv');
  except
    on E: Exception do
      ShowMessage(E.Message);
  end;
end;

Здесь видимо следует дать пояснения по коду. Начнем с того, что опять же, решать такую задачу можно кучей всяких инструментов. В том числе Calc, MisroSoft Access и так далее и тому подобное. Но делал я это несколько раз, и таскать данные туда-сюда ленился. Кроме того, пример этот можно интересно прокомментировать, по сему – он тут.

Начнем с того, что NameValueSeparator автоматически разделяет строки в списки на пары Name-Value. То есть до сих пор мы могли обратиться к элементу списка, например, так:

CityCodes[0]:='';

таким образом мы могли “обнулить” строку нашего CSV файла. Могли получить получить весь текст из файла целиком. Например, таким образом:

Label1.Caption:=CityCodes.DelimitedText;

Но для того чтобы добраться до конкретного кода города, нам пришлось бы “вручную” разбирать каждый элемент CityCodes. После выполнения инструкции

CityCodes.NameValueSeparator := ';';

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

S:=CityCodes.Values['Helsinki'];

Правда, необходимо заметить, что в дальнейшем этот способ нам не слишком поможет, поскольку названия городов в списке у нас дублируются (из-за того, что мы добавили дополнительные коды).

Но получить код города из определенной строки мы можем:

S:=CityCodes.ValueFromIndex[0];

И можем получить название города из определенной строки:

S:=CityCodes.Names[0];

И последних двух возможностей нам будет вполне достаточно.

Далее нам необходимо сформировать список префиксов операторов связи. Делал я это совершенно аналогично составлению первого списка, за тем единственным исключением, что в принципе название оператора нам не слишком важно. Оно пригодится разве что только для того, чтобы иметь представление о том, какого рода префикс мы определили.

Коды во втором списке у нас уникальны, поэтому при создании списка нужно использовать инструкции

OperCodes.Delimiter:=';';
OperCodes.Duplicates:=dupIgnore;
OperCodes.Sorted:=true;

В результате должно получиться два приблизительно таких списка (я их привожу неполностью):

Код Оператор/доп. информация 102 Elisa 305 TDC 800 PUBLIC/PREMIUM 303 TDC 302 TDC 301 TDC 308 Setera 307 Setera 299 Elisa 109 Elisa 108 Elisa 107 Elisa 106 Elisa 105 Elisa 600 PUBLIC/PREMIUM 700 PUBLIC/PREMIUM ... ...

Город Код Espoo 9 Eura 2 Eurajoki 2 Evijarvi 6 Finstrom 18 Foglo 18 Forssa 3 Geta 18 Haapajarvi 8 Haapavesi 8 Hailuoto 8 Halikko 2 Halsua 6 Hameenkyro 3 Hameenlinna 19 Hameenlinna 3 ... ...

Теперь, чтобы не утруждать читателя инструкциями по настройке интерфейса, приведу просто код его динамической настройки (Кнопку, которую я создал ранее, я удалил вместе с обработчиком события OnClick).

В объявление Form1 добавились два обработчика событий:

type

  { TForm1 }
  TForm1 = class(TForm)
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure bStartClick(Sender: TObject);
    procedure bStopClick(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;         

В секции implementation изменения следующие (все лишнее я опять убрал):

var
  CityCodes,OperCodes: TStringList;
  Panel1: TPanel;
  bStart, bStop: TButton;
  mmOut: TMemo;
  Dbf1: TDbf;
  Aborted:boolean;

{ TForm1 }

procedure TForm1.FormCreate(Sender: TObject);
begin
  CityCodes := TStringList.Create;
  CityCodes.NameValueSeparator:=';';
  OperCodes := TStringList.Create;
  OperCodes.NameValueSeparator:=';';
  
  Panel1 := TPanel.Create(Form1);
  Panel1.Parent := Form1;
  Panel1.Align := alTop;
  Panel1.Height := 50;

  bStart := TButton.Create(Panel1);
  bStart.Parent := Panel1;
  bStart.Caption := 'Start';
  bStart.OnClick := @bStartClick;

  bStop := TButton.Create(Panel1);
  bStop.Parent := Panel1;
  bStop.Caption := 'Stop';
  bStop.OnClick := @bStopClick;

  mmOut := TMemo.Create(Form1);
  mmOut.Parent := Form1;
  mmOut.Align := alClient;
  mmOut.ScrollBars := ssAutoVertical;

  Dbf1 := TDbf.Create(Form1);
  Dbf1.FilePath := ExtractFilePath(Application.ExeName);
  Dbf1.TableName := 'comp.dbf';
end;  

procedure TForm1.FormDestroy(Sender: TObject);
begin
  FreeAndNil(CityCodes);
  FreeAndNil(OperCodes);
end;


procedure TForm1.FormResize(Sender: TObject);
begin
  bStart.Top := 10;
  bStop.Top := bStart.Top;
  bStart.Left := Form1.Width - bStart.Width - 10;
  bStop.Left := bStart.Left - bStop.Width - 10;
end;

procedure TForm1.bStartClick(Sender: TObject);
begin
  Aborted:=false;
  Try
    CityCodes.LoadFromFile('citycodes4.csv');
    OperCodes.LoadFromFile('opercodes.csv');
    Dbf1.Active := True;
    mmOut.Lines.Add('Connected to dbf ' + Dbf1.TableName);
  except
    on E: Exception do
      mmOut.Lines.Add(E.Message);
  end;

end;

procedure TForm1.bStopClick(Sender: TObject);
begin
  Aborted:=true;
end;

Ну вот. Все готово для обработки dbf. Результат трудов будем выкладывать в result.csv. Добавляем проход по dbf и пустую функцию форматирования номеров:

function FormatPhone(Ph, City, Province: string; var Dcdd:integer): string;
begin
  Result := '';
end;

procedure TForm1.bStartClick(Sender: TObject);
var
  Province, City, Phone, PhFormatted: string;
  Total, Decoded: integer;
  RSL: TStringList;
begin
  Aborted := False;
  Total := 0;
  Decoded := 0;
  mmOut.Clear;
  RSL := TStringList.Create;
  RSL.Add('phone_source;province;city;phone_formatted;');
  try
    CityCodes.LoadFromFile('citycodes4.csv');
    OperCodes.LoadFromFile('opercodes.csv');
    Dbf1.Active := True;
    mmOut.Lines.Add('Connected to dbf ' + Dbf1.TableName);
    while not dbf1.EOF do
    begin
      City := dbf1.FieldByName('city').AsString;
      Province := dbf1.FieldByName('province').AsString;
      Phone := dbf1.FieldByName('ph2').AsString;
      PhFormatted := FormatPhone(Phone, City, Province, Decoded);
      RSL.Add(Phone + ';' + Province + ';' + City + ';' + PhFormatted + ';');
      Inc(Total);
      if (Total mod 50 = 0) then
        mmOut.Lines.Add(
          IntToStr(Decoded) + ' / ' + IntToStr(Total) + '    NOT DECODED ' +
          IntToStr(Total - Decoded));
      Application.ProcessMessages;
      if Aborted then
        Break;
      dbf1.Next;
    end;
    RSL.SaveToFile('result.csv');
  except
    on E: Exception do
      mmOut.Lines.Add(E.Message);
  end;
  FreeAndNil(RSL);
  mmOut.Lines.Add('JOB COMPLETED -----------------------');
  mmOut.Lines.Add('Total: ' + IntToStr(Total) + ' Decoded: ' + IntToStr(Decoded));
  dbf1.Active := False;
end;

В принципе здесь все просто: подготавливаем переменные, RSL (TStringList, в который сложим результаты), затем открываем dbf, проходим ее, попутно сохраняя значения полей в переменные, форматируем телефонные номера и записываем все в RSL, затем все закрываем, записываем RSL в файл, освобождаем память и выводим сообщение о завершении работы.

Наверное заслуживает отдельного внимание возможность останова процесса обработки. В обработчике bStopClick мы устанавливаем значение флага Aborted в true и после обработки каждой записи в bStartClick проверяем значение этого флага. В случае, если Aborted=false – выходим из цикла и планово завершаем процесс. Примечательно, что эта конструкция не будет работать без инструкции Application.ProcessMessages, которая позволяет обработать нажатие пользователем кнопки bStop в процессе работы цикла.

Теперь возьмемся за функцию FormatPhone. Для начала приведем телефоны "к единому знаменателю" (как я уже говорил, вводили их без соблюдения каких-либо правил).

Потом разобьем номер на части:

"конец номера" – последние четыре цифры, которые мы не разбираем, а просто вставляем в середину пробел и больше не трогаем;

"начало номера" – в нем содержится некоторый код или префикс, который необходимо выделить, после чего начальная номера будет представлять собой код/префикс+"хвост".

Функция DecodePrefix пока пуста и оставлена напоследок.

function DecodePrefix(const Prefix, City, Province: string;
  var Tail): string;
begin
  Result := '';
end;

procedure SplitTail(const Splitter: string; var aTail: string);
begin
  if Length(aTail) > 4 then
    Insert(Splitter, aTail, 4);
end;  

function FormatPhone(Ph, City, Province: string; var Dcdd:integer): string;
var
  Ph2Decode,
  PhoneStart, PhStart, PhoneEnd,
  PTail: string;
  i: integer;
begin
  Result := '';
  if Length(Ph) = 0 then
    Exit;
  Ph2Decode := Ph;
  //убираем ноли (trunck prefix) из начала номера
  if Ph2Decode[1] = '0' then
  begin
    Ph2Decode := Copy(Ph2Decode, 2, Length(Ph2Decode) - 1);
    if Ph2Decode[1] = '0' then
      Ph2Decode := Copy(Ph2Decode, 2, Length(Ph2Decode) - 1);
  end;
  //удаляем посторонние символы из номера (добавочных номеров
  //нашем списке нет
  for i := 1 to Length(Ph2Decode) do
    if not (Ph2Decode[i] in ['0', '1'..'9']) then
      Delete(Ph2Decode, i, 1);
  //разделяем номер на "начало" и "конец"
  //в конецевую часть номера сразу вставляем разделитель
  //и больше ее не трогаем
  PhoneEnd := Copy(Ph2Decode, Length(Ph2Decode) - 3, 4);
  Insert(' ', PhoneEnd, 3);
  //на всякий случай делаем копию начала номера
  PhoneStart := Copy(Ph2Decode, 1, Length(Ph2Decode) - 4);
  PhStart := PhoneStart;
  //разбираем начальную часть номера
  //PTail - это "хвост", оставшийся от начальной части номера
  //после выделения префикса
  PhoneStart := DecodePrefix(PhoneStart, City, Province, PTail);
  if PhoneStart <> '' then
  begin
    //если удалось выделить код города или префикс
    Inc(Dcdd);
    if PTail = '' then
    begin
      Result := PhoneStart + ' ' + PhoneEnd;
    end
    else
    begin
      SplitTail(' ', PTail);
      Result := PhoneStart + ' ' + PTail + ' ' + PhoneEnd;
    end;
  end
  else
  begin
    //если не удалось выделить код города или префикс
    //просто разделяем "начало" номера
    SplitTail(' ', PhStart);
    Result := PhStart + ' ' + PhoneEnd;
  end;
  Result := '+358 ' + Result;
end;

Ну и собственно функция DecodePrefix. Оговорюсь, что результаты работы приведенной здесь функции меня лично не слишком впечатляют. Но она худо-бедно разобрала приблизительно 90% номеров. Улучшить ее можно за счет более "тонкой" настройки, которую я не привожу, поскольку задачу она все равно не решает на 100% (может быть у меня с исходными данными что-то не так?;-), места занимает сравнительно много, и объяснять, что она делает, придется долго. Я поленился. Помните, в начале поста я сказал, что пример этот приводится для изучения возможностей Lazarus? Вот.

function DecodePrefix(const Prefix, City, Province: string;
  var Tail: string): string;
var
  i, j: integer;
  Oper, Pref1, Pref2, Place, Code: string;
begin
   //ищем совпадения кодов городов
  Tail := '';
  Pref2 := Prefix;
  for j := 2 downto 1 do
  begin
    //устанавливаем длину префикса и "хвоста"
    //например, если Prefix='235' то при первом проходе
    //будем искать код '23', Tail = '5'
    // при втором проходе будем искать код 2, Tail='35'
    Pref1 := Copy(Prefix, 1, j);
    Tail := Copy(Prefix, j + 1, Length(Prefix) - j);
    for i := 0 to CityCodes.Count - 1 do
    begin
      Place := CityCodes.Names[i];
      Code := CityCodes.ValueFromIndex[i];
      //считаем, что код найден, только если город или провинция совпадают
      if (Code = Pref1) and ((Place = City) or (Place = Province)) then
      begin
        Result := Code;
        Exit;
      end;
    end;
  end;

  //ищем совпадения с префиксами операторов
  Pref2 := Prefix;
  Tail := '';
  repeat
    //здесь префикс и "хвост" настраиваются аналогично
    //тому, как это делалось с кодами городов.
    //только в качестве счетчика используется длина Pref2
    //от которого на каждой итерации отделяется одна цифра
    Pref1 := Copy(Pref2, 1, Length(Pref2) - 1);
    Tail := Copy(Pref2, Length(Pref2), 1) + Tail;
    Oper := OperCodes.Values[Pref1];
    //если в списке найден оператор с таким префиксом,
    //значит можно возвращать результат
    if Oper <> '' then
    begin
      Result := Pref1;
      Exit;
    end;
    Pref2 := Copy(Pref2, 1, Length(Pref2) - 1);
  until Length(Pref2) <= 2;
end;

Вот, собственно, и все. Резюме я выкладываю отдельной запиской, а то этот пост получился длинноват.

Комментарии приветствуются. Не возьмусь назвать свои примеры и решения образцовыми, так что Welcome!

Весь проект можно скачать отсюда. Dbf, извините, не выложу. Как-никак, персональные данные – хоть и финские;-)

PS. Про TStringList написано очень основательно вот тут.