مصفوفه لعمل Index لملف Text
#2
عملت تغير صغير فقط على الدالة ExtractStrings الموجودة فى الوحدة Classes

[صورة: 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; 


الملفات المرفقة
.rar   ArrMot.rar (الحجم : 2.09 ك ب / التحميلات : 37)
الرد


الردود في هذا الموضوع
مصفوفه لعمل Index لملف Text - بواسطة NOna - 16-02-2009, 07:39 AM
مصفوفه لعمل Index لملف Text - بواسطة hanipino - 16-02-2009, 11:10 AM
مصفوفه لعمل Index لملف Text - بواسطة NOna - 16-02-2009, 12:16 PM
مصفوفه لعمل Index لملف Text - بواسطة hanipino - 16-02-2009, 01:08 PM
مصفوفه لعمل Index لملف Text - بواسطة NOna - 16-02-2009, 01:24 PM
مصفوفه لعمل Index لملف Text - بواسطة hanipino - 16-02-2009, 02:13 PM
مصفوفه لعمل Index لملف Text - بواسطة NOna - 16-02-2009, 08:44 PM
مصفوفه لعمل Index لملف Text - بواسطة hanipino - 16-02-2009, 09:59 PM
مصفوفه لعمل Index لملف Text - بواسطة NOna - 16-02-2009, 11:10 PM
مصفوفه لعمل Index لملف Text - بواسطة hanipino - 17-02-2009, 02:22 AM
مصفوفه لعمل Index لملف Text - بواسطة AL-MOB4RM3G - 18-02-2009, 07:14 PM
مصفوفه لعمل Index لملف Text - بواسطة hanipino - 21-02-2009, 01:45 PM
مصفوفه لعمل Index لملف Text - بواسطة NOna - 16-02-2009, 07:10 PM
مصفوفه لعمل Index لملف Text - بواسطة NOna - 17-02-2009, 09:56 AM

التنقل السريع :


يقوم بقرائة الموضوع: بالاضافة الى ( 1 ) ضيف كريم