udfPDFGetNumPages (sFilename)
;------------------------------------------------------------------------------------------------------------------------------------------
If ItemLocate("udfpdfgetnumpages",IntControl(77,103,0,0,0),@TAB) Then Goto skip_udfpdfgetnumpages

#DefineFunction udfPDFGetNumPages (sFilename)

; On Error GoTo Label :WBERRORHANDLER
IntControl(73,1,0,0,0)

; Sets the file sharing mode for file reads.
; 1 ... Allow other open operations for read access.
iLastIC39 = IntControl(39,1,0,0,0)

; Define some constants.
@01="  "
@02=" "
@03=" /"
@04=" />"
@05=" /Type /Pages "
@06=" [ "
@07=" ] "
@08=" << "
@09=" >> "
@10=""
@11="#"
@12="#* #*"
@13="%%%%EOF"
@14="%%PDF"
@15=","
@16="/"
@17="/Count "
@18="/Pages "
@19="/Parent "
@20="/Prev "
@21="/Root "
@22="["
@23="]"
@24="<<"
@25=">>"
@26="1234567890"
@27="n"
@28="startxref"
@29="trailer"
@30="xref"

iFileIsUndefined = 0
iFileIsEmpty     = -1
iFileIsDamaged   = -2
iFileIsNoPdf     = -3


; Check filesize.
iNumPages = iFileIsUndefined
iFilesize = FileSizeEx(sFilename)
If !iFilesize Then iNumPages = iFileIsEmpty
If !iFilesize Then Goto ExitUdf

iNoPdf = @FALSE
iNoEof = @FALSE
iNoStartXref = @FALSE
iAlternativeSearch = @FALSE

; Define a binary buffer.
iChunk = 1024
hBB = BinaryAlloc(iChunk)

; Read backwards into pdf file.
iEod = BinaryReadEx(hBB,0,sFilename,Max(0,iFilesize-iChunk),iChunk) - 1

; Find EOF marker.
iOffset = BinaryIndexEx(hBB,iEod,@13,@BACKSCAN,1)  ; "[pct][pct]EOF"
iNoEof = (iOffset==-1)

; Find startxref section.
If iNoEof Then iOffset = iEod
iOffsetEnd = iOffset
sStartXref = @28
iLenStartXref = 9
iOffset = BinaryIndexEx(hBB,iOffset,sStartXref,@BACKSCAN,1)
iNoStartXref = (iOffset==-1)

iAlternativeSearch = (iNoEof||iNoStartXref)
If iAlternativeSearch Then Goto EXITNORMALSEARCH


iOffset = iOffset + iLenStartXref ; Jump over last search item.
iOffsetStartXref = Int(StrClean(BinaryPeekStr(hBB,iOffset,iOffsetEnd-iOffset),@26,@10,@TRUE,2))


; Create a list of pointers to the xref tables.
sDelimBol   = StrCat(@LF,@02)
sListXref   = @10
iObjFound   = @FALSE
iOffsetXref = iOffsetStartXref

