_________________________
Professionelle Entwicklerkomponenten
www.tools4vb.de

Zitat:

Das Script liest den "Quellcode" der PDF nur bis zu einem PS-Steuerbefehl (NUL) ein und gibt den Rest nicht mehr aus,

' Variable Dateiname setzen
Dateiname = "C:\Test\1143522_RB~0.pdf"
 
 
' Datei öffnen/auslesen
Const ForReading = 1
Set objFSO = CreateObject("Scripting.FileSystemObject")
Set objTest = objFSO.GetFile(Dateiname)
If objTest.Size > 0 Then
Set objFile = objFSO.OpenTextFile(Dateiname, ForReading)
strText = objFile.ReadAll
objFile.Close
end if
 
' PDF nach einem String durchsuchen und den Startpunkt ermitteln
abmessungen_start1 = InStr(strText,"MediaBox[")+9
abmessungen_start2 = InStr(strText,"MediaBox [")+9
 
' tatsächlichen Startpunkt in Abhängigkeit von start1 und start2 ermitteln 
if(abmessungen_start1="9") then
	abmessungen_start = abmessungen_start2
elseif(abmessungen_start1<>"9") then
	abmessungen_start = abmessungen_start1
end if
 
' Position an der die abschliessende eckige Klammer steht
abmessungen_end = InStr(abmessungen_start,strText,"]",1)+1
 
' Zeichenlaenge der Werte innerhalb der eckigen Klammern
laenge_start_to_end = abmessungen_end - abmessungen_start - 1
 
' Bereich in dem die Werte der PDF-Groesse in den eckigen Klammern steht
abmessungen = mid(strText, abmessungen_start, laenge_start_to_end)
 
 
' Bereich zerlegen in einzelne Werte
abmessungen_splitten = Split(abmessungen," ")
abmessungen_einzeln = ubound(abmessungen_splitten)
for i=0 to abmessungen_einzeln
	abmessungen_x = abmessungen_splitten(1) / 2.834 / 100
	abmessungen_y = abmessungen_splitten(2) / 2.834 / 100
	abmessungen_breite = abmessungen_splitten(3) / 2.834 / 100
	abmessungen_hoehe = abmessungen_splitten(4) / 2.834 / 100
next
 
' Nachkommastellen bei Abmessungen in mm  entfernen (z.B. 210,06 mm = 210 mm)
If InStrRev(abmessungen_breite, ",") > 0 Then abmessungen_breite = Left( _
  abmessungen_breite, InStrRev(abmessungen_breite, ",") - 1)
If InStrRev(abmessungen_hoehe, ",") > 0 Then abmessungen_hoehe = Left( _
abmessungen_hoehe, InStrRev(abmessungen_hoehe, ",") - 1)
 
' Werte in globale Variablen in Outputmanagement Software eintragen
'Watch.setvariable "global.PDFxPosition", abmessungen_x
'Watch.setvariable "global.PDFyPosition", abmessungen_y
'Watch.setvariable "global.PDFbreite", abmessungen_breite
'Watch.setvariable "global.PDFhoehe", abmessungen_hoehe
 
' Ergebnis ausgeben in Windows Fenster zur Überprüfung (nicht relevant für 
' Outputmanagementsystem)
Msgbox(abmessungen)
Msgbox(abmessungen_x)
Msgbox(abmessungen_y)
Msgbox(abmessungen_breite)
Msgbox(abmessungen_hoehe)

Option Explicit
 
Sub test()
 
Dim FF As Integer
Dim abmessungen_start As Long
Dim abmessungen_start1 As Long
Dim abmessungen_start2 As Long
Dim abmessungen_end As Long
Dim laenge_start_to_end As Long
Dim abmessungen_einzeln As Long
Dim i As Long
 
Dim Start_x As Double, Start_y As Double
Dim Ende_x As Double, Ende_y As Double
Dim abmessungen_breite As Double, abmessungen_hoehe As Double
 
Dim msg As String, t As String
Dim abmessungen As String
Dim abmessungen_splitten() As String
 
Dim strText As String
Dim DateiName As String
' Variable Dateiname setzen
DateiName = "D:\U70-1F300.pdf" '"C:\Test\1143522_RB~0.pdf"
 
 
' Datei öffnen/auslesen
FF = FreeFile
Open DateiName For Binary As #FF
strText = Space$(LOF(FF))
Get #FF, , strText
Close
 
 
' PDF nach einem String durchsuchen und den Startpunkt ermitteln
abmessungen_start1 = InStr(strText, "MediaBox[")
abmessungen_start2 = InStr(strText, "MediaBox [")
 
' tatsächlichen Startpunkt in Abhängigkeit von start1 und start2 ermitteln
If abmessungen_start1 Then
    abmessungen_start = abmessungen_start1 + 9
