Xojo Conferences

Platforms to show: All Mac Windows Linux Cross-Platform

/Main/MBS Help Search/MBS Help Search
Required plugins for this example: MBS Util Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /Main/MBS Help Search/MBS Help Search
This example is the version from Thu, 6th Apr 2016.
Project "MBS Help Search.rbp"
Class MainWindow Inherits Window
Control iSearch Inherits TextField
ControlInstance iSearch Inherits TextField
EventHandler Sub TextChange() SearchButton.Enabled=me.text<>"" End EventHandler
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
Control SearchButton Inherits PushButton
ControlInstance SearchButton Inherits PushButton
EventHandler Sub Action() dim j,n,i,c,cc,m,k,b as integer dim f as file dim a(0) as string dim s as string s=iSearch.text cc=CountFields(s," ")-1 redim a(cc) for i=0 to cc a(i)=NthField(s," ",i+1) next ListBox1.DeleteAllRows c=UBound(w.files) for n=1 to c f=w.files(n) s=f.text if s<>"" then m=0 b=0 for j=0 to cc k=CountFields(s,a(j)) if k>1 then b=b+1 end if m=m+k-1 next if b>cc then ListBox1.AddRow f.titel s=str(m) while len(s)<5 s=" "+s wend ListBox1.cell(ListBox1.LastIndex,1)=s ListBox1.Cell(ListBox1.LastIndex,2)=str(n) end if end if NextLoop: next ListBox1.SortedColumn=1 ListBox1.ColumnSortDirection(1)=2 ListBox1.Sort End EventHandler
End Control
Control ListBox1 Inherits Listbox
ControlInstance ListBox1 Inherits Listbox
EventHandler Sub Change() dim id as integer if me.ListIndex<>-1 then id=val(ListBox1.Cell(ListBox1.ListIndex,2)) if id>0 then w.files(id).file.launch end if end if End EventHandler
EventHandler Sub DoubleClick() dim id as integer id=val(ListBox1.Cell(ListBox1.ListIndex,2)) if id>0 then w.files(id).file.launch end if End EventHandler
EventHandler Sub Open() ListBox1.ColumnAlignment(1)=3 End EventHandler
End Control
Control ProgressMessage Inherits Label
ControlInstance ProgressMessage Inherits Label
End Control
Control ProgressDisplay Inherits ProgressBar
ControlInstance ProgressDisplay Inherits ProgressBar
End Control
EventHandler Sub Open() w=new Workthread w.run End EventHandler
Property w As workthread
End Class
MenuBar Menu
MenuItem UntitledMenu3 = ""
MenuItem UntitledMenu2 = "File"
MenuItem FileQuit = "Quit"
MenuItem UntitledMenu0 = "Edit"
MenuItem EditUndo = "Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cut"
MenuItem EditCopy = "Copy"
MenuItem EditPaste = "Paste"
MenuItem EditClear = "Clear"
End MenuBar
Class Workthread Inherits Thread
EventHandler Sub Run() MainWindow.ProgressDisplay.Maximum=0 MainWindow.ProgressDisplay.Value=0 MainWindow.ProgressMessage.text="Reading directory..." ReadDirectory MainWindow.ProgressDisplay.Maximum=UBound(files) MainWindow.ProgressDisplay.Value=0 MainWindow.ProgressMessage.text="Reading files..." ReadFiles MainWindow.ProgressMessage.text="Loaded "+str(ubound(files))+" files..." End EventHandler
Function FindFile(name as string) As FolderItem // Look for file in parent folders from executable on dim parent as FolderItem = app.ExecutableFile.Parent while parent<>Nil dim file as FolderItem = parent.Child(name) if file<>Nil and file.Exists then Return file end if parent = parent.Parent wend End Function
Sub ReadDirectory() dim dir as FolderItem dim file as FolderItem dim f as file dim i,c as integer dir=FindFile("HTML files") dir=dir.Child("files") c=dir.Count for i=1 to c file=dir.item(i) if file<>nil and Right(file.name,5)=".html" then f=new file f.file=file files.Append f end if next Exception End Sub
Sub ReadFiles() dim p as ProgressBar dim i,c,n as integer dim f as file p=MainWindow.ProgressDisplay c=UBound(files) n=1 for i=c downto 1 f=files(i) p.Value=n f.process n=n+1 next p.Value=n Exception End Sub
Property files(0) As file
End Class
Class File
Function FindTitel(s as string) As string dim p1,p2 as integer dim p,l as integer dim t as string const titlestart="<TITLE>" const titleend="</TITLE>" const mbs="Monkeybread Realbasic plugin - " p1=instr(s,titlestart) p2=instr(s,titleend) l=p2-p1-len(mbs)-len(titlestart) p=p1+len(titlestart)+len(mbs) t=mid(s,p,l) Return t End Function
Function HasIndex() As Boolean dim f as FolderItem dim dir as FolderItem dim t as TextInputStream dir=HelpIndexFolder if dir<>Nil and dir.Exists then f=dir.Child(file.Name) if f<>nil and f.Exists then if f.ModificationDate.TotalSeconds>=file.ModificationDate.TotalSeconds then t=f.OpenAsTextFile titel=t.ReadLine(Encodings.UTF8) text=t.ReadAll(Encodings.utf8) if text<>"" then Return true end if end if end if end if Exception End Function
Protected Function HelpIndexFolder() As folderitem dim f as folderitem f=CreateCachedDataFolderMBS(-32763) if f=nil then f=CreateApplicationSupportFolderMBS(-32763) end if if f=nil then // Last way for Windows/Linux f=SpecialFolder.ApplicationData end if f=f.Child("MBS Help Search") f.CreateAsFolder Return f End Function
Function RemoveLinks(s as string) As String dim p as integer p=instr(s,"<!-- Ende Content-->") if p>0 then s=left(s,p-1) end if const start="<!-- Start Content -->" p=instr(s,start) if p>0 then s=mid(s,p+len(start)) end if Return s End Function
Sub WriteIndex() dim f as FolderItem dim dir as FolderItem dim t as TextOutputStream dir=HelpIndexFolder f=dir.Child(file.Name) t=f.CreateTextFile t.WriteLine titel.ConvertEncoding(Encodings.UTF8) t.Write text.ConvertEncoding(Encodings.UTF8) t.Close End Sub
Function name() As string Return file.Name Exception End Function
Sub process() dim b as BinaryStream dim s as string if not hasindex then b=file.OpenAsBinaryFile(false) s=b.Read(b.Length, Encodings.ASCII) if s<>"" then titel=FindTitel(s) s=RemoveLinks(s) s=RemoveHTMLTagsMBS(s) s=DecodingFromHTMLMBS(s) s=ConvertEncoding(s,Encodings.UTF8) s=Shorten(s) if s<>"" then text=s WriteIndex end if end if end if End Sub
Property file As folderitem
Property text As string
Property titel As string
End Class
Class App Inherits Application
EventHandler Sub Open() // You should add your own registration here, if you want. // As only for indexing a registration is needed, you don't need it later for lookup End EventHandler
End Class
Module Util
Function Shorten(s as string) As string s=ReplaceAll(s,Encodings.UTF8.chr(13)," ") s=ReplaceAll(s,Encodings.UTF8.chr(10)," ") s=ReplaceAll(s,Encodings.UTF8.chr(9)," ") s=ReplaceAll(s,Encodings.UTF8.chr(160)," ") Return s End Function
End Module
End Project

See also:

Feedback, Comments & Corrections

The items on this page are in the following plugins: MBS Main Plugin.

MBS Xojo Plugins