While @TRUE
   ; Read first line xref.
   ; Assumption: xref is found within the first 20 byte.
   BinaryReadEx(hBB,0,sFilename,iOffsetXref,20)
   BinaryEodSet(hBB,20)
   BinaryReplace(hBB,@CR,@LF,@TRUE)

   sExtract = BinaryPeekStr(hBB,0,20)
   sExtract = StrClean(sExtract,sDelimBol,@02,@TRUE,2)
   iPos     = StrIndex(sExtract,sDelimBol,1,@FWDSCAN)
   ; Xref subsection begins here.
   iOffsetXref = iOffsetXref + iPos

   sExtract = BinaryPeekStr(hBB,0,20)
   sExtract = ItemExtract(1,sExtract,@LF)
   sExtract = StrTrim(sExtract)

   ; If the pdf structure is damaged, then we use the alternative search algorithm.
   iAlternativeSearch = (sExtract!=@30)
   If iAlternativeSearch Then Break

   While @TRUE
      ; Read xref subsection header.
      BinaryReadEx(hBB,0,sFilename,iOffsetXref,20)
      BinaryEodSet(hBB,20)
      BinaryReplace(hBB,@CR,@LF,@TRUE)

      sExtract = BinaryPeekStr(hBB,0,20)
      sExtract = StrClean(sExtract,sDelimBol,@02,@TRUE,2)
      iPos     = StrIndex(sExtract,sDelimBol,1,@FWDSCAN)
      ; Following xref subsection entries begin here.
      iOffsetXref = iOffsetXref + iPos

      sExtract = BinaryPeekStr(hBB,0,20)
      sExtract = ItemExtract(1,sExtract,@LF)
      sExtract = StrTrim(sExtract)

      ; If we reach the trailer section, then we break out.
      If (sExtract==@29) Then Break

      ; If there are no two numbers, then we break out.
      If !StrIndexWild(StrClean(StrClean(sExtract,@26,@02,@TRUE,2),@26,@11,@TRUE,1),@12,1) Then Break

      ;iSectionStart = ItemExtract(1,sExtract,@02)
      iSectionCount = ItemExtract(2,sExtract,@02)

      ; Build our list of pointers.
      sItemXref = ItemInsert(iOffsetXref,-1,sExtract,@02)
      sListXref = ItemInsert(sItemXref,-1,sListXref,@15)

      ; Next subsection begins here.
      iOffsetXref = iOffsetXref + (iSectionCount * 20)
   EndWhile

   ; Read the trailer section.
   ; Find link to previous xref table, if there is one.
   iOffset = iOffsetXref
   sSearch = @20
   GoSub ReadChunks
   If (iOffset==-1) Then Break
   GoSub GetSearchValue
   If (iSearchValue==-1) Then Break
   iOffsetXref = iSearchValue
EndWhile

If iAlternativeSearch Then Goto EXITNORMALSEARCH

; Count items in the list of pointers.
iCountXref = ItemCount(sListXref,@15)


; Now start working.

; Find the trailer section beyond the xref section.
iOffset = iOffsetStartXref
sSearch = @29
GoSub ReadChunks
sSearch = @21
GoSub ReadChunks
GoSub GetSearchValue
iObjRoot = iSearchValue

; Find offset for object.
iObj = iObjRoot
GoSub FindOffset
iOffsetRoot = iObjOffset

; Read Root object. Find Pages element.
iOffset = iOffsetRoot
sSearch = @18
GoSub ReadChunks
GoSub GetSearchValue
iObjPages = iSearchValue

; Find offset for object.
iObj = iObjPages
GoSub FindOffset
iOffsetPages = iObjOffset

; Read Pages object. Find Count element.
iOffset = iOffsetPages
sSearch = @17
GoSub ReadChunks
GoSub GetSearchValue
iNumPages = iSearchValue

:EXITNORMALSEARCH
BinaryFree(hBB)

If iAlternativeSearch Then GoSub AlternativeSearch

If (iNumPages==iFileIsUndefined)
   ; Check pdf signature in first 1024 byte.
   iChunk = 1024
   hBB = BinaryAlloc(iChunk)
   BinaryReadEx(hBB,0,sFilename,0,iChunk)
   iNoPdf = (BinaryIndexEx(hBB,0,@14,@FWDSCAN,@TRUE)==-1) ; "[pct]PDF"
   If iNoPdf Then iNumPages = iFileIsNoPdf
      Else iNumPages = iFileIsDamaged
   BinaryFree(hBB)
Else
   If iNoStartXref Then iNumPages = iFileIsDamaged
EndIf

:ExitUdf
IntControl(39,iLastIC39,0,0,0)
Return (iNumPages)

;..........................................................................................................................................
:FindOffset
iObjOffset = -1
For i=1 To iCountXref
   sItemXref = ItemExtract(i,sListXref,@15)
   iSectionStart = Int(ItemExtract(1,sItemXref,@02))
   iSectionCount = Int(ItemExtract(2,sItemXref,@02))
   If !((iObj < iSectionstart) || (iObj > (iSectionStart + iSectionCount - 1)))
      iOffsetXref = Int(ItemExtract(3,sItemXref,@02))
      iIndex = iObj - iSectionStart
      iOffset = iOffsetXref + (iIndex * 20)
      BinaryReadEx(hBB,0,sFilename,iOffset,18)
      BinaryEodSet(hBB,18)
      sExtract = BinaryPeekStr(hBB,0,18)
      iInUse = (ItemExtract(3,sExtract,@02)==@27)
      If !iInUse Then Continue
      iObjOffset = Int(ItemExtract(1,sExtract,@02))
      Break
   EndIf
