PDF Manipulation and Creation

PDFHelper for converting images

Imports System.IO
Imports PdfSharp.Drawing
Imports PdfSharp.Pdf

Public Class PdfHelper
    'https://stackoverflow.com/questions/36052918/c-sharp-how-to-convert-an-image-to-a-pdf-using-a-free-library
    'Public Static PdfHelper Instance { Get; } = New PdfHelper();

    Public Shared Sub SaveImageAsPdf(imageFileName As String, pdfFileName As String, Optional width As Integer = 600, Optional deleteImage As Boolean = False)
        Dim document As New PdfDocument

        Dim page As PdfPage = document.AddPage()
        page = document.Pages(0)
        Dim img As XImage = XImage.FromFile(imageFileName)

        '// Calculate New height to keep image ratio
        Dim height = (width / img.PixelWidth) * img.PixelHeight

        '// Change PDF Page size to match image
        page.Width = width
        page.Height = height

        Dim gfx As XGraphics = XGraphics.FromPdfPage(page)
        gfx.DrawImage(img, 0, 0, width, height)

        document.Save(pdfFileName)

        If (deleteImage) Then File.Delete(imageFileName)
    End Sub
End Class

CreatePDF


    Sub CreatePDF(text As String, sFileName As String)
        Dim encodingMetaTag As String = "" '"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />";
        Dim htmlCode As String = text '"text <div> <b> bold </ b> or <u> underlined </ u> <div/>"

        Dim SR As StringReader = New StringReader(encodingMetaTag + htmlCode)
        Dim pdf = HtmlRenderer.PdfSharp.PdfGenerator.GeneratePdf(text, PdfSharp.PageSize.Letter)
        pdf.Save(sFileName)
        pdf.Close()

        'Dim pdfDoc = New Document(PageSize.A4, 10.0F, 10.0F, 10.0F, 0F);
        'var = New HTMLWorker htmlparser (pdfDoc);
        'PdfWriter.GetInstance(pdfDoc, HttpContext.Current.Response.OutputStream);
        'pdfDoc.Open();
        'htmlparser.Parse(SR);
        'pdfDoc.Close();
    End Sub

CreatePDF if there are errors in the Library


    Sub CreatePDF(text As String, sFileName As String)
        Dim encodingMetaTag As String = "" '"<meta http-equiv=\"Content-Type\" content=\"text/html; charset=utf-8\" />";
        Dim htmlCode As String = text '"text <div> <b> bold </ b> or <u> underlined </ u> <div/>"

        'Dim SR As StringReader = New StringReader(encodingMetaTag + htmlCode)
        'Dim pdf = HtmlRenderer.PdfSharp.PdfGenerator.GeneratePdf(text, PdfSharp.PageSize.Legal)
        'Dim pdf = HtmlRenderer.PdfSharp.PdfGenerator.GeneratePdf(text, PdfSharp.PageSize.Letter)

        Dim doc1 As PdfDocument = New PdfDocument
        Dim page As New PdfPage
        Dim rec As New PdfRectangle
        'page.AddWebLink(rec, "https://lemmermann.tech")
        doc1.AddPage(page)

        doc1.Save(sFileName)
        doc1.Close()

        'Dim pdfDoc = New Document(PageSize.A4, 10.0F, 10.0F, 10.0F, 0F);
        'var = New HTMLWorker htmlparser (pdfDoc);
        'PdfWriter.GetInstance(pdfDoc, HttpContext.Current.Response.OutputStream);
        'pdfDoc.Open();
        'htmlparser.Parse(SR);
        'pdfDoc.Close();
    End Sub
 

Add PDF to an existing PDF


    Function AddPDFtoExistingPDF(sSource As String, sFileToAdd As String) As Boolean
        Dim doc1 As PdfDocument = PdfReader.Open(sSource, PdfDocumentOpenMode.Import)
        Dim doc2 As PdfDocument
        'Dim page As PdfPage = doc1.Pages(0)
        If Not File.Exists(sFileToAdd) Then
            doc2 = doc1
        Else
            doc2 = PdfReader.Open(sFileToAdd, PdfDocumentOpenMode.Modify)
            For i As Integer = 0 To doc1.Pages.Count - 1
                Dim page As PdfPage = doc1.Pages(i)
                doc2.AddPage(page)
            Next

        End If
        'Try
        doc2.Save(sFileToAdd)

        'doc2.Close()
        'doc1.Close()
        '     Return True
        ' Catch ex As Exception
        ' End Try
    End Function

