Парсер печатных текстовых форм

Slava Kostin пишет:

Для себя недавно написал. А вдруг, кому пригодится? Часто приходится генерировать формы в текстовые файлы, заполнять поля кучей всяких значений. Приведенный ниже модуль помогает мне упростить свою жизнь. Для удобства использования я все оформил в виде одной функции.

Сначала приведу пример формы с комментариями для ее использования, затем - собственно юнит PrintForm.

Итак, форма: ;Строки комментариев должны начинаться со знака ";". ;В одной строке не должно быть более одной команды ;Секции могут следовать в любом порядке. ;Конечный вид формы будет сформирован путем конкатенации всех секций !FORM. ;Значения полей будут подставляться в форму в том порядке, в котором они ;встречаются в тексте файла-определения формы. При этом играет роль только ;порядок перечисления полей, а располагать эти описания можно в любом месте ;формы. В поля форму будут подставляться параметры, определенные в виде ; !FIELD[n](a) ; где n - порядковый номер параметра ; a - выравнивание (может принимать значения "c", "l", "r") ;Знакоместа для полей просматриваются слева направо и сверху вниз !DEFINE Mask="$" !FORM----------------------------------------------------------------- !FORM¬ Бланк учета отгрузки товара За $$ месяц ¬ !FORM¬ ¬ !FORM¬ Товар: $$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$$ ¬ !FORM¬ Стоимость единицы товара: $$$$$$$$$$ ¬ !FIELD[1](l) ;Месяц является первым из параметров !FIELD[2](l) ;Наименование товара !FIELD[3](c) ;Стоимость выравниваем по правому краю

;Предположим, что в дальнейшей части формы необходимо вывести символ "$" ;Для этого переопределим маску: !DEFINE Mask="#" ;И продолжаем определение формы: !FORM¬ Количество единиц товара: ###### штук ¬ !FORM¬ Общая сумма в рублях: ######## руб. ¬ !FORM¬ Общая сумма в долларах: ###### $ ¬ !FORML---------------------------------------------------------------- !FIELD[4](r) ;Количество единиц товара !FIELD[5](r) ;Общая сумма в рублях !FIELD[6](r) ;Общая сумма в долларах А это сам unit:

unit PrintForm;

interface

uses SysUtils;

{Процедура, осуществляющая запись формы, определенной пользователем.
Данные для заполнения этой формы берутся из архива FormData.
FormFile - файл с шаблоном формы, оформленным особым образом
(см. файл printform.frm) OutFile - файл, в котором будет сохранена заполненная форма

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

var FormData: array [0..6] of String;
begin
FormData[1] := '03'; FormData[2] := 'Потники сушеные в контейнерах'; CharToOem(PChar(FormData[2]), PChar(FormData[2])); FormData[3] := '10000'; FormData[4] := '9'; FormData[5] := '90000'; FormData[6] := '69,23'; PrnForm(FormData, 'D:\MyProg\Forms\fillform.frm', 'D:\MyProg\Forms\_out.frm'); end.

}
function PrnForm(FormData: array of String; FormFile, OutFile: String): Integer;

implementation

{Автор: Slava Kostin}
{Возвращаемые значения:
0 - все в порядке 1 - не найден файл формы 2 - обнаружена неизвестная команда 3 - неверный числовой параметр 4 - некорректный символ выравнивания -255 - произошла какая-то непонятная ошибка } function PrnForm(FormData: array of String; FormFile, OutFile: String): Integer;
const COMMENT = ';'; //Символ комментария
const INT_MASK = 0; //Внутренний (для функции) символ, считающийся
//маской. Шаблон формы не должен содержать //ни одного символа с кодом, равным INT_MASK. const COMMANDS_QUANTITY = 3; //Количество обрабатываемых команд
//Массив имен обрабатываемых команд в теле шаблона формы:
const COMMANDS: array [0..COMMANDS_QUANTITY - 1] of String = (
'!DEFINE', '!FORM', '!FIELD' );
var frm_f, out_f: TextFile;
i, fld_idx: Integer; isDigit: Boolean; msg, str, param: String; Mask: Char; outform, flds: array of String; align: array of Char;
//Функция, возвращающая подстроку строки str, заключенную между
//последовательностями символов LeftDelim слева и RightDelim справа
function GetWordLimited(str: String; LeftDelim, RightDelim: String): String;
begin
Result := Copy(str, Pos(LeftDelim, str) + 1, LastDelimiter(RightDelim, str) - Pos(LeftDelim, str) - 1); end;

//Данная процедура заменяет текущие символы маски в строке str
//на внутренние символы маски для дальнейшей обработки
procedure ReplaceMask(var str: String; Mask: Char);
var i: Integer;
begin
for i := 1 to Length(str) do if str[i] = Mask then str[i] := Char(INT_MASK); end;

