sscanf в Delphi (синтаксический разбор входной строки)

Written on . Posted in [Delphi] Алгоритмы

Применять данный модуль надлежит с некоторой долей осторожности, ибо тэг %s иногда приводит к исключительным ситуациям.

 

unit Scanf;

interface
uses SysUtils;

type
EFormatError = class(ExCeption);


function Sscanf(const s: string; const fmt : string;
const Pointers : array of Pointer) : Integer;
implementation

{ Sscanf выполняет синтаксический разбор входной строки. Параметры...
s - входная строка для разбора
fmt - 'C' scanf-форматоподобная строка для управления разбором
%d - преобразование в Long Integer
%f - преобразование в Extended Float
%s - преобразование в строку (ограничено пробелами)
другой символ - приращение позиции s на "другой символ"
пробел - ничего не делает
Pointers - массив указателей на присваиваемые переменные

результат - количество действительно присвоенных переменных

Например, ...
Sscanf('Name. Bill   Time. 7:32.77   Age. 8',
'. %s . %d:%f . %d', [@Name, @hrs, @min, @age]);

возвратит ...
Name = Bill  hrs = 7  min = 32.77  age = 8 }

function Sscanf(const s: string; const fmt : string;
const Pointers : array of Pointer) : Integer;
var
i,j,n,m : integer;
s1      : string;
L       : LongInt;
X       : Extended;

function GetInt : Integer;
begin
s1 := '';
while (s[n] = ' ')  and (Length(s) > n) do inc(n);
while (s[n] in ['0'..'9', '+', '-'])
and (Length(s) >= n) do begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;

function GetFloat : Integer;
begin
s1 := '';
while (s[n] = ' ')  and (Length(s) > n) do inc(n);
while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])
and (Length(s) >= n) do begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;

function GetString : Integer;
begin
s1 := '';
while (s[n] = ' ')  and (Length(s) > n) do inc(n);
while (s[n] <> ' ') and (Length(s) >= n) do
begin
s1 := s1+s[n];
inc(n);
end;
Result := Length(s1);
end;

function ScanStr(c : Char) : Boolean;
begin
while (s[n] <> c) and (Length(s) > n) do inc(n);
inc(n);

If (n <= Length(s)) then Result := True
else Result := False;
end;

function GetFmt : Integer;
begin
Result := -1;

while (TRUE) do begin
while (fmt[m] = ' ') and (Length(fmt) > m) do inc(m);
if (m >= Length(fmt)) then break;

if (fmt[m] = '%') then begin
inc(m);
case fmt[m] of
'd': Result := vtInteger;
'f': Result := vtExtended;
's': Result := vtString;
end;
inc(m);
break;
end;

if (ScanStr(fmt[m]) = False) then break;
inc(m);
end;
end;

begin
n := 1;
m := 1;
Result := 0;

for i := 0 to High(Pointers) do begin
j := GetFmt;

case j of
vtInteger : begin
if GetInt > 0 then begin
L := StrToInt(s1);
Move(L, Pointers[i]^, SizeOf(LongInt));
inc(Result);
end
else break;
end;

vtExtended : begin
if GetFloat > 0 then begin
X := StrToFloat(s1);
Move(X, Pointers[i]^, SizeOf(Extended));
inc(Result);
end
else break;
end;

vtString : begin
if GetString > 0 then begin
Move(s1, Pointers[i]^, Length(s1)+1);
inc(Result);
end
else break;
end;

else break;
end;
end;
end;

end.
delphi форум