Sscanf в 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.

[000301]

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