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.xojo_binary_project"
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:
The items on this page are in the following plugins: MBS Main Plugin.
