Platforms to show: All Mac Windows Linux Cross-Platform
/DynaPDF/Wiki to PDF/Wiki to PDF
Function:
Required plugins for this example: MBS MacControls Plugin, MBS MacOSX Plugin, MBS DynaPDF Plugin, MBS DataTypes Plugin, MBS Picture Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /DynaPDF/Wiki to PDF/Wiki to PDF
This example is the version from Tue, 6th Mar 2017.
Function:
Required plugins for this example: MBS MacControls Plugin, MBS MacOSX Plugin, MBS DynaPDF Plugin, MBS DataTypes Plugin, MBS Picture Plugin
You find this example project in your Plugins Download as a Xojo project file within the examples folder: /DynaPDF/Wiki to PDF/Wiki to PDF
This example is the version from Tue, 6th Mar 2017.
Project "Wiki to PDF.xojo_binary_project"
Class App Inherits Application
Const kEditClear = "&Delete"
Const kFileQuit = "&Quit"
Const kFileQuitShortcut = ""
EventHandler Sub Open()
' register MBS Plugins here
if TargetMachO then
// ok
else
MsgBox "Please run on a Mac."
quit
end if
End EventHandler
End Class
Class Window1 Inherits Window
Control web Inherits HTMLViewer
ControlInstance web Inherits HTMLViewer
EventHandler Sub DocumentComplete(URL as String)
// if the page is all white, we had an error and try again
dim p as Picture = self.ScreenshotWindowRectMBS(me.left, me.top, me.Width, me.Height)
if p<>nil then
dim c as integer = p.CountColorMBS(&cFFFFFF)
System.DebugLog "CountColorMBS: "+str(c)
if c > p.Width*p.Height*0.95 then
mode = 6
Return
end if
else
System.DebugLog "Picture is nil."
end if
if mode = 1 then // everything okay
mode = 2
end if
End EventHandler
End Control
Control Timer1 Inherits Timer
ControlInstance Timer1 Inherits Timer
EventHandler Sub Action()
Select case mode
case 0
// next run?
if CheckBox1.Value then
me.Mode = 0
quit
end if
if URLsTodo.Count = 0 then
me.Mode = 0
beep
MsgBox "Done."
Return
end if
// download next page
mode = 1
dim it as StringHashSetIteratorMBS = URLsTodo.first
currentURL = it.Key
URLsTodo.Remove it
System.DebugLog currentURL
web.LoadURL currentURL
case 1
// waiting
case 2
// write URL file and PDF file
CurrentFile = GetFileForURL(currentURL)
WriteURL currentURL
call web.PrintToPDFFileMBS(CurrentFile)
URLsDone.insert currentURL
mode = 3
case 3
// process PDF file
LoadURLs CurrentFile
mode = 0
case 6
// this is for the case the web page was blank and we try again
mode = 1
web.LoadURL currentURL
end Select
End EventHandler
End Control
Control CheckBox1 Inherits CheckBox
ControlInstance CheckBox1 Inherits CheckBox
End Control
Control StaticText1 Inherits Label
ControlInstance StaticText1 Inherits Label
End Control
EventHandler Sub Open()
System.DebugLog "Start..."
URLsTodo = new StringHashSetMBS
URLsDone = new StringHashSetMBS
// read redirects
System.DebugLog "Read Redirects..."
ReadRedirects
LoadRedirects
// make webpages smaller
web.setPageSizeMultiplierMBS 0.7
// start here always
System.DebugLog "AddURL..."
AddURL "http://docs.realsoftware.com/index.php/Main_Page"
// load processed urls from existing PDF files
// so you can quit this app and continue later
// 1. URLs we already downloaded
dim folder as FolderItem = SpecialFolder.Desktop.Child("pdf files")
folder.CreateAsFolder
System.DebugLog "Read URLs..."
dim c as integer = folder.Count
for i as integer = 1 to c
dim file as FolderItem = folder.TrueItem(i)
if file<>Nil then
if Right(file.Name,4)=".txt" then
dim t as TextInputStream = file.OpenAsTextFile
if t<>Nil then
dim url as string = t.ReadLine(encodings.UTF8)
URLsDone.insert url
end if
end if
end if
next
System.DebugLog "Read URLs from PDF files..."
// than find URLs we need to download
for i as integer = 1 to c
dim file as FolderItem = folder.TrueItem(i)
if file<>Nil then
if Right(file.Name,4)=".pdf" then
LoadURLs file
end if
end if
next
WriteURLsDone
WriteURLsTodo
System.DebugLog "Loading websites..."
timer1.Mode=2
End EventHandler
Sub AddURL(s as string)
s = NthField(S,"#",1) // remove right part of URLs
// must be part of wiki
const k1 = "http://docs.realsoftware.com/index.php/"
if left(s,len(k1))<>k1 then
Return
end if
// no file pages
const k2 = "http://docs.realsoftware.com/index.php/File:"
if left(s, len(k2)) = k2 then
Return
end if
// no user pages
const k3 = "http://docs.realsoftware.com/index.php/User:"
if left(s, len(k3)) = k3 then
Return
end if
// no help pages
const k6 = "http://docs.realsoftware.com/index.php/Help:"
if left(s, len(k6)) = k6 then
Return
end if
// no template pages
const k4 = "http://docs.realsoftware.com/index.php/Template:"
if left(s, len(k4)) = k4 then
Return
end if
// no wiki help pages
const k5 = "http://docs.realsoftware.com/index.php/MediaWiki:"
if left(s, len(k5)) = k5 then
Return
end if
// if not already in one of the lists
if URLsDone.find(s).isEqual(URLsDone.last) then
if URLsTodo.find(s).isEqual(URLsTodo.last) then
// add it to todo list
URLsTodo.insert s
end if
end if
End Sub
Function GetFileForURL(url as string) As FolderItem
dim name as string = GetFileNameForURL(url) + ".pdf"
dim folder as FolderItem = SpecialFolder.Desktop.Child("pdf files")
dim file as FolderItem = folder.Child(name)
Return file
End Function
Function GetFileNameForURL(url as string) As string
dim name as string = url
if left(name,7)="http://" then
name = mid(name,8)
end if
name = ReplaceAll(name,"/", " ")
name = ReplaceAll(name,":", " ")
Return name
End Function
Sub LoadRedirects()
// Read duplicates list to avoid duplicates in PDFs
dim f as FolderItem = SpecialFolder.Desktop.Child("redirect")
dim t as TextInputStream = f.OpenAsTextFile
if t = nil then Return
dim tab as string = encodings.ASCII.Chr(9)
while not t.EOF
dim line as string = t.ReadLine(encodings.ASCII)
dim l as string = NthField(line, tab, 1)
dim r as string = NthField(line, tab, 2)
if len(r)>0 then
URLsDone.insert "http://docs.realsoftware.com/index.php/"+l
'addurl "http://docs.realsoftware.com/index.php/"+r
end if
wend
End Sub
Sub LoadURLs(file as FolderItem)
dim pdf as new MyDynapdfMBS
' pdf.SetLicenseKey "Lite" // Add your license key here
call pdf.CreateNewPDF nil
dim template1 as integer = pdf.OpenImportFile(file, 0, "")
call pdf.ImportPDFFile(1, 1.0, 1.0)
dim c as integer = pdf.GetAnnotCount
for i as integer = 0 to c-1
dim a as DynaPDFAnnotationExMBS = pdf.GetAnnotEx(i)
dim URL as string = a.DestFile
AddURL url
next
call pdf.CloseImportFile
call pdf.CloseFile
End Sub
Sub ReadRedirects()
// Read duplicates list to avoid duplicates in PDFs
dim f as FolderItem = SpecialFolder.Desktop.Child("redirect")
dim t as TextOutputStream = f.CreateTextFile
dim HTTPSocket as new HTTPSocket
dim s as string = HTTPSocket.get("http://docs.realsoftware.com/index.php?title=Special:ListRedirects&limit=999&offset=0", 30)
const k1 = "<ol start='1' class='special'>"
dim pos1 as integer = instr(s,k1)
const k2 = "</ol>"
dim pos2 as integer = instr(pos1, s,k2)
s = mid(s, pos1, pos2-pos1)
dim lines(-1) as string = split(s,"<li>")
for each line as string in lines
// <li><a href="/index.php?title=UsersGuide:Chapter14:Microsoft_Office_Automation&redirect=no" class="mw-redirect"
// title="UsersGuide:Chapter14:Microsoft Office Automation">UsersGuide:Chapter14:Microsoft Office Automation</a> →
// <a href="/index.php/UsersGuide:Chapter_14:Microsoft_Office_Automation"
// title="UsersGuide:Chapter 14:Microsoft Office Automation">UsersGuide:Chapter 14:Microsoft Office Automation</a></li>
const k3 = "href="""
const k4 = "&redirect=no"
const k5 = "href="""
const k6 = """"
dim p1 as integer = instr(line, k3)
dim p2 as integer = instr(p1+len(k3),line, k4)
dim p3 as integer = instr(p2+1,line, k5)
dim p4 as integer = instr(p3+len(k5),line, k6)
if p1>0 and p2>p1 and p3>p2 and p4>p3 then
dim s1 as string = mid(line, p1+len(k3), p2-p1-len(k3))
dim s2 as string = mid(line, p3+len(k5), p4-p3-len(k5))
const k7 = "/index.php?title="
const k8 = "/index.php/"
if left(s1,len(k7))=k7 then
s1 = mid(S1, len(k7)+1)
elseif left(s1,len(k8))=k8 then
s1 = mid(S1, len(k8)+1)
end if
if left(s2,len(k7))=k7 then
s2 = mid(S2, len(k7)+1)
elseif left(s2,len(k8))=k8 then
s2 = mid(S2, len(k8)+1)
end if
'redirectFrom.append s1
'redirectTo.append s2
t.WriteLine ConvertEncoding(s1+chr(9)+s2, encodings.UTF8)
'URLsDone.Append "http://docs.realsoftware.com/index.php/"+s1
end if
next
End Sub
Sub WriteURL(url as string)
dim name as string = GetFileNameForURL(url) + ".txt"
dim folder as FolderItem = SpecialFolder.Desktop.Child("pdf files")
folder.CreateAsFolder
dim file as FolderItem = folder.Child(name)
dim t as TextOutputStream = file.CreateTextFile
if t = nil then
t = file.CreateTextFile
end if
if t = nil then
MsgBox "If you come here, please quit app and restart again."
quit
else
t.Writeline ConvertEncoding(url,encodings.UTF8)
t.close
end if
End Sub
Sub WriteURLsDone()
// for debbuging...
dim f as FolderItem = SpecialFolder.Desktop.Child("URLs Done")
dim t as TextOutputStream = f.CreateTextFile
for each url as string in URLsDone.Keys
t.WriteLine url
next
End Sub
Sub WriteURLsTodo()
// for debbuging...
dim f as FolderItem = SpecialFolder.Desktop.Child("URLs Todo")
dim t as TextOutputStream = f.CreateTextFile
for each url as string in URLsTodo.Keys
t.WriteLine url
next
End Sub
Property CurrentFile As FolderItem
Property URLsDone As StringHashSetMBS
Property URLsTodo As StringHashSetMBS
Property count As Integer
Property currentURL As string
Property mode As Integer
End Class
MenuBar MenuBar1
MenuItem FileMenu = "&File"
MenuItem FileQuit = "#App.kFileQuit"
MenuItem EditMenu = "&Edit"
MenuItem EditUndo = "&Undo"
MenuItem UntitledMenu1 = "-"
MenuItem EditCut = "Cu&t"
MenuItem EditCopy = "&Copy"
MenuItem EditPaste = "&Paste"
MenuItem EditClear = "#App.kEditClear"
MenuItem UntitledMenu0 = "-"
MenuItem EditSelectAll = "Select &All"
End MenuBar
Class MyDynaPDFMBS Inherits DynaPDFMBS
EventHandler Function Error(ErrorCode as integer, ErrorMessage as string, ErrorType as integer) As integer
// output all messages on the console:
System.DebugLog str(ErrorCode)+": "+ErrorMessage
// and display dialog:
Dim d as New MessageDialog //declare the MessageDialog object
Dim b as MessageDialogButton //for handling the result
d.icon=MessageDialog.GraphicCaution //display warning icon
d.ActionButton.Caption="Continue"
d.CancelButton.Visible=True //show the Cancel button
// a warning or an error?
if BitAnd(ErrorType, me.kE_WARNING) = me.kE_WARNING then
// if user decided to ignore, we'll ignore
if IgnoreWarnings then Return 0
d.Message="A warning occurred while processing your PDF code."
// we add a third button to display all warnings
d.AlternateActionButton.Caption = "Ignore warnings"
d.AlternateActionButton.Visible = true
else
d.Message="An error occurred while processing your PDF code."
end if
d.Explanation = str(ErrorCode)+": "+ErrorMessage
b=d.ShowModal //display the dialog
Select Case b //determine which button was pressed.
Case d.ActionButton
Return 0 // ignore
Case d.AlternateActionButton
IgnoreWarnings = true
Return 0 // ignore
Case d.CancelButton
Return -1 // stop
End select
End EventHandler
Property IgnoreWarnings As Boolean
End Class
End Project
See also:
The items on this page are in the following plugins: MBS DynaPDF Plugin.
Feedback: Report problem or ask question.