//Центрирование строки str. Длина строки, которая должна быть //получена, задается параметром w. function CenterString(str: String; w: Integer): String;
var i: Integer;
begin
Result := str; if w <= Length(str) then Exit; for i := 1 to (Trunc(w / 2)) do begin Insert(' ', str, 1); str := str + ' '; end; if Length(str) > w then SetLength(str, w); Result := str; end;

//Функция, осуществляющая выравнивание содержимого поля
//в соответствии с типом выравнивания:
//   L - по левому краю,
//   R - по правому краю,
//   C - по центру
function AlignField(fld_idx, w: Integer): String;
begin
Result := ''; if fld_idx >= Length(flds) then Exit; case align[fld_idx] of 'L': Result := Format('%-' + IntToStr(w) + 's', [flds[fld_idx]]); 'R': Result := Format('%' + IntToStr(w) + 's', [flds[fld_idx]]); 'C': Result := CenterString(flds[fld_idx], w); else Exception.Create('1'); end; end;

//Данная функция заменяет первую маску в строке на значение
//соответствующего поля. Если строка не содержит маски,
//функция возвращает false. При успешной замене - true
function PutOneField(var str: String; fld_idx: Integer): Boolean;
var first, last: Integer;
begin
Result := false; first := Pos(Char(INT_MASK), str); if (fld_idx >= Length(flds)) or (first = 0) then Exit; last := first; while (last < Length(str)) and (str[last] = Char(INT_MASK)) do Inc(last); str := Copy(str, 1, first - 1) + AlignField(fld_idx, last - first) + Copy(str, last, Length(str) - last + 1); Result := true; end;

//Тело основной функции
begin
Result := 0; Mask := Char(INT_MASK); try if not FileExists(FormFile) then Exception.Create('1'); AssignFile(frm_f, FormFile); Reset(frm_f);
AssignFile(out_f, OutFile); if not FileExists(OutFile) then Rewrite(out_f) else Append(out_f);
while not Eof(frm_f) do begin ReadLn(frm_f, str); if Pos(COMMENT, str) <> 0 then //Обрубаем комментарии SetLength(str, Pos(COMMENT, str) - 1); str := Trim(str); if Length(str) > 0 then begin i := 0; while i < COMMANDS_QUANTITY do   //Определение команды begin if UpperCase(Copy(str, 1, Length(COMMANDS[i]))) = COMMANDS[i] then Break; Inc(i); end; param := ''; //Когда команда определена, совершаем необходимые действия, //выбор которых производится в зависимости от порядкового //номера данной команды в массиве команд case i of 0: begin //Обработка команды !DEFINE param := UpperCase(Trim(Copy(str, Length(COMMANDS[i]) + 1, Pos('=', str) - Length(COMMANDS[i]) - 1))); if param = 'MASK' then Mask := GetWordLimited(str, '"', '"')[1]; end; 1: begin //Обработка команды !FORM Delete(str, 1, Length(COMMANDS[i])); ReplaceMask(str, Mask); SetLength(outform, Length(outform) + 1); outform[Length(outform) - 1] := str; end; 2: begin //Обработка команды !FIELD Delete(str, 1, Length(COMMANDS[i])); SetLength(flds, Length(flds) + 1); flds[Length(flds) - 1] := FormData[StrToInt(GetWordLimited(str, '[', ']'))]; SetLength(align, Length(align) + 1); align[Length(align) - 1] := UpperCase(GetWordLimited(str, '(', ')'))[1]; end; else Exception.Create('2'); //Если код команды не опознан - выходим с исключением end; end; end;
//Шаблон формы и значения полей в том порядке, в котором //они встречаются в шаблоне, считаны целиком. //Далее производится подстановка значений полей на места масок //в шаблоне формы и запись формы в выходной файл: fld_idx := 0; for i := 0 to Length(outform) - 1 do begin while PutOneField(outform[i], fld_idx) do Inc(fld_idx); WriteLn(out_f, outform[i]); end;
Close(out_f); Close(frm_f); except //Обработка ошибок, возникших при работе функции on E: EConvertError do //Ошибка преобразования типов begin Result := 3; end; //Все остальные типы ошибок идентифицируются по номеру. //Функция по окончании работы возвращает номер ошибки //(или 0, если в процессе работы не было ошибок) on E: Exception do begin msg := String(E.Message); isDigit := true; for i := 1 to Length(msg) do if not (msg[i] in [Char('0')..Char('9')]) then begin isDigit := false; Break; end; if not isDigit then begin Result := -255; Exit; end; Result := StrToInt(msg); end; end; end;

end.

[001897]

Содержание раздела