Delete a page


    Function funDeletePage(sSource As String, iPage As Integer) As Boolean
        Dim doc1 As PdfDocument = PdfReader.Open(sSource, PdfDocumentOpenMode.Modify)
        Try
            doc1.Pages.RemoveAt(iPage)
            'Try
            doc1.Save(sSource)
            return true
        Catch ex As Exception
            MsgBox("Error:  Cannot Delete Page: " & vbCrLf & ex.Message)
            return false
        End Try
    End Function

Delete Pages (ranges, and indviduals) Example


                ElseIf Left(args(x), 8) = "/delete:" Then
                    sDeleteRange = Right(args(x), Len(args(x)) - Len("/delete:"))
                    Dim oListToDelete As New List(Of String)
                    For Each sInd As String In Split(sDeleteRange & ",", ",")
                        If sInd.Length > 0 Then
                            'If InStr(sInd, "-") > 0 Then
                            oListToDelete.Add(sInd)

                            'End If
                        End If
                    Next

                    oListToDelete.Sort()
                    oListToDelete.Reverse()

                    If oListToDelete.Count > 0 Then
                        For Each sList As String In oListToDelete
                            If InStr(sList, "-") > 0 Then
                                Dim oOrder As New List(Of String)

                                For ICounter As Integer = Convert.ToInt32(Split(sList, "-")(1)) - 1 To Convert.ToInt32(Split(sList, "-")(0)) - 1 Step -1
                                    Console.Write(" " & ICounter)
                                    funDeletePage(oListOfFile(0), ICounter)
                                Next
                                Console.WriteLine()
                            Else
                                Console.WriteLine(Convert.ToInt32(sList) - 1)
                                funDeletePage(oListOfFile(0), Convert.ToInt32(sList) - 1)
                            End If
                        Next
                    End If
                Else
 

ConvertMSG

    Function ConvertMSG(sAttachFileName As String) As String
        Dim iRet As String = ""

        Try
            Dim RDOSession As New RDOSession
            Dim msg As RDOMail
            Try
                msg = RDOSession.GetMessageFromMsgFile(sAttachFileName)
                msg.SaveAs(sAttachFileName & ".html", rdoSaveAsType.olHTML)
                'WriteFile("ConvertMSG: " & sAttachFileName & ".html", sFile, bDebug)
                'CreatePDF(File.ReadAllText(sAttachFileName & ".html"), sAttachFileName & ".pdf")
                iRet = funConvertDOCX(sAttachFileName & ".html")
                'sAttachFileName = sAttachFileName & ".pdf"
            Catch ex As Exception
                MsgBox("Error:  Cannot Convert ConvertMSG Page: " & vbCrLf & ex.Message)
                bError = True
            End Try
        Catch ex2 As Exception
            bError = True
            MsgBox("Error:  Cannot Convert ConvertMSG Page (ex2): " & vbCrLf & ex2.Message)
        End Try
        Return iRet
    End Function

Convert DOC/x

    Function funConvertDOCX(sSource As String) As String
        Try
            Dim word As Application = New Application()
            Dim doc As Document = word.Documents.Open(sSource)
            doc.Activate()
            doc.SaveAs2(sSource & ".pdf", WdSaveFormat.wdFormatPDF)
            doc.Close()
            Return sSource & ".pdf"
        Catch ex As Exception
            MsgBox("Error:  Cannot Convert DOCX Page: " & vbCrLf & ex.Message)
            bError = True

        End Try


        Return ""

    End Function