Next
Return
;..........................................................................................................................................
:GetSearchValue
BinaryReadEx(hBB,0,sFilename,iOffset,iChunk)
BinaryReplace(hBB,@CR,@02,@TRUE)
BinaryReplace(hBB,@LF,@02,@TRUE)
sExtract = BinaryPeekStr(hBB,0,iChunk)
iPos1 = StrIndex(sExtract,sSearch,1,@FWDSCAN)
If iPos1
   iPos1 = iPos1 + StrLen(sSearch)
   iPos2 = StrScan(sExtract,@04,iPos1,@FWDSCAN)
   sExtract = StrSub(sExtract,iPos1,iPos2-iPos1)
   iSearchValue = Int(sExtract)
Else
   iSearchValue = -1
EndIf
Return
;..........................................................................................................................................
:ReadChunks
iLenSearch = StrLen(sSearch)
While @TRUE
   BinaryReadEx(hBB,0,sFilename,iOffset,iChunk)
   BinaryReplace(hBB,@CR,@02,@TRUE)
   BinaryReplace(hBB,@LF,@02,@TRUE)
   iOffsetEnd1 = BinaryIndexEx(hBB,0,@25,@FWDSCAN,1)
   If (iOffsetEnd1>-1)
      BinaryEodSet(hBB,iOffsetEnd1)
   EndIf
   iOffsetEnd2 = BinaryIndexEx(hBB,0,sSearch,@FWDSCAN,1)
   If (iOffsetEnd2>-1)
      iOffset = iOffset + iOffsetEnd2
      Break
   EndIf
   If (iOffsetEnd1>-1)
      iOffset = -1
      Break
   EndIf
   iOffset = iOffset + iChunk - iLenSearch
   If (iOffset>iFileSize) Then Break
EndWhile
Return

;..........................................................................................................................................
:AlternativeSearch

; Prepare data.
hBB = BinaryAlloc(iFilesize)
BinaryRead(hBB,sFilename)
iSize1=BinaryReplace(hBB,@22,@10,@TRUE)
iSize2=BinaryReplace(hBB,@23,@10,@TRUE)
iSize3=BinaryReplace(hBB,@24,@10,@TRUE)
iSize4=BinaryReplace(hBB,@25,@10,@TRUE)
iSize5=BinaryReplace(hBB,@16,@10,@TRUE)
BinaryFree(hBB)
hBB = BinaryAlloc(iFilesize + 2*iSize1 + 2*iSize2 + 2*iSize3 + 2*iSize4 + iSize5)
BinaryRead(hBB,sFilename)
BinaryReplace(hBB,@CR,@02,@TRUE)
BinaryReplace(hBB,@LF,@02,@TRUE)
BinaryReplace(hBB,@22,@06,@TRUE)
BinaryReplace(hBB,@23,@07,@TRUE)
BinaryReplace(hBB,@24,@08,@TRUE)
BinaryReplace(hBB,@25,@09,@TRUE)
BinaryReplace(hBB,@16,@03,@TRUE)
While BinaryReplace(hBB,@01,@02,@TRUE)
EndWhile

