Парсинг строк
Falk0ner, вс, 06/07/2008 - 15:34.
http://delphiworld.narod.ru/
DelphiWorld 6.0
unit splitfns;
interface
uses Classes, Sysutils;
function GetToken(Const S: string; Separator: TSysCharSet; var StartPos: integer): String;
{Returns the next token (substring) from string S, starting at index StartPos and ending 1 character
before the next occurrence of Separator (or at the end of S, whichever comes first).}
{StartPos returns the starting position for the next token, 1 more than the position in S of
the end of this token}
procedure Split(const S: String; Separator: TSysCharSet; MyStringList: TStringList);
{Splits a string containing designated separators into tokens and adds them to MyStringList NOTE: MyStringList must be Created before being passed to this procedure and Freed after use}
function AddToken (const aToken, S: String; Separator: Char; StringLimit: integer): String;
{Used to join 2 strings with a separator character between them and can be used in a Join function}
{The StringLimit parameter prevents the length of the Result String from exceeding a preset maximum}
implementation
function GetToken(Const S: string; Separator: TSysCharSet; var StartPos: integer): String;
var Index: integer;
begin
Result := '';
{Step over repeated separators}
While (S[StartPos] in Separator) and (StartPos <= length(S)) do StartPos := StartPos + 1;
if StartPos > length(S) then Exit;
{Set Index to StartPos}
Index := StartPos;
{Find the next Separator}
While not (S[Index] in Separator) and (Index <= length(S))do Index := Index + 1;
{Copy the token to the Result}
Result := Copy(S, StartPos, Index - StartPos);
{SetStartPos to next Character after the Separator}
StartPos := Index + 1;
end;
procedure Split(const S: String; Separator: TSysCharSet; MyStringList: TStringList);
var Start: integer;
begin
Start := 1;
While Start <= Length(S) do MyStringList.Add(GetToken(S, Separator, Start));
end;
function AddToken (const aToken, S: String; Separator: Char; StringLimit: integer): String;
begin
if Length(aToken) + Length(S) < StringLimit then
begin
{Add a separator unless the Result string is empty}
if S = '' then Result := '' else Result := S + Separator;
{Add the token}
Result := Result + aToken;
end
else
{if the StringLimit would be
exceeded, raise an exception}
Raise Exception.Create('Cannot add token');
end;
end.
пример использования:
interface
uses Classes, Sysutils;
function GetToken(Const S: string; Separator: TSysCharSet; var StartPos: integer): String;
{Returns the next token (substring) from string S, starting at index StartPos and ending 1 character
before the next occurrence of Separator (or at the end of S, whichever comes first).}
{StartPos returns the starting position for the next token, 1 more than the position in S of
the end of this token}
procedure Split(const S: String; Separator: TSysCharSet; MyStringList: TStringList);
{Splits a string containing designated separators into tokens and adds them to MyStringList NOTE: MyStringList must be Created before being passed to this procedure and Freed after use}
function AddToken (const aToken, S: String; Separator: Char; StringLimit: integer): String;
{Used to join 2 strings with a separator character between them and can be used in a Join function}
{The StringLimit parameter prevents the length of the Result String from exceeding a preset maximum}
implementation
function GetToken(Const S: string; Separator: TSysCharSet; var StartPos: integer): String;
var Index: integer;
begin
Result := '';
{Step over repeated separators}
While (S[StartPos] in Separator) and (StartPos <= length(S)) do StartPos := StartPos + 1;
if StartPos > length(S) then Exit;
{Set Index to StartPos}
Index := StartPos;
{Find the next Separator}
While not (S[Index] in Separator) and (Index <= length(S))do Index := Index + 1;
{Copy the token to the Result}
Result := Copy(S, StartPos, Index - StartPos);
{SetStartPos to next Character after the Separator}
StartPos := Index + 1;
end;
procedure Split(const S: String; Separator: TSysCharSet; MyStringList: TStringList);
var Start: integer;
begin
Start := 1;
While Start <= Length(S) do MyStringList.Add(GetToken(S, Separator, Start));
end;
function AddToken (const aToken, S: String; Separator: Char; StringLimit: integer): String;
begin
if Length(aToken) + Length(S) < StringLimit then
begin
{Add a separator unless the Result string is empty}
if S = '' then Result := '' else Result := S + Separator;
{Add the token}
Result := Result + aToken;
end
else
{if the StringLimit would be
exceeded, raise an exception}
Raise Exception.Create('Cannot add token');
end;
end.
...
data:= TStringList.Create;
splited:=TStringList.Create;
data.LoadFromFile(s);
Split(data.Text,[',',' ',#10,#13,';','\"','.','!','-','+','*','/','\',
'(',')','[',']','{','}','<','>','''','"','?','"','#',#0],splited);
for i:= 0 to splited.Count-1 do
begin
if not words.Find(splited.Strings,adr) then
words.Add(splited.Strings[i]);
application.processmessages;[i]//make program to respond to user
//commands while processing in case of very long string.
end;
...
data:= TStringList.Create;
splited:=TStringList.Create;
data.LoadFromFile(s);
Split(data.Text,[',',' ',#10,#13,';','\"','.','!','-','+','*','/','\',
'(',')','[',']','{','}','<','>','''','"','?','"','#',#0],splited);
for i:= 0 to splited.Count-1 do
begin
if not words.Find(splited.Strings,adr) then
words.Add(splited.Strings[i]);
application.processmessages;[i]//make program to respond to user
//commands while processing in case of very long string.
end;
...
Автор: Song
Взято из http://forum.sources.ru
Некоторое время назад одна любезная душа прислала мне этот модуль. Я нашел его весьма полезным, но применять его вам надлежит с некоторой долей осторожности, ибо тэг %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.
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.
http://delphiworld.narod.ru/
DelphiWorld 6.0
// Parse a string, for example:
// How do I get the "B" from "A|B|C|D|E|F"?
function Parse(Char, S: string; Count: Integer): string;
var
I: Integer;
T: string;
begin
if S[Length(S)] <> Char then
S := S + Char;
for I := 1 to Count do
begin
T := Copy(S, 0, Pos(Char, S) - 1);
S := Copy(S, Pos(Char, S) + 1, Length(S));
end;
Result := T;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(Parse('|', 'A|B|C|D|E|F', 2));
end;
{
Parameters:
Parse([Character, for example "|"], [The string],
[The number, the "B" is the 2nd part of the string]);
This function is handy to use when sending data over the internet,
for example a chat program: Name|Text. Note: Be sure there's no "Char" in the string!
Use a unused character like "|" or "?".
}
// How do I get the "B" from "A|B|C|D|E|F"?
function Parse(Char, S: string; Count: Integer): string;
var
I: Integer;
T: string;
begin
if S[Length(S)] <> Char then
S := S + Char;
for I := 1 to Count do
begin
T := Copy(S, 0, Pos(Char, S) - 1);
S := Copy(S, Pos(Char, S) + 1, Length(S));
end;
Result := T;
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(Parse('|', 'A|B|C|D|E|F', 2));
end;
{
Parameters:
Parse([Character, for example "|"], [The string],
[The number, the "B" is the 2nd part of the string]);
This function is handy to use when sending data over the internet,
for example a chat program: Name|Text. Note: Be sure there's no "Char" in the string!
Use a unused character like "|" or "?".
}
Взято с сайта: http://www.swissdelphicenter.ch
{ s - входная строка для разбора}
const s: string;
{ fmt - 'C' scanf-форматоподобная строка для управления разбором}
const fmt: string;
{ Pointers - массив указателей на присваиваемые переменные}
const Pointers: array of Pointer;
{ может ли отсутствовать строка %s}
const aStringCanBeNil : Boolean = False
): Boolean;
var
i, j, n, m: integer;
s1: string; vP: Pointer;
L: LongInt;
X: Extended;
c: Integer ;
// p: Pointer;
pc: PChar;
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;
// end;
function GetString: Integer;
var
subFmt: string;
pos0Fmt: Integer;
subFmtNextChain: string;
subS: string;
posEOS: Integer;
begin
// { текущая позиция в строке-маске}
// fmt[m]
// { текщая позиция в анализируемой строке}
// s[n]
{найдем позицию % в строке-формате}
subFmt := Copy(fmt, m, Length(fmt)-m+1);
subS := Copy(s, n, Length(s) -n+1);
pos0Fmt := Pos('%', subFmt);
{ если не нашли % в строке -формате}
if pos0Fmt =0
then begin
{ нет в строке больше выражений-масок с %}
if m<Length(fmt)
then begin
{ после строки есть еще символы, которые не должны быть включены в строку}
{ найдем вхождение этих символов в остатоке анализируемой строки}
posEOS := Pos(subFmt, subS);
if posEOS=0
then begin
{ нет вхождения, нет строки}
s1 :='';
n := Length(s);
end
else begin
{ есть вхождение, строка до этого вхождения}
s1 := Copy(s, n, posEOS-1);
n := posEOS +n-1;
end;
end
else begin
{ после строки нет символов, берем все до конца анализируемого выражения}
s1 := Copy(s, n, Length(s)-n+1);
end;
end
else begin
{ есть в строке выражения-маски %}
{ получим следующую за %s последовательность разделителей}
subFmtNextChain := Copy(subFmt, 1, pos0Fmt-1);
{ найдем позицию этой последовательности в остатке анализируемой строки}
posEOS := Pos(subFmtNextChain, subS);
if posEOS=0
then begin
{ нет вхождения, нет строки}
s1 :='';
n := Length(s);
end
else begin
{ есть вхождение, строка до этого вхождения}
s1 := Copy(s, n, posEOS-1);
n := posEOS +n-1;
end;
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 ScanStrAcuracy(c: Char): Boolean;
begin
if s[n] <> c
then Result := False
else begin
inc(n);
if (n <= Length(s))
then Result := True
else Result := False;
end;
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;
if (ScanStrAcuracy(fmt[m]) = False)
then break;
inc(m);
end;
end;
begin
n := 1;
m := 1;
c := 0;
pc:= nil;
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(c);
end
else break;
end;
vtExtended: begin
if GetFloat > 0 then begin
X := StrToFloat(Str2DecimalSeparator(s1));
Move(X, Pointers[i]^, SizeOf(Extended));
inc(c);
end
else break;
end;
vtString: begin
{ может ли отсутствовать строка %s}
if aStringCanBeNil
then begin
GetString;
GetMem(PChar(Pointers[i]^), (Length(s1)*SizeOf(Char) + 1)); //SizeOf(Char) *MAX_PATH +1);
StrLCopy(PChar(Pointers[i]^), PChar( s1), Length( s1));
inc(c);
end
else begin
if GetString > 0 then begin
// GetMem(PChar(Pointers[i]^), (Length(s1)*SizeOf(Char) + 1)); //SizeOf(Char) *MAX_PATH +1);
// StrLCopy(PChar(Pointers[i]^), PChar( s1), Length( s1) );
GetMem(PChar(Pointers[i]^), (Length(s1)*SizeOf(Char) + 1)); //SizeOf(Char) *MAX_PATH +1);
StrLCopy(PChar(Pointers[i]^), PChar( s1), Length( s1)+1 );
inc(c);
end
else break;
end;
s1 := '';
end;
else
break;
end;
end;
if Length(Pointers)>0
then Result := c = Length(Pointers)
else Result := Pos( fmt, s) =1;
// else Result := Pos(fmt, s) >0
end;
!!! работает корректно со строками Строка должна точно соответствовать формату
c: Integer;
{ буер для строковых значений}
vBuffer_4Str: PChar;
{ тип событиz магнетометра}
vEvent_Type: TMgEvent_Type;
{ маски, соответствующие типам событий магнетометра}
vEvent_Mask: string;
{ данные, в зависимости от типа события магнетометра}
vEvent_Data : TMgEvent_Data;
begin
{ переберем все известные события}
for vEvent_Type := Low( TMgEvent_Type) to High( TMgEvent_Type) do begin
{ маска для определения этого события}
vEvent_Mask := cMgEvent_Mask[ vEvent_Type];
vEvent_Data.Event_Type := vEvent_Type;
vBuffer_4Str := nil;
{ результат разбора отличается... поэтому такая громоздкая хрень}
case vEvent_Type of
metStandard_Explorer_Data, metSingle_reading: begin
Result := ParseStringAcuracy(
aStringFromMag,
vEvent_Mask,
[
@vEvent_Data.sed_Year,
@vEvent_Data.sed_Julian_day,
@vEvent_Data.sed_Hour,
@vEvent_Data.sed_Minute,
@vEvent_Data.sed_Second,
@vEvent_Data.sed_Magnetic_Field,
@vEvent_Data.sed_Signal_Strength,
@vEvent_Data.sed_Depth,
@vEvent_Data.sed_Leak_sensor,
@vEvent_Data.sed_Measurement_time,
@vEvent_Data.sed_Signal_quality,
@vBuffer_4Str
],
true);
if Result
then if not Assigned( vBuffer_4Str)
then vEvent_Data.sed_Warning_Messages := ''
else vEvent_Data.sed_Warning_Messages := string(vBuffer_4Str);
if Assigned( vBuffer_4Str) then begin
FreeMem(vBuffer_4Str, (Length(vBuffer_4Str)*SizeOf(Char) + 1));
vBuffer_4Str := nil;
end;
end;
[b][/b]
Отправить комментарий