ElseIf abmessungen_start2 Then
    abmessungen_start = abmessungen_start2 + 9
Else
    MsgBox ("Fehler")
    Exit Sub
End If
 
' Position an der die abschliessende eckige Klammer steht
abmessungen_end = InStr(abmessungen_start, strText, "]", 1) + 1
 
' Zeichenlaenge der Werte innerhalb der eckigen Klammern
laenge_start_to_end = abmessungen_end - abmessungen_start - 1
 
' Bereich in dem die Werte der PDF-Groesse in den eckigen Klammern steht
abmessungen = Mid$(strText, abmessungen_start, laenge_start_to_end)
 
 
' Bereich zerlegen in einzelne Werte
abmessungen_splitten = Split(abmessungen, " ")
 
    Start_x = CDbl(abmessungen_splitten(0))
    Start_y = CDbl(abmessungen_splitten(1))
    Ende_x = CDbl(abmessungen_splitten(2))
    Ende_y = CDbl(abmessungen_splitten(3))
 
 
' Nachkommastellen bei Abmessungen in mm  entfernen (z.B. 210,06 mm = 210 mm)
abmessungen_breite = Int((Ende_x - Start_x) / 2.834)
abmessungen_hoehe = Int((Ende_y - Start_y) / 2.834)
 
 
msg = "Abmessungen:" & vbLf & _
      "x = " & CStr(Start_x) & vbLf & _
      "y = " & CStr(Start_y) & vbLf & _
      "Höhe = " & CStr(abmessungen_hoehe) & vbLf & _
      "Breite = " & CStr(abmessungen_breite)
 
 
t = MsgBox(msg, 64)
End Sub

Zitat:

Ich hab das Programm testweise nach VB6 (VBA) konvertiert.

Function PaperHeight(sFile)
 
  Dim F As Integer
  Dim nCount As Double
  Dim sBuffer As String
  Dim FileContent As String
  Dim nFilePos As Double
  Dim nSize As Double
  Dim nBytes As Double
  Dim nPos As Double
 
  ' Blockgröße
  Const nBlockSize = 16384
 
  ' Datei im Binary-Mode öffnen
  F = FreeFile
  Open sFile For Binary As #F
 
  ' Datei blockweise auslesen
  nSize = LOF(F)
  nFilePos = 0
  Do While nFilePos < nSize
    nBytes = nBlockSize
    If nFilePos + nBytes > nSize Then nBytes = nSize - nFilePos
 
    ' Inhalt lesen
    sBuffer = Space$(nBytes)
    Get #F, , sBuffer
    FileContent = FileContent + sBuffer
 
    nFilePos = nFilePos + nBytes
  Loop
 
  Close #F
  SpaceCount = 0
  FileLength = Len(FileContent)
  zaehler1 = 1
 
  Do Until Mid(FileContent, zaehler1, 9) = "MediaBox[" Or Mid(FileContent, _
    zaehler1, 10) = "MediaBox ["
  zaehler1 = zaehler1 + 1
  Loop
 
  If Mid(FileContent, zaehler1, 9) = "MediaBox[" Then Ueberspringen = 9
  If Mid(FileContent, zaehler1, 10) = "MediaBox [" Then Ueberspringen = 10
 
  For Zaehler2 = zaehler1 + Ueberspringen To FileLength
 
  If SpaceCount = 3 Then
     If Mid(FileContent, Zaehler2, 1) = "]" Then GoTo Finish:
     PaperHeightString = PaperHeightString + Mid(FileContent, Zaehler2, 1)
     End If
 
  If SpaceCount = 2 Then
     If Mid(FileContent, Zaehler2, 1) = " " Then GoTo Weiter2:
     PaperWidthString = PaperWidthString + Mid(FileContent, Zaehler2, 1)
Weiter2:
     End If
 
  If SpaceCount = 1 Then
     If Mid(FileContent, Zaehler2, 1) = " " Then GoTo Weiter1:
     PaperHeightMinusString = PaperHeightMinusString + Mid(FileContent, _
       Zaehler2, 1)
Weiter1:
     End If
 
  If SpaceCount = 0 Then
     If Mid(FileContent, Zaehler2, 1) = " " Then GoTo Weiter0:
     PaperWidthMinusString = PaperWidthMinusString + Mid(FileContent, Zaehler2, _
       1)
Weiter0:
     End If
 
If Mid(FileContent, Zaehler2, 1) = " " Then SpaceCount = SpaceCount + 1
 
  Next Zaehler2
 
 
Finish:
  PaperHeight = Val(PaperHeightString) - Val(PaperHeightMinusString)
  PaperWidth = Val(PaperWidthString) - Val(PaperWidthMinusString)
 
End Function