Convert XLS/x

    Function funConvertExcel(sSource As String) As String
        Dim oApplication As ApplicationClass = New ApplicationClass
        Dim sOut As String = sSource & ".pdf"

        Dim oWorkbook As Workbook = Nothing
        Dim PDFFile As String = sOut
        Dim pFormatType As XlFixedFormatType = XlFixedFormatType.xlTypePDF
        Dim pQuality As XlFixedFormatQuality = XlFixedFormatQuality.xlQualityMinimum
        Dim pIncludeDocProperties As Boolean = True
        Dim pIgnorePrintAreas As Boolean = True
        Dim pFrom As Object = Type.Missing
        Dim pTo As Object = Type.Missing
        Dim pOpenAfterPublish As Boolean = False

        Try
            oWorkbook = oApplication.Workbooks.Open(sSource)
            Dim oWorksheet As Excel.Worksheet
            oWorksheet = oApplication.Worksheets(1)
            oWorksheet.PageSetup.FitToPagesWide = 1
            oWorksheet.PageSetup.FitToPagesTall = 1
            oWorksheet.PageSetup.Zoom = False
            If Not oWorkbook Is Nothing Then
                oWorkbook.ExportAsFixedFormat(pFormatType, PDFFile, pQuality,
                                              pIncludeDocProperties,
                                              pIgnorePrintAreas,
                                              pFrom, pTo, pOpenAfterPublish)
            End If
        Catch ex As Exception
            MsgBox("Error:  Cannot Convert XLSX Page: " & vbCrLf & ex.Message)
            bError = True

        End Try


        If Not oWorkbook Is Nothing Then
            oWorkbook.Close(False)
            oWorkbook = Nothing
        End If

        If Not oApplication Is Nothing Then
            oApplication.Quit()
            oApplication = Nothing
        End If

        GC.Collect()
        GC.WaitForPendingFinalizers()
        Return sOut

        'Dts.TaskResult = ScriptResults.Success
    End Function

Get All Pages of an Image

    'https://stackoverflow.com/questions/401561/how-to-open-a-multi-frame-tiff-imageformat-image-in-net-2-0
    Function GetAllPages(file As String) As List(Of Image)
        Dim bitmap As Bitmap


        Dim images As List(Of Image) = New List(Of Image)
        Try
            bitmap = Image.FromFile(file)
            Dim count As Integer = bitmap.GetFrameCount(FrameDimension.Page)
            For idx As Integer = 0 To count - 1
                'For (Int() idx = 0; idx <count; idx++)
                SetToolStripText(ToolStripStatusLabel1, "Image: " & idx)
                '// save each frame to a bytestream
                bitmap.SelectActiveFrame(FrameDimension.Page, idx)
                Dim byteStream As MemoryStream = New MemoryStream()
                bitmap.Save(byteStream, ImageFormat.Jpeg)

                ''// And then create a New Image from it
                SetToolStripText(ToolStripStatusLabel1, "Adding Image")
                images.Add(Image.FromStream(byteStream))
            Next
        Catch ex As Exception
            bitmap = Image.FromFile(file)
            images.Add(bitmap)

        End Try

        SetToolStripText(ToolStripStatusLabel1, "Returning images # " & images.Count)
        Return images
    End Function

