Советы по Delphi
       

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;begins1 := '';while (s[n] = ' ') and (Length(s) > n) do inc(n);while (s[n] in ['0'..'9', '+', '-'])and (Length(s) >= n) do begins1 := s1+s[n];inc(n);end;Result := Length(s1);end;
function GetFloat : Integer;begins1 := '';while (s[n] = ' ') and (Length(s) > n) do inc(n);while (s[n] in ['0'..'9', '+', '-', '.', 'e', 'E'])and (Length(s) >= n) do begins1 := s1+s[n];inc(n);end;Result := Length(s1);end;
function GetString : Integer;begins1 := '';while (s[n] = ' ') and (Length(s) > n) do inc(n);while (s[n] <> ' ') and (Length(s) >= n) dobegins1 := s1+s[n];inc(n);end;Result := Length(s1);end;
function ScanStr(c : Char) : Boolean;beginwhile (s[n] <> c) and (Length(s) > n) do inc(n);inc(n);
If (n <= Length(s)) then Result := Trueelse Result := False;end;
function GetFmt : Integer;beginResult := -1;
while (TRUE) do beginwhile (fmt[m] = ' ') and (Length(fmt) > m) do inc(m);if (m >= Length(fmt)) then break;
if (fmt[m] = '%') then begininc(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 beginj := GetFmt;
case j ofvtInteger : beginif GetInt > 0 then beginL := StrToInt(s1);Move(L, Pointers[i]^, SizeOf(LongInt));inc(Result);endelse break;end;
vtExtended : beginif GetFloat > 0 then beginX := StrToFloat(s1);Move(X, Pointers[i]^, SizeOf(Extended));inc(Result);endelse break;end;
vtString : beginif GetString > 0 then beginMove(s1, Pointers[i]^, Length(s1)+1);inc(Result);endelse break;end;
else break;end;end;end;

end.
[000301]



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