|
|
本帖最后由 ycz22 于 2024-10-12 23:28 编辑
Option Explicit
'备注:低版本的不支持中文路径(要9.0或更高版本)
'------------------------------------------------
'API 调用开始
'------------------------------------------------
'Win32 API 声明
Public Declare Sub CopyMemory Lib "kernel32" Alias "RtlMoveMemory" (ByVal dest As Long, ByVal source As Long, ByVal bytes As Long)
'此函数将一定字节长度的数据从内存中的一个位置（源）复制到另一个位置（目的地）.
'GhostScript API 声明
Private Declare Function gsapi_revision Lib "gsdll32.dll" (ByVal pGSRevisionInfo As Long, ByVal intLen As Long) As Long
'此函数返回 GhostScript 解释器库包括版本号相关信息的字符串, 您应该在任何其他解释器库函数之前将其调用, 以确保已加载正确版本的 GhostScript 解释器
Private Declare Function gsapi_new_instance Lib "gsdll32.dll" (ByRef lngGSInstance As Long, ByVal lngCallerHandle As Long) As Long
'创建 Ghostscript 新的实例.此实例传递给大多数其他 gsapi 函数. lngCallerHandle 将提供给回调函数. 在这个阶段, Ghostscript 只支持一个实例.
Private Declare Function gsapi_set_stdio Lib "gsdll32.dll" (ByVal lngGSInstance As Long, ByVal gsdll_stdin As Long, ByVal gsdll_stdout As Long, ByVal gsdll_stderr As Long) As Long
'设置 stdio 的回调函数. 回调中使用的 handle 将取自传递给 gsapi_new_instance() 的值. 否则, 此函数的行为将与 gsapi_set_stdio_with_handle()匹配.
Private Declare Sub gsapi_delete_instance Lib "gsdll32.dll" (ByVal lngGSInstance As Long)
'销毁 GhostScript 的实例. 在您调用此之前, GhostScript 必须已经完成. 如果 GhostScript 已初始化, 则必须在 gsapi_delete_instance（）之前调用 gsapi_exit()
Private Declare Function gsapi_init_with_args Lib "gsdll32.dll" (ByVal lngGSInstance As Long, ByVal lngArgumentCount As Long, ByVal lngArguments As Long) As Long
'初始化解释器.这在 imainarg.c 中调用 gs_main_init_with_args().返回代码请参阅返回代码列表. 参数与 "C" 主函数相同: argv(0)将被忽略, 用户提供的参数是从 argv(1)至 argv(Ubound(argv)).
Private Declare Function gsapi_run_file Lib "gsdll32.dll" (ByVal lngGSInstance As Long, ByVal strFileName As String, ByVal intErrors As Long, ByVal intExitCode As Long) As Long
'gsapi_run_file 函数与 gs_main_run_file 类似，只是省略了 error_object. 如果此函数返回 <= -100, 则表示退出或发生致命错误. 接下来必须调用 gsapi_exit().
Private Declare Function gsapi_exit Lib "gsdll32.dll" (ByVal lngGSInstance As Long) As Long
'退出 GhostScript 解释器,如果已调用 gsapi_init_with_args（）,则必须在关闭时调用该命令, 并且在 gsapi_delete_instance（）之前调用
'------------------------------------------------
'API 调用开始结束
'------------------------------------------------
'------------------------------------------------
'回调函数开始
'------------------------------------------------
'只有使用 gsapi_set_stdio() 时才需要这些
Public Function gsdll_stdin(ByVal intGSInstanceHandle As Long, ByVal strz As Long, ByVal intBytes As Long) As Long
'VBA 没有 console, 只需返回 EOF
gsdll_stdin = 0
End Function
Public Function gsdll_stdout(ByVal intGSInstanceHandle As Long, ByVal strz As Long, ByVal intBytes As Long) As Long
'如果你能想到更有效率的方法, 请告知.
'我们需要从字节缓冲区转换为字符串
'首先, 我们创建一个适当大小的字节数组
Dim aByte() As Byte
ReDim aByte(intBytes)
'然后我们获取字节数组的地址
Dim ptrByte As Long
ptrByte = VarPtr(aByte(0))
'然后我们字节将缓冲区复制到字节数组
CopyMemory ptrByte, strz, intBytes
'然后我们将字节数组逐个字符复制到字符串
Dim str As String
Dim i As Long
For i = 0 To intBytes - 1
str = str + Chr(aByte(i))
Next
'最后,我们输出信息
gsdll_stdout = intBytes
End Function
Public Function gsdll_stderr(ByVal intGSInstanceHandle As Long, ByVal strz As Long, ByVal intBytes As Long) As Long
gsdll_stderr = gsdll_stdout(intGSInstanceHandle, strz, intBytes)
End Function
'------------------------------------------------
'回调函数结束
'------------------------------------------------
'------------------------------------------------
'用户自定义函数开始
'------------------------------------------------
Public Function AnsiZtoString(ByVal strz As Long) As String
'我们需要从字节缓冲区转换为字符串
Dim byteCh(1) As Byte
Dim bOK As Boolean
bOK = True
Dim ptrByte As Long
ptrByte = VarPtr(byteCh(0))
Dim j As Long
j = 0
Dim str As String
While bOK
'这就是指针算术的方法！
CopyMemory ptrByte, strz + j, 1
If byteCh(0) = 0 Then
bOK = False
Else
str = str + Chr(byteCh(0))
End If
j = j + 1
Wend
AnsiZtoString = str
End Function
Public Function CallGS(ByRef astrGSArgs() As String) As Boolean
Dim intReturn As Long
Dim intGSInstanceHandle As Long
Dim aAnsiArgs() As String
Dim aPtrArgs() As Long
Dim intCounter As Long
Dim intElementCount As Long
Dim iTemp As Long
Dim callerHandle As Long
Dim ptrArgs As Long
' 加载 Ghostscript 并获取实例的 handle
intReturn = gsapi_new_instance(intGSInstanceHandle, callerHandle)
If (intReturn < 0) Then
CallGS = False
Return
End If
'捕获 stdio
intReturn = gsapi_set_stdio(intGSInstanceHandle, AddressOf gsdll_stdin, AddressOf gsdll_stdout, AddressOf gsdll_stderr)
If (intReturn >= 0) Then
'将 Unicode 字符串转换为以 null 结尾的 ANSI 字节数组
'然后获取指向字节数组的指针.
intElementCount = UBound(astrGSArgs)
ReDim aAnsiArgs(intElementCount)
ReDim aPtrArgs(intElementCount)
For intCounter = 0 To intElementCount
aAnsiArgs(intCounter) = StrConv(astrGSArgs(intCounter), vbFromUnicode)
aPtrArgs(intCounter) = StrPtr(aAnsiArgs(intCounter))
Next
ptrArgs = VarPtr(aPtrArgs(0))
intReturn = gsapi_init_with_args(intGSInstanceHandle, intElementCount + 1, ptrArgs)
' 停止 Ghostscript 解释器
gsapi_exit (intGSInstanceHandle)
End If
' 释放 Ghostscript 实例 handle
gsapi_delete_instance (intGSInstanceHandle)
If (intReturn >= 0) Then
CallGS = True
Else
CallGS = False
End If
End Function
Function getPdfPageNum(ByVal sPath As String) As Long '获取PDF文件的总页数
Dim iFN As Integer, bPos As Long
iFN = FreeFile
Dim bFileSize As Long
bFileSize = FileLen(sPath)
Open sPath For Binary Access Read As iFN
Dim arrResult() As Byte
'读取字节流
arrResult = InputB(bFileSize, iFN)
Dim arrFind() As Byte
'要查找的字节串,"/Count"为pdf总页数的特征字符标识
arrFind = StrConv("/Count", vbFromUnicode)
'设置查找的起始位置
bPos = 0
bPos = InStrB(bPos + 1, arrResult, arrFind, vbBinaryCompare)
'设置个变量预装"/Count"之后的字符
Dim sResult As String
sResult = Space(1000)
Get iFN, bPos + 6, sResult
getPdfPageNum = Val(sResult)
Close iFN
End Function
Private Function Pdf2Img(InputFile As String, OutputFile As String, Optional DPI As Long = 300) As Boolean
Dim DeviceFormat As String, fp As Long, lp As Long, OFile As String, astrArgs(11) As String
If LCase(Right(OutputFile, 3)) = "jpg" Then
DeviceFormat = "jpeg"
ElseIf LCase(Right(OutputFile, 3)) = "png" Then
DeviceFormat = "png16m"
ElseIf LCase(Right(OutputFile, 3)) = "bmp" Then
DeviceFormat = "bmp16m"
End If
If getPdfPageNum(InputFile) > 1 Then
fp = 1
lp = getPdfPageNum(InputFile)
OFile = Split(OutputFile, ".")(0) & "_%02d." & Split(OutputFile, ".")(1) '页码01代表1位数,02代表2位数,依次类推.
Else
fp = 1
lp = 1
OFile = OutputFile
End If
astrArgs(0) = "pdf2img" '首个参数将被忽略
astrArgs(1) = "-dNOPAUSE" '每一页转换之间没有停顿
astrArgs(2) = "-dBATCH" '防止 gs 进入交互模式
astrArgs(3) = "-dPARANOIDSAFER" '在安全模式下运行此命令
astrArgs(4) = "-sDEVICE=" & DeviceFormat '转换输出的文件类型格式
astrArgs(5) = "-r" & DPI '图像分辨率
astrArgs(6) = "-dQUIET" '静默的意思,指代执行过程中尽可能少的输出日志等信息.（也可以简写为"-q"）
astrArgs(7) = "-dNOPROMPT" '禁用用户交互提示
astrArgs(8) = "-dFirstPage=" & fp '从第几页开始
astrArgs(9) = "-dLastPage=" & lp '到第几页结束
astrArgs(10) = "-sOutputFile=" & OFile '输出文件路径,使用%d或%ld输出页数
astrArgs(11) = InputFile '输入文件路径
Pdf2Img = CallGS(astrArgs) '提交参数数组执行转换
End Function
'------------------------------------------------
'用户自定义函数结束
'------------------------------------------------
|
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2024-10-12 23:27
还是用我的pq获取页数 通用不管有没有/Count
楼主