Process Binder   

        Function ProcessBinder(lvItem As ListViewItem, lstOfTiffs As List(Of String)) As String
        Dim lstForBinder As List(Of String) = New List(Of String)

        Dim iTiffCount As Integer = 0

        For Each sfile In lstOfTiffs
            Dim sProcessFilename As String = ribWorkFolder.TextBoxText & "\" & Path.GetFileName(sfile)
            If File.Exists(sProcessFilename) Then
                SetToolStripText(ToolStripStatusLabel1, "File already exists: " & sProcessFilename)
            Else
                My.Computer.FileSystem.CopyFile(sfile, sProcessFilename)
                SetToolStripText(ToolStripStatusLabel1, "File copied to: " & sProcessFilename)

            End If

            Dim iCount As Integer = 0


            For Each bmp As Bitmap In GetAllPages(sProcessFilename)
                SetToolStripText(ToolStripStatusLabel1, sProcessFilename & "_" & iCount & ".jpg")
                Dim sFileNew = sProcessFilename & "_0" & iCount & ".jpg"
                bmp.Save(sFileNew, ImageFormat.Jpeg)
                Dim s_document As PdfDocument = New PdfDocument()
                Threading.Thread.Sleep(1500)
                Dim page As PdfPage = s_document.AddPage()

                Dim gfx As XGraphics = XGraphics.FromPdfPage(page)


                Dim Image As XImage = XImage.FromFile(sFileNew)

                page.Width = Image.PointWidth
                page.Height = Image.PointHeight
                SetToolStripText(ToolStripStatusLabel1, "Drawing Image")
                gfx.DrawImage(Image, 0, 0)

                s_document.Save(sFileNew & ".pdf")
                Dim lvs As ListViewItem.ListViewSubItem = lvItem.SubItems(4)

                'My.Computer.FileSystem.DeleteFile(sFileNew)
                SetToolStripText(ToolStripStatusLabel1, "Created: " & sFileNew & ".pdf")
                lstForBinder.Add(sFileNew & ".pdf")
                'My.Computer.FileSystem.DeleteFile(sFileNew)
                iTiffCount += 1
                iCount += 1
                SetLVsubitem(lvs, iTiffCount)
            Next





        Next

        Dim sBinderName As String = ribOutputFolder.TextBoxText & "\" & lvItem.Text & " " & lvItem.SubItems(1).Text & " " & Replace(lvItem.SubItems(2).Text, "/", "_") & ".pdf"
        SetToolStripText(ToolStripStatusLabel1, "Creating Binder: " & sBinderName)
        Dim bCreated As Boolean = False

        If Not File.Exists(sBinderName) Then
            SetToolStripText(ToolStripStatusLabel1, "Binder does not exist! ")
            bCreated = True
            CreatePDF(Now, sBinderName)
        End If
        For Each sFileBinder As String In lstForBinder
            AddPDFtoExistingPDF(sFileBinder, sBinderName)
            My.Computer.FileSystem.DeleteFile(sFileBinder)
        Next

        If bCreated Then
            Debug.Print("Removing Page 0")
            funDeletePage(sBinderName, 0)
        End If

        Dim lvsBinder As ListViewItem.ListViewSubItem = lvItem.SubItems(5)
        SetLVsubitem(lvsBinder, sBinderName)

        Return sBinderName


    End Function
   

CreatePDFfromTIFFs

CreatePDFfromTIFFs(sFileTIFFbuildout)
    For Each bmp As Image In GetAllPages(sAttachFileName)
            'SetToolStripText(ToolStripStatusLabel1, sFile & "_" & iCount & ".jpg")
            Dim sFileNew = sFile & "_0" & iCount & ".jpg"
            bmp.Save(sFileNew, ImageFormat.Jpeg)
            Dim s_document As PdfDocument = New PdfDocument()
            Threading.Thread.Sleep(1500)
            Dim page As PdfPage = s_document.AddPage()

            Dim gfx As XGraphics = XGraphics.FromPdfPage(page)


            Dim Image As XImage = XImage.FromFile(sFileNew)

            page.Width = Image.PointWidth
            page.Height = Image.PointHeight
            'SetToolStripText(ToolStripStatusLabel1, "Drawing Image")
            gfx.DrawImage(Image, 0, 0)
            Console.WriteLine("   Adding: " & sFileNew)
            s_document.Save(sFileNew & ".pdf")
            s_document.Close()
            s_document.Dispose()
            bmp.Dispose()
            gfx.Dispose()
            Image.Dispose()
            AddPDFtoExistingPDF(sFileNew & ".pdf", sFileTIFFbuildout)
        Try
    My.Computer.FileSystem.DeleteFile(sFileNew)
    My.Computer.FileSystem.DeleteFile(sFileNew & ".pdf")
Catch ex As Exception
    Console.WriteLine("ProcessTIFF: CANNNOT REMOVE: " & sFileNew)
End Try
            'My.Computer.FileSystem.DeleteFile(sFileNew)
            'SetToolStripText(ToolStripStatusLabel1, sFileNew & ".pdf")
            iCount += 1
        Next
        sAttachFileName = sFileTIFFbuildout
    Catch ex As System.Exception
        sErrorLog.AppendLine("***TIFF***: " & sAttachFileName & vbCrLf & ex.Message)
        WriteFile("***TIFF***: " & sAttachFileName & vbCrLf & ex.Message, sFile, True)
        bError = True
    End Try