VPF::Unicode Search - Форум программистов

mojo

Дата 30.5.2007, 12:43 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 30.5.2007

Репутация: нет
Всего: нет

Hi All .
Sorry for writing in english .
I used the bellow code to find a keyword in a Non-Unicode Html Files and every thing went good , but when i want to use it to find a Keyword in a Unicode Html File it doesn't give any result ,
could someone direct or help me really i need your help :

Код


function ScanFile(const filename: String; 
                 const forString: String; // WideString  
                 caseSensitive: Boolean ): LongInt; 
{ returns position of string in file or -1, if not found } 
const 
BufferSize= $8001;  { 32K+1 bytes } 
var 
pBuf, pEnd, pScan, pPos : PWidechar; 
filesize: LongInt; 
bytesRemaining: LongInt; 
bytesToRead: Integer; 
F   : File; 
SearchFor: PWidechar; 
oldMode: Word; 
begin 
Result := -1;  { assume failure } 
if (Length( forString ) = 0) or (Length( filename ) = 0) then 
   Exit; 
SearchFor := nil; 
pBuf      := nil; 

{ open file as binary, 1 byte recordsize } 
AssignFile( F, filename ); 
oldMode := FileMode; 
FileMode := 0;    { read-only access } 
Reset( F, 1 ); 
FileMode := oldMode; 
try { allocate memory for buffer and pchar search string } 
   SearchFor := StrAllocW( Length( forString )+1 ); 
   StrPCopyW( SearchFor, forString ); 
  if not caseSensitive then  { convert to upper case } 

  Tnt_WideUpperCase(SearchFor ); // 
    // AnsiUpperCase( SearchFor ); 
   GetMem( pBuf, BufferSize ); 
   filesize := System.Filesize( F ); 
   bytesRemaining := filesize; 
   pPos := nil; 
   while bytesRemaining > 0 do 
   begin 
     { calc how many bytes to read this round } 
     if bytesRemaining >= BufferSize then 
       bytesToRead := Pred( BufferSize ) 
     else 
       bytesToRead := bytesRemaining; 

     { read a buffer full and zero-terminate the buffer } 
     BlockRead(F, pBuf^, bytesToRead, bytesToRead); 
     pEnd := @pBuf[ bytesToRead ]; 
     pEnd^:= #0; 
     { scan the buffer. Problem: buffer may contain #0 chars! So we 
       treat it as a concatenation of zero-terminated strings. } 
     pScan := pBuf; 
     while pScan < pEnd do 
     begin 
      if not caseSensitive then { convert to upper case } 
        Tnt_WideUpperCase( pScan ); 
       pPos := StrPosW( pScan, SearchFor );  { search for substring } 
       if pPos <> nil then 
       begin { Found it! } 
         Result := FileSize - bytesRemaining + 
                   LongInt( pPos ) - LongInt( pBuf ); 
         Break; 
       end; 
       pScan := StrEndW( pScan ); 
       Inc( pScan ); 
     end; 
     if pPos <> nil then 
       Break; 
     bytesRemaining := bytesRemaining - bytesToRead; 
     if bytesRemaining > 0 then 
     begin 
     { no luck in this buffers load. We need to handle the case of 
       the search string spanning two chunks of file now. We simply 
       go back a bit in the file and read from there, thus inspecting 
       some characters twice 
     } 
       Seek( F, FilePos(F)-Length( forString )); 
       bytesRemaining := bytesRemaining + Length( forString ); 
     end; 
   end; { While } 
finally 
   CloseFile( F ); 
   If SearchFor <> nil then 
     StrDisposeW( SearchFor ); 
   If pBuf <> nil then 
     FreeMem( pBuf, BufferSize ); 
end; 
end; { ScanFile } 
procedure GetFileList( FileList: TStringList; inDir, Extension : String ); 
procedure ProcessSearchRec( aSearchRec : TSearchRecW ); 
var 
  sDate: String; 
