Просмотров: 2105 | Дата: 29.03.2024 | Коментарии (0)

Поиск на форумах







Хорошая программа для поиска по форумах написанная kvitaliy:
Поисковик по всем форумам о PureBasic
Долгий период её пользуюсь.
Запрос отсылается на Google и производится поиск на форумах.
Но на английском, немецком и французском форумах, можно на прямую искать, исключив Google, тем более если страницы им ещё не проиндексированы.
И как правило, я ищу по одному ключевому слову.
Написал себе свой поиск.
Это не действует на русский форум, приходится запрос вбивать в ручную, или через Google. При клике переходим на страницу формирования запроса.
Кодировку в формат HTTP не делал и без неё вроде работает правильно.

Код получился в четыре десятков строк:

Enumeration
 #Window_0:#Frame3D:#String:#But:#ru:#en:#ge:#fr:#in
EndEnumeration

OpenWindow (#Window_0,0,0,380,160,"www.purebasic.info", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered )
 Frame3DGadget(#Frame3D,5,5,370,115, "Поиск на форумах")
 StringGadget(#String,15,30,350,20,"")
 ButtonGadget(#But,270,130,80,20,"Поиск")

 OptionGadget(#ru, 25, 130, 180, 15, "Перейти на русский форум") 
 OptionGadget(#en, 25, 65, 120, 15, "Английский форум"): SetGadgetState(#en,1)
 OptionGadget(#ge, 25, 85, 120, 15, "Немецкий форум")
 OptionGadget(#fr, 200,65, 130, 15, "Французский форум") 
 OptionGadget(#in, 200,85, 120, 15, "Google")

Repeat
Event = WaitWindowEvent() 
Gadget = EventGadget()
 Select Event
 Case #PB_Event_Gadget
 Select EventGadget()
 Case #But
 zapros.s= GetGadgetText(#String)
 If GetGadgetState(#ru) 
 RunProgram("http://purebasic.info/phpBB2/search.php")
 ElseIf GetGadgetState(#en) 
 RunProgram("http://www.purebasic.fr/english/search.php?keywords="+zapros+"&terms=Search")
 ElseIf GetGadgetState(#ge) 
 RunProgram("http://www.purebasic.fr/german/search.php?keywords="+zapros+"&terms=Search")
 ElseIf GetGadgetState(#fr) 
 RunProgram("http://www.purebasic.fr/french/search.php?keywords="+zapros+"&terms=Search")
 ElseIf GetGadgetState(#in)
 RunProgram("http://www.google.com.ua/search?hl=ru&source=hp&q="+zapros)
 EndIf
 EndSelect
 EndSelect
If Event = #PB_Event_CloseWindow
Break
EndIf
ForEver
;


Не много доработал код, добавил поиск по папке CodeArchiv на локальном компьютере.
В папку с EXE файлом поиска, помещаем всю папку CodeArchiv (имя CodeArchiv)
При двойном клике по списку - открывается редактор PureBasic с выбранным файлом.



Код реализации:

Enumeration
 #Window_0:#Frame3D:#String:#But:#ru:#en:#ge:#fr:#in:#ca:#List:#file
EndEnumeration

Procedure POISK(FileName.s)
 If ReadFile(#file, FileName.s)
 ;-------------------------------------
 Size=Lof(#file)
 string$=Space(Size+2)
 ReadData(#file,@string$,Size)
 CloseFile(#file)
 ;-------------------------------------
 If FindString(LCase(string$), LCase(GetGadgetText(#String)), 1) ; поиск бе зучёта регистра
 Name.s= RemoveString(FileName.s, GetPathPart(ProgramFilename()))
 AddGadgetItem(#List,-1, Name.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+EntryName
 Ext$ = LCase(Right(FileName.s,3))
 Ext4$ = LCase(Right(FileName.s,4))
 If Ext$ = ".pb" Or Ext4$ = ".pbi"
 POISK(FileName.s) 
 EndIf
 EndIf 
 Wend 
 FinishDirectory(z) 
 EndIf 
EndProcedure

OpenWindow (#Window_0,0,0,380,180,"www.purebasic.info", #PB_Window_MinimizeGadget|#PB_Window_ScreenCentered )
 Frame3DGadget(#Frame3D,5,5,370,135, "Поиск на форумах")
 StringGadget(#String,15,30,350,20,"CreateRegularExpression")
 ButtonGadget(#But,280,150,80,20,"Поиск")
 ListIconGadget(#List,5,185,370,310,"",500,#LVS_NOCOLUMNHEADER)

 OptionGadget(#en, 25, 65, 120, 15, "Английский форум"): SetGadgetState(#en,1)
 OptionGadget(#ge, 25, 85, 120, 15, "Немецкий форум")
 OptionGadget(#ru, 25, 105, 170, 15, "Перейти на русский форум") 
 OptionGadget(#fr, 200,65, 130, 15, "Французский форум") 
 OptionGadget(#in, 200,85, 120, 15, "Google")
 OptionGadget(#ca, 200,105, 120, 15, "Code Archiv") 
Repeat
Event = WaitWindowEvent() 
Gadget = EventGadget()
 Select Event
 Case #PB_Event_Gadget
 Select EventGadget()
 Case #List
 If EventType()= #PB_EventType_LeftDoubleClick
 nom = GetGadgetState(#List)
 name.s=GetGadgetItemText(#List,nom)
 RunProgram(GetPathPart(ProgramFilename())+name)
 EndIf
 Case #But
 zapros.s= GetGadgetText(#String)
 If GetGadgetState(#ru) 
 RunProgram("http://purebasic.info/phpBB2/search.php")
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,#PB_Ignore,180)
 ElseIf GetGadgetState(#en) 
 RunProgram("http://www.purebasic.fr/english/search.php?keywords="+zapros+"&terms=Search")
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,#PB_Ignore,180)
 ElseIf GetGadgetState(#ge) 
 RunProgram("http://www.purebasic.fr/german/search.php?keywords="+zapros+"&terms=Search")
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,#PB_Ignore,180)
 ElseIf GetGadgetState(#fr) 
 RunProgram("http://www.purebasic.fr/french/search.php?keywords="+zapros+"&terms=Search")
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,#PB_Ignore,180)
 ElseIf GetGadgetState(#in)
 RunProgram("http://www.google.com.ua/search?hl=ru&source=hp&q="+zapros)
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,#PB_Ignore,180)
 ElseIf GetGadgetState(#ca)
 Directory.s= GetPathPart(ProgramFilename())+"CodeArchiv\" 
 ClearGadgetItems(#List)
 Direct(Directory)
 ResizeWindow(#Window_0,#PB_Ignore,#PB_Ignore,#PB_Ignore,500)
 EndIf 
 EndSelect
 EndSelect
If Event = #PB_Event_CloseWindow
Break 
EndIf
ForEver
;












Сайт посвящён языку программирования PureBasic — коммерческий компилятор языка программирования, использующего синтаксис BASIC. Предназначен для создания кроссплатформенных приложений для AmigaOS, Linux, Microsoft Windows, Windows NT и Mac OS X. Разработан компанией Fantaisie Software.