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.
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&amp;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 = "&amp;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.

The biggest plugin in space...