begin 
   if ( aSearchRec.Attr and faDirectory ) <> 0 then 
   begin 
     if ( aSearchRec.Name <> '.' ) and 
        ( aSearchRec.Name <> '..' ) then 
     begin 
       GetFileList( FileList, Extension, InDir + '\' + aSearchRec.Name ); 
     end; 
   end 
   else 
   begin 
     sDate := DateTimeToStr(FileDateToDateTime(aSearchRec.Time)); 
     FileList.Add(inDir + '\' + aSearchRec.Name); 

   end; 

end; 

var CurDir : String; 
aSearchRec : TSearchRecW; 
begin 
CurDir := inDir + '\*.' + Extension; 
if WideFindFirst( CurDir, faAnyFile, aSearchRec ) = 0 then 
begin 
   ProcessSearchRec( aSearchRec ); 
   while WideFindNext( aSearchRec ) = 0 do 
     ProcessSearchRec( aSearchRec ); 
end; 
WideFindClose(aSearchRec); 

end; 



procedure TForm1.GetHTMLFileList(Directory, SearchString: WideString; 
  CaseSens: Boolean); 
var 
FL: TStringList; 
begin 
FL := TStringList.Create; 
FL.Sorted := True; 
GetFileList(FL, Directory, 'HTM*'); 
ProcessHTMLFIles(FL, SearchString, CaseSens); 
FL.Free; 
end; 


procedure TForm1.ProcessHTMLFiles(FileList: TStringList; 
  SearchString: WideString; CaseSens: Boolean); 
var 
i: Integer; 
begin 
for i := 0 to Pred(FileList.Count) do 
begin 
   if ScanFile(FileList.Strings[i], SearchString, CaseSens) > 0 then 
   begin 
     // The result was found 
     Memo1.Lines.Add(FileList.Strings[i]); // TntMemo
   end; 
end; 
end;

mojo

Дата 30.5.2007, 17:01 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 30.5.2007

Репутация: нет
Всего: нет

I attached an exemple so that someone can help me please

Search

Это сообщение отредактировал(а) mojo - 30.5.2007, 17:04

MetalFan

Дата 30.5.2007, 20:38 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128

Hello!
I don't have functions StrPCopyW and StrAllocW in Delphi 6. and for what it can be used if delphi has a WideString type.
simply write

Код


var
   lAnsiString: string;
   lWideString: widestring;
begin
...
  lAnsiString := 'Some Value';
  lWideString := lAnsiString;
 ...

and you'll have in lWideString converted to unicode lAnsiString.

and second... a unicode PWideChar must have at the end two zero bytes...

hm... plz keep in mind, if you work with unicode buffer - one unicode symbol keeps in 2 bytes.

Цитата(mojo @ 30.5.2007, 12:43

)

     if bytesRemaining > 0 then
     begin
     { no luck in this buffers load. We need to handle the case of
       the search string spanning two chunks of file now. We simply
       go back a bit in the file and read from there, thus inspecting
       some characters twice
     }
       Seek( F, FilePos(F)-Length( forString ));
       bytesRemaining := bytesRemaining + Length( forString );

why you use Length(forString) ??
to get length of unicode string in bytes, multiply length( AString ) by 2....

maybe there are another mistakes...

sorry for my english

Это сообщение отредактировал(а) MetalFan - 30.5.2007, 20:41

--------------------

There are always someone smarter than you...

mojo

Дата 31.5.2007, 09:23 (ссылка)

(нет голосов)

Загрузка ...

Новичок

Профиль
Группа: Участник
Сообщений: 7
Регистрация: 30.5.2007

Репутация: нет
Всего: нет

Thank you MetalFan :
StrPCopyW and StrAllocW are from the Unite Unicode20 of Mike i will attache it here

Really i need your help could you please correct my exemple , so that i can use it ..

many many thanks

Это сообщение отредактировал(а) mojo - 31.5.2007, 09:25

Присоединённый файл ( Кол-во скачиваний: 11 )

Unicode20.zip 66,05 Kb

MetalFan

Дата 31.5.2007, 09:34 (ссылка)

(нет голосов)

Загрузка ...

Аццкий Сотона

Профиль
Группа: Комодератор
Сообщений: 3815
Регистрация: 2.10.2006
Где: Moscow

Репутация: 22
Всего: 128

I don't have TntControls installed and don't install it in future.
So I Can't correct and debug your example...
but I show some of mistakes in your example... correct this... maybe it helps...
wbw

Это сообщение отредактировал(а) MetalFan - 31.5.2007, 09:35

--------------------

There are always someone smarter than you...

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Для новичков \| Следующая тема »