воскресенье, 25 марта 2012 г.

Примеры простых программ на 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). В результате получится примерно следующее:

ГородКод
Aanekoski14
Aanekoski14
Aetsa3
Ahtari6
Ahtari6
Akaa3
Alaharma6
Alajarvi6
Alajarvi6
Alastaro2
Alavieska8
Alavieska8
Alavus6
Alavus6
Anjalankoski5
Anttola15
......

Города в списке дублируются, но в этом ничего страшного нет, поскольку повторяющиеся варианты мы сможем удалить потом автоматически. Сохраняем таблицу в формате 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;

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

КодОператор/доп. информация
102Elisa
305TDC
800PUBLIC/PREMIUM
303TDC
302TDC
301TDC
308Setera
307Setera
299Elisa
109Elisa
108Elisa
107Elisa
106Elisa
105Elisa
600PUBLIC/PREMIUM
700PUBLIC/PREMIUM
......
ГородКод
Espoo9
Eura2
Eurajoki2
Evijarvi6
Finstrom18
Foglo18
Forssa3
Geta18
Haapajarvi8
Haapavesi8
Hailuoto8
Halikko2
Halsua6
Hameenkyro3
Hameenlinna19
Hameenlinna3
......

Теперь, чтобы не утруждать читателя инструкциями по настройке интерфейса, приведу просто код его динамической настройки (Кнопку, которую я создал ранее, я удалил вместе с обработчиком события 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 написано очень основательно вот тут.

Комментариев нет:

Отправить комментарий