PureBasic - форум

Информация о пользователе

Привет, Гость! Войдите или зарегистрируйтесь.


Вы здесь » PureBasic - форум » Вопросы по PureBasic » поиск в директории


поиск в директории

Сообщений 1 страница 9 из 9

1

По роду своей деятельности, работаю с каталогом состоящего из html и htm файлов на локальном компютере .
Страниц порядком 500 шт.
Хочу организовать поиск по ключевому слову...

Алгоритм работы в принципи понятен:

создал окно, на нем WebGadget и StringGadget и кнопки навигации...
директория сканирования известна и постоянна
организовываю цикл чтения каждого файла и поиск в нем с помощью FindString ключевого  слова
при нахождении, выводить данный файл в WebGadget

Это если файлы все в одной папки.
Не знаю как организовать сканирование сложной структуры:
папка в ней файлы и папки, а в этих папках тоже файлы и папки и.т.д. ?

может есть примеры организации поиска ?

Код:
Procedure Direct()  ; Ск. директории
   Path.s=GetPathPart(ProgramFilename())+"Catalog" 
         If ExamineDirectory(#Directory, Path.s, "")
           Repeat
              FileType = NextDirectoryEntry(#Directory)
                If FileType 
                Result = DirectoryEntryType(#Directory) ; выявляем файл или директория.
                  FileName.s = DirectoryEntryName(#Directory)
                  ;Debug FileName.s
                  If FileName.s <> "." And FileName.s <> ".."
                    Ext$ = LCase(Right(FileName.s,4)) 
                    If Ext$ = ".html" Or Ext$ = ".htm"  
                      ;Debug FileName.s      
                    EndIf
                  EndIf
                EndIf                
             Until FileType = 0                     
          EndIf
 EndProcedure

0

2

mirashic написал(а):

может есть примеры организации поиска ?

Когда-то подобное делал.
Здесь используется рекурсионный вызов процедуры самой себя при находжении очередной папки.

Код:
Global v=0 

Procedure x(Directory$) 
If Right(Directory$,1)<>"\":Directory$ + "\":EndIf 
   z=ExamineDirectory(#PB_Any, Directory$, "*.*")  
   v=v+1 
   If v>1000 ; Это чтобы не сканировать весь диск - долго очень 
    End 
   EndIf 
  If z 
    While NextDirectoryEntry(z) 
     EntryName.s=DirectoryEntryName(z) 
      
      If EntryName = "." Or EntryName = ".." 
       Continue 
      EndIf 
      
      
      If DirectoryEntryType(z) = #PB_DirectoryEntry_Directory 
        x(Directory$+EntryName) ; Процедура вызывает саму себя
      EndIf 
      
      Debug Directory$+"    "+DirectoryEntryName(z) 
    Wend 
    FinishDirectory(z) 
  EndIf 
EndProcedure 

x("C:\")

0

3

спасибо буду разбираться...

0

4

У меня такой код получился:

Код:
Enumeration 
 #Window_0
 #String     
 #but
 #file
 #Web
 #but_web1
 #but_web2
 #but_web3
 #Directory  
EndEnumeration


Procedure POISK(FileName.s)
 If ReadFile(#file, FileName.s)
   While Eof(#file) = 0
    string$ = string$ + ReadString(#file) 
   Wend 
    If  FindString(string$, GetGadgetText(#String), 0) 
     Debug FileName.s
     SetGadgetText(#Web, FileName.s) 
    EndIf
 EndIf  
EndProcedure 

  
Procedure Direct(Directory.s) 
If Right(Directory.s,1)<>"\":Directory.s + "\":EndIf 
   z=ExamineDirectory(#PB_Any, Directory.s, "*.*")  
  If z 
    While NextDirectoryEntry(z) 
     EntryName.s=DirectoryEntryName(z) 
  ;------------------------------------------
      If EntryName = "." Or EntryName = ".." 
       Continue 
      EndIf 
  ;------------------------------------------ 
      If DirectoryEntryType(z) = #PB_DirectoryEntry_Directory
        Direct(Directory.s+EntryName ) ; Процедура вызывает саму себя 
      EndIf 
  ;-------------------------------------------      
      FileName.s= Directory.s+""+DirectoryEntryName(z)
        If FileName.s <> "." And FileName.s <> ".."
          Ext$ = LCase(Right(FileName.s,4)) 
           If Ext$ = ".html" Or Ext$ = ".htm"
             POISK(FileName.s)  
             Debug FileName.s      
           EndIf
        EndIf
    Wend 
    FinishDirectory(z) 
  EndIf 
EndProcedure  
  

OpenWindow (#Window_0,0,0,870,600,"Поиск",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered) 
  StringGadget(#String, 15, 10, 250, 20, "667 255.0" )
  ButtonGadget(#but,280,10,70,20,"Поиск")
  WebGadget(#Web, 0, 40, 870, 560, "" )
  ButtonGadget(#but_web1,480,10,70,20,"<<<")
  ButtonGadget(#but_web2,580,10,70,20,">>>")
  ButtonGadget(#but_web3,555,10,20,20,"x") 

ProgPath.s=GetPathPart(ProgramFilename())
SetGadgetText(#Web, "file://localhost/"+ProgPath+"belts.htm") 


Repeat
Event =  WaitWindowEvent() 
Window = EventWindow() 
Gadget = EventGadget()
   Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
             Case #but
            Directory.s= GetPathPart(ProgramFilename())+"Catalog\"
              Direct(Directory.s)
             Case #but_web1
              SetGadgetState(#Web, #PB_Web_Back)
             Case #but_web2
              SetGadgetState(#Web, #PB_Web_Forward)
             Case #but_web3
              SetGadgetState(#Web, #PB_Web_Stop)  
          EndSelect
   EndSelect
If Event = #PB_Event_CloseWindow 
Break                            
EndIf
ForEver

Файлов очень много и время поиска до 10 секунд...
Работает хорошо, но пробовал организовать поток - не получилось ?
При вызаве самой себя получается ошибка?

0

5

mirashic написал(а):

Файлов очень много и время поиска до 10 секунд...

Так должно быть быстрее

Код:
Enumeration 
 #Window_0
 #String     
 #but
 #file
 #Web
 #but_web1
 #but_web2
 #but_web3
 #Directory  
EndEnumeration


Procedure POISK(FileName.s)
 If ReadFile(#file, FileName.s)
;    While Eof(#file) = 0    ; Очень медленный способ!
;     string$ = string$ + ReadString(#file) 
;    Wend 

    Size=Lof(#file)
    string$=Space(Size+2)
    ReadData(#file,@string$,Size)
    CloseFile(#file)

    If  FindString(string$, GetGadgetText(#String), 1) 
     Debug FileName.s
     SetGadgetText(#Web, FileName.s) 
    EndIf
 EndIf  
EndProcedure 

  
Procedure Direct(Directory.s) 
If Right(Directory.s,1)<>"\":Directory.s + "\":EndIf 
   z=ExamineDirectory(#PB_Any, Directory.s, "*.*")  
  If z 
    While NextDirectoryEntry(z) 
     EntryName.s=DirectoryEntryName(z) 
  ;------------------------------------------
      If EntryName = "." Or EntryName = ".." 
       Continue 
      EndIf 
  ;------------------------------------------ 
      Type=DirectoryEntryType(z)
      If Type = #PB_DirectoryEntry_Directory
        Direct(Directory.s+EntryName ) ; Процедура вызывает саму себя 
      ElseIf Type = #PB_DirectoryEntry_File
  ;-------------------------------------------      
      ;FileName.s= Directory.s+""+DirectoryEntryName(z)
      
      FileName.s= Directory.s+EntryName
        ;If FileName.s <> "." And FileName.s <> ".."  ; Выше уже проводилась эта проверка
          Ext$ = LCase(Right(FileName.s,4)) 
           If Ext$ = ".html" Or Ext$ = ".htm"
             POISK(FileName.s)  
             Debug FileName.s      
           EndIf
        ;EndIf
      EndIf 
    Wend 
    FinishDirectory(z) 
  EndIf 
EndProcedure  
  

OpenWindow (#Window_0,0,0,870,600,"Поиск",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered) 
  StringGadget(#String, 15, 10, 250, 20, "667 255.0" )
  ButtonGadget(#but,280,10,70,20,"Поиск")
  WebGadget(#Web, 0, 40, 870, 560, "" )
  ButtonGadget(#but_web1,480,10,70,20,"<<<")
  ButtonGadget(#but_web2,580,10,70,20,">>>")
  ButtonGadget(#but_web3,555,10,20,20,"x") 

ProgPath.s=GetPathPart(ProgramFilename())
SetGadgetText(#Web, "file://localhost/"+ProgPath+"belts.htm") 


Repeat
Event =  WaitWindowEvent() 
Window = EventWindow() 
Gadget = EventGadget()
   Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
             Case #but
            Directory.s= GetPathPart(ProgramFilename())+"Catalog\"
              Direct(Directory.s)
             Case #but_web1
              SetGadgetState(#Web, #PB_Web_Back)
             Case #but_web2
              SetGadgetState(#Web, #PB_Web_Forward)
             Case #but_web3
              SetGadgetState(#Web, #PB_Web_Stop)  
          EndSelect
   EndSelect
If Event = #PB_Event_CloseWindow 
Break                            
EndIf
ForEver
mirashic написал(а):

Работает хорошо, но пробовал организовать поток - не получилось ?
При вызаве самой себя получается ошибка?

Как организовывал поток?

0

6

что то так:

Код:
Enumeration 
 #Window_0
 #String     
 #but
 #file
 #Web
 #but_web1
 #but_web2
 #but_web3
 #Directory  
EndEnumeration


Procedure POISK(FileName.s)
 If ReadFile(#file, FileName.s)
   While Eof(#file) = 0
    string$ = string$ + ReadString(#file) 
   Wend 
    If  FindString(string$, GetGadgetText(#String), 0) 
     ;Debug FileName.s
     SetGadgetText(#Web, FileName.s) 
    EndIf
 EndIf  
EndProcedure 

  
Procedure Direct(*Directory.s) 
If Right(Directory.s,1)<>"\":*Directory.s + "\":EndIf 
   z=ExamineDirectory(#PB_Any, *Directory.s, "*.*")  
  If z 
    While NextDirectoryEntry(z) 
     EntryName.s=DirectoryEntryName(z) 
  ;------------------------------------------
      If EntryName = "." Or EntryName = ".." 
       Continue 
      EndIf 
  ;------------------------------------------ 
      If DirectoryEntryType(z) = #PB_DirectoryEntry_Directory
       Directory.s=  Directory.s+EntryName 
        ;??????????????      
        CreateThread(@Direct(), @Directory.s)
        ;?????????????? 
      EndIf 
  ;-------------------------------------------      
      FileName.s= *Directory.s+""+DirectoryEntryName(z)
        If FileName.s <> "." And FileName.s <> ".."
          Ext$ = LCase(Right(FileName.s,4)) 
           If Ext$ = ".html" Or Ext$ = ".htm"
             POISK(FileName.s)  
             Debug FileName.s      
           EndIf
        EndIf
    Wend 
    FinishDirectory(z) 
  EndIf 
EndProcedure  
  

OpenWindow (#Window_0,0,0,870,600,"Поиск",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered) 
  StringGadget(#String, 15, 10, 250, 20, "667 255.0" )
  ButtonGadget(#but,280,10,70,20,"Поиск")
  WebGadget(#Web, 0, 40, 870, 560, "" )
  ButtonGadget(#but_web1,480,10,70,20,"<<<")
  ButtonGadget(#but_web2,580,10,70,20,">>>")
  ButtonGadget(#but_web3,555,10,20,20,"x") 

ProgPath.s=GetPathPart(ProgramFilename())
SetGadgetText(#Web, "file://localhost/"+ProgPath+"belts.htm") 


Repeat
Event =  WaitWindowEvent() 
Window = EventWindow() 
Gadget = EventGadget()
   Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
             Case #but
            Directory.s= GetPathPart(ProgramFilename())+"Catalog\"
             If IsThread(ThreadID)=0          
              ThreadID=CreateThread(@Direct(), @Directory.s)
             EndIf           
             Case #but_web1
              SetGadgetState(#Web, #PB_Web_Back)
             Case #but_web2
              SetGadgetState(#Web, #PB_Web_Forward)
             Case #but_web3
              SetGadgetState(#Web, #PB_Web_Stop)  
          EndSelect
   EndSelect
If Event = #PB_Event_CloseWindow 
Break                            
EndIf
ForEver

0

7

Да, теперь быстро, можно и без потока...

Спасибо !

0

8

Как-то так надо

Код:
Enumeration 
 #Window_0
 #String     
 #but
 #file
 #Web
 #but_web1
 #but_web2
 #but_web3
 #Directory  
EndEnumeration


Procedure POISK(FileName.s)
 If ReadFile(#file, FileName.s)
   While Eof(#file) = 0
    string$ = string$ + ReadString(#file) 
   Wend 
    If  FindString(string$, GetGadgetText(#String), 0) 
     ;Debug FileName.s
     SetGadgetText(#Web, FileName.s) 
    EndIf
 EndIf  
EndProcedure 

  
Procedure Direct(Directory.s) 
If Right(Directory.s,1)<>"\":Directory.s + "\":EndIf 
   z=ExamineDirectory(#PB_Any,Directory.s, "*.*")  
  If z 
    While NextDirectoryEntry(z) 
     EntryName.s=DirectoryEntryName(z) 
  ;------------------------------------------
      If EntryName = "." Or EntryName = ".." 
       Continue 
      EndIf 
  ;------------------------------------------ 
      If DirectoryEntryType(z) = #PB_DirectoryEntry_Directory
       Directory.s=  Directory.s+EntryName 
        ;??????????????      
       Direct(Directory.s+EntryName ) ; Процедура вызывает саму себя 
        ;?????????????? 
      EndIf 
  ;-------------------------------------------      
      FileName.s= Directory.s+""+DirectoryEntryName(z)
        If FileName.s <> "." And FileName.s <> ".."
          Ext$ = LCase(Right(FileName.s,4)) 
           If Ext$ = ".html" Or Ext$ = ".htm"
             POISK(FileName.s)  
             Debug FileName.s      
           EndIf
        EndIf
    Wend 
    FinishDirectory(z) 
  EndIf 
EndProcedure  

Procedure Thread(*Dir)
  Direct(PeekS(*Dir))
EndProcedure
  

OpenWindow (#Window_0,0,0,870,600,"Поиск",#PB_Window_MinimizeGadget|#PB_Window_ScreenCentered) 
  StringGadget(#String, 15, 10, 250, 20, "667 255.0" )
  ButtonGadget(#but,280,10,70,20,"Поиск")
  WebGadget(#Web, 0, 40, 870, 560, "" )
  ButtonGadget(#but_web1,480,10,70,20,"<<<")
  ButtonGadget(#but_web2,580,10,70,20,">>>")
  ButtonGadget(#but_web3,555,10,20,20,"x") 

ProgPath.s=GetPathPart(ProgramFilename())
SetGadgetText(#Web, "file://localhost/"+ProgPath+"belts.htm") 


Repeat
Event =  WaitWindowEvent() 
Window = EventWindow() 
Gadget = EventGadget()
   Select Event
        Case #PB_Event_Gadget
          Select EventGadget()
             Case #but
            Directory.s= GetPathPart(ProgramFilename())+"Catalog\"
             If IsThread(ThreadID)=0          
              ThreadID=CreateThread(@Thread(), @Directory.s)
             EndIf           
             Case #but_web1
              SetGadgetState(#Web, #PB_Web_Back)
             Case #but_web2
              SetGadgetState(#Web, #PB_Web_Forward)
             Case #but_web3
              SetGadgetState(#Web, #PB_Web_Stop)  
          EndSelect
   EndSelect
If Event = #PB_Event_CloseWindow 
Break                            
EndIf
ForEver

0

9

Я так пробовал, не работает, но не страшно, сейчас поиск мгновенный и можно обойтись без потока...

0

Похожие темы


Вы здесь » PureBasic - форум » Вопросы по PureBasic » поиск в директории