; Search for the Pages object.
sSearch = @05
iOffsetR = BinaryEodGet(hBB)-1
iOffsetL = 0
iDirection = 1
While @TRUE
   iDirection = !iDirection
   If iDirection
      iOffset1 = BinaryIndexEx(hBB,iOffsetL,sSearch,@FWDSCAN,1)
   Else
      iOffset1 = BinaryIndexEx(hBB,iOffsetR,sSearch,@BACKSCAN,1)
   EndIf
   If (iOffset1==-1) Then Break
   iOffset2 = BinaryIndexEx(hBB,iOffset1,@24,@BACKSCAN,1)
   If !iDirection Then iOffsetR = iOffset2
   iOffset3 = BinaryIndexEx(hBB,iOffset1,@25,@FWDSCAN,1)
   If iDirection Then iOffsetL = iOffset3
   iOffset4 = BinaryIndexEx(hBB,iOffset2,@19,@FWDSCAN,1)
   If ((iOffset4<iOffset3)&&(iOffset4>-1)) Then Continue
   sExtract = BinaryPeekStr(hBB,iOffset2,iOffset3-iOffset2+1)
   iPos = StrIndex(sExtract,@17,1,@FWDSCAN)
   If !iPos Then Continue
   iPos = iPos+7
   iEow = StrScan(sExtract,@04,iPos,@FWDSCAN)
   sExtract = StrSub(sExtract,iPos,iEow-iPos)
   iNumPages = Int(sExtract)
   If iNumPages Then Break
EndWhile

BinaryFree(hBB)

Return

;..........................................................................................................................................
:WBERRORHANDLER
WbError = LastError()
WbTextcode = WbError
If WbError==1668||WbError==2669||WbError==3670
   ; 1668 ; "Minor user-defined error"
   ; 2669 ; "Moderate user-defined error"
   ; 3670 ; "Severe user-defined error"
   WbError = ItemExtract(1,IntControl(34,-1,0,0,0),":")
   WbTextcode = -1
EndIf
WbErrorString = IntControl(34,WbTextcode,0,0,0)
WbErrorDateTime = StrCat(TimeYmdHms(),"|",StrFixLeft(GetTickCount()," ",10))

WbErrorFile = StrCat(DirWindows(0),"WWWBATCH.INI")
IniWritePvt(WbErrorDateTime,"ErrorValue"   ,WbError                 ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ErrorString"  ,WbErrorString           ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ScriptLine"   ,WbErrorHandlerLine      ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"ScriptOffset" ,WbErrorHandlerOffset    ,WbErrorFile)
IniWritePvt(WbErrorDateTime,"VarAssignment",WbErrorHandlerAssignment,WbErrorFile)
IniWritePvt("","","",WbErrorFile)

WbErrorMsgText = StrCat(WbErrorDateTime,@LF,@LF)
WbErrorMsgText = StrCat(WbErrorMsgText,"LastError value:",@LF,WbError,@LF,@LF)
WbErrorMsgText = StrCat(WbErrorMsgText,"LastError string:",@LF,WbErrorString,@LF,@LF)
; Line in script that caused Error.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerLine:",@LF,WbErrorHandlerLine,@LF,@LF)
; Offset into script of error line, in bytes.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerOffset:",@LF,WbErrorHandlerOffset,@LF,@LF)
; Variable being assigned on error line, or "" if none.
WbErrorMsgText = StrCat(WbErrorMsgText,"WbErrorHandlerAssignment:",@LF,WbErrorHandlerAssignment,@LF,@LF)
If (WbErrorHandlerAssignment>"") Then %WbErrorHandlerAssignment% = "eeek"
Message("wbErrorHandler",WbErrorMsgText)

Exit

;..........................................................................................................................................
; This function udfPDFGetNumPages returns the number of pages for a given PDF file.
; Return values:
;  n ... The number of pages, greater than zero.
; -1 ... The given file has a size of zero byte or does not exist.
; -2 ... The given file seems to be a pdf file but it is damaged.
; -3 ... The given file seems to be not an Adobe pdf file.
;
; Detlev Dalitz.20021114.20030116.20030117.20030119. ...
; 20030823 Bug Report by Mimmo Montalenti.
; 20030825 Revised version, should handle linearized pdf files too.
; 20030827 New algorithm (xref walker).
; 20030829 Added an alternative search algorithm to handle weird pdf files too.
; 20030830 Some small bugfixes.
; 20030831 Some small refinements.
;..........................................................................................................................................
#EndFunction

:skip_udfpdfgetnumpages
;------------------------------------------------------------------------------------------------------------------------------------------



; --- test ---

