16-02-2009, 11:10 AM
عملت تغير صغير فقط على الدالة ExtractStrings الموجودة فى الوحدة Classes
![[صورة: sanstitreqg6.jpg]](http://img136.imageshack.us/img136/9955/sanstitreqg6.jpg)
-
![[صورة: sanstitreqg6.jpg]](http://img136.imageshack.us/img136/9955/sanstitreqg6.jpg)
-
PHP كود :
function ExtractStrings(Separators, WhiteSpace: TSysCharSet; Content: PChar
): Integer;
var
Head, Tail: PChar;
//-------------//
Indx:LongWord;
Strings: TStringList;
//-------------//
EOS, InQuote: Boolean;
QuoteChar: Char;
Item: string;
begin
Strings:=TStringList.Create;
Result := 0; Indx:=0;
if (Content = nil) or (Content^=#0) or (Strings = nil) then Exit;
Tail := Content;
InQuote := False;
QuoteChar := #0;
Strings.BeginUpdate;
try
repeat
while Tail^ in WhiteSpace + [#13, #10] do Tail := StrNextChar(Tail);
Head := Tail;
while True do
begin
while (InQuote and not (Tail^ in [QuoteChar, #0])) or
not (Tail^ in Separators + [#0, #13, #10, '''', '"']) do Tail := StrNextChar(Tail);
if Tail^ in ['''', '"'] then
begin
if (QuoteChar <> #0) and (QuoteChar = Tail^) then
QuoteChar := #0
else if QuoteChar = #0 then
QuoteChar := Tail^;
InQuote := QuoteChar <> #0;
Tail := StrNextChar(Tail);
end else Break;
end;
EOS := Tail^ = #0;
if (Head <> Tail) and (Head^ <> #0) then
begin
if (Strings <> nil) then
begin
SetString(Item, Head, Tail - Head);
if (Strings.IndexOf(Item)< 0) then
begin
SetLength(ArrStr,Indx+1);
Strings.Add(Item);
ArrStr[Indx]:=(Item);
Inc(Indx);
end;
end;
Inc(Result);
end;
Tail := StrNextChar(Tail);
until EOS;
finally
Strings.EndUpdate;
end;
Strings.Free;
end;
procedure TForm1.btn1Click(Sender: TObject);
var
Str:TStringList;
begin
Str:=TStringList.Create;
if dlgOpen1.Execute then
begin
Str.LoadFromFile(dlgOpen1.FileName);
ExtractStrings([' '],
[' '],
(PChar(Str.Text)));
end;
Str.Free;
end;