; Create a simple pdf file with one page.
sTempFile = FileCreateTemp("TMP")
FileDelete(sTempFile)
sTempFolder = FilePath(sTempFile)
sFilename = "simple.pdf"
sFilename = StrCat(sTempFolder,sFilename)

hFW = FileOpen(sFilename,"WRITE")
FileWrite(hFW,"%%PDF-1.0") ; One duplicated percent sign.
FileWrite(hFW,"1 0 obj")
FileWrite(hFW,"<<")
FileWrite(hFW,"/Type /Catalog")
FileWrite(hFW,"/Pages 3 0 R")
FileWrite(hFW,"/Outlines 2 0 R")
FileWrite(hFW,">>")
FileWrite(hFW,"endobj2 0 obj")
FileWrite(hFW,"<<")
FileWrite(hFW,"/Type /Outlines")
FileWrite(hFW,"/Count 0")
FileWrite(hFW,">>")
FileWrite(hFW,"endobj")
FileWrite(hFW,"3 0 obj")
FileWrite(hFW,"<<")
FileWrite(hFW,"/Type /Pages ")
FileWrite(hFW,"/Count 1 ")
FileWrite(hFW,"/Kids [4 0 R]")
FileWrite(hFW,">>")
FileWrite(hFW,"endobj")
FileWrite(hFW,"4 0 obj")
FileWrite(hFW,"<<")
FileWrite(hFW,"/Type /Page")
FileWrite(hFW,"/Parent 3 0 R")
FileWrite(hFW,"/Resources << /Font << /F1 7 0 R >> /ProcSet 6 0 R")
FileWrite(hFW,">>")
FileWrite(hFW,"/MediaBox [0 0 612 792]")
FileWrite(hFW,"/Contents 5 0 R")
FileWrite(hFW,">>")
FileWrite(hFW,"endobj")
FileWrite(hFW,"5 0 obj")
FileWrite(hFW,"<< /Length 44 >>")
FileWrite(hFW,"stream")
FileWrite(hFW,"BT")
FileWrite(hFW,"/F1 24 Tf")
FileWrite(hFW,"100 100 Td (Hello World) Tj")
FileWrite(hFW,"ET")
FileWrite(hFW,"endstream")
FileWrite(hFW,"endobj")
FileWrite(hFW,"6 0 obj")
FileWrite(hFW,"[/PDF /Text]")
FileWrite(hFW,"endobj")
FileWrite(hFW,"7 0 obj")
FileWrite(hFW,"<<")
FileWrite(hFW,"/Type /Font")
FileWrite(hFW,"/Subtype /Type1")
FileWrite(hFW,"/Name /F1")
FileWrite(hFW,"/BaseFont /Helvetica")
FileWrite(hFW,"/Encoding /MacRomanEncoding")
FileWrite(hFW,">>endobj")
FileWrite(hFW,"xref")
FileWrite(hFW,"0 8")
FileWrite(hFW,"0000000000 65535 f")
FileWrite(hFW,"0000000010 00000 n")
FileWrite(hFW,"0000000080 00000 n")
FileWrite(hFW,"0000000132 00000 n")
FileWrite(hFW,"0000000198 00000 n")
FileWrite(hFW,"0000000349 00000 n")
FileWrite(hFW,"0000000451 00000 n")
FileWrite(hFW,"0000000482 00000 n")
FileWrite(hFW,"trailer")
FileWrite(hFW,"<<")
FileWrite(hFW,"/Size 8")
FileWrite(hFW,"/Root 1 0 R")
FileWrite(hFW,">>")
FileWrite(hFW,"startxref")
FileWrite(hFW,"597")
FileWrite(hFW,"%%%%EOF") ; Two duplicated percent signs.
FileClose(hFW)

sMsgTitle = "Demo  udfPDFGetNumPages (sFilename)"


sFilename = "simple.pdf"
iPages = udfPDFGetNumPages (sFilename)
sMsgText = StrCat("PDF Filename",@TAB,sFilename,@LF,"PDF Pages",@TAB,iPages,@LF)
Message(sMsgTitle,sMsgText)

; FileDelete(sFilename)
Exit
;------------------------------------------------------------------------------------------------------------------------------------------
;*EOF*