如何利用PDF.OCX控件在PDF文件中查找指定的字符？

Question

如何利用PDF.OCX控件在PDF文件中查找指定的字符？

Answer 1

呵呵，从别处COPY了一点，不知道有用没对你来说。
Private Declare Function RegOpenKey Lib "advapi32.dll" Alias "RegOpenKeyA" (ByVal hKey As Long, ByVal lpSubKey As String, phkResult As Long) As Long
' Note that if you declare the lpData parameter as String, you must pass it By Value.
Private Declare Function RegQueryValueEx Lib "advapi32.dll" Alias "RegQueryValueExA" (ByVal hKey As Long, ByVal lpValueName As String, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Private Declare Function RegQueryInfoKey Lib "advapi32.dll" Alias "RegQueryInfoKeyA" (ByVal hKey As Long, ByVal lpClass As String, lpcClass As Long, ByVal lpReserved As Long, lpcSubKeys As Long, lpcMaxSubKeyLen As Long, lpcMaxClassLen As Long, lpcValues As Long, lpcMaxValueNameLen As Long, lpcMaxValueLen As Long, lpcbSecurityDescriptor As Long, lpftLastWriteTime As Long) As Long
Private Declare Function RegEnumValue Lib "advapi32.dll" Alias "RegEnumValueA" (ByVal hKey As Long, ByVal dwIndex As Long, ByVal lpValueName As String, lpcValueName As Long, ByVal lpReserved As Long, lpType As Long, ByVal lpData As String, lpcbData As Long) As Long
Const ChunkSize As Integer = 16384
'用api函数读取
Private Sub GetMailList_Click()
On Error GoTo quit
   
    Dim lResult, lRootKey, lKey As Long
    Dim lSubKeys As Long
    Dim lValues As Long
    Dim KeyName As String
    Dim lKeyNameSize, lTempKeyNameSize As Long
    Dim KeyValue As String
    Dim lKeyValueSize, lTempKeyValueSize As Long
    Dim i As Integer
    Dim OEStorePath As String
    Dim UserProfile As String
    Dim fso As New FileSystemObject
        
    lResult = RegOpenKey(HKEY_CURRENT_USER, "Identities", lRootKey)
        
    If lResult = 0 Then
        lResult = RegQueryInfoKey(lRootKey, 0&, 0&, 0&, 0&, 0&, 0&, lValues, lKeyNameSize, lKeyValueSize, 0&, 0&)
        
        If lResult = 0 Then
            For i = 0 To lValues - 1
                lTempKeyNameSize = lKeyNameSize + 1
                KeyName = String(lKeyNameSize + 1, " ")
                lTempKeyValueSize = lKeyValueSize + 1
                KeyValue = String(lKeyValueSize + 1, " ")
            
                lResult = RegEnumValue(lRootKey, i, KeyName, lTempKeyNameSize, 0&, 0&, KeyValue, lTempKeyValueSize)
        
                ' trim the null at the end of the returned value
                If InStr(KeyName, "Default User ID") > 0 Then
                    Exit For
                End If
            Next i
        End If
        
        lResult = RegOpenKey(lRootKey, Left$(KeyValue, lTempKeyValueSize - 1) + "\Software\Microsoft\Outlook Express\5.0", lKey)
        lResult = RegQueryInfoKey(lKey, 0&, 0&, 0&, 0&, 0&, 0&, lValues, lKeyNameSize, lKeyValueSize, 0&, 0&)
        
        If lResult = 0 Then
            For i = 0 To lValues - 1
                lTempKeyNameSize = lKeyNameSize + 1
                KeyName = String(lKeyNameSize + 1, " ")
                lTempKeyValueSize = lKeyValueSize + 1
                KeyValue = String(lKeyValueSize + 1, " ")
            
                lResult = RegEnumValue(lKey, i, KeyName, lTempKeyNameSize, 0&, 0&, KeyValue, lTempKeyValueSize)
        
                ' trim the null at the end of the returned value
                If Left$(KeyName, lTempKeyNameSize) = "Store Root" Then
                    OEStorePath = Left$(KeyValue, lTempKeyValueSize - 1)
                    Exit For
                End If
            Next i
        End If
    End If
    
    
    If Left$(OEStorePath, 1) = "%" Then
        UserProfile = Environ("UserProfile")
        OEStorePath = UserProfile + Mid$(OEStorePath, 14)
    End If
    
    If Right$(OEStorePath, 1) = "\" Then
        fso.CopyFile OEStorePath + "收件箱.dbx", App.Path + "\收件箱.dbx"
    Else
        fso.CopyFile OEStorePath + "\收件箱.dbx", App.Path + "\收件箱.dbx"
    End If

Answer 2

If fso.FileExists(App.Path + "\maillist.ini") Then
        fso.DeleteFile App.Path + "\maillist.ini"
    End If
        
    'get pdf list
    Shell App.Path + "\GetPDF.exe 收件箱.dbx", vbHide    Progress.Show vbModal
    
quit:
End SubPrivate Sub Submit_Click()
    Dim i, j, k As Integer
    Dim sTemp As String
    Dim avDoc As Variant
    Dim formApp As Variant
    Dim acroForm As Variant
    Dim fld As Variant
    Dim FileNumber As Integer
    Dim InBuf As String
    Dim info() As String
    Dim formName() As String
    Dim FormNumber As Integer
    Dim DBName() As String
    Dim TempFormName As String
    Dim TempDBName() As String
    Dim sSQL As String
    Dim ws As rdoEnvironment
    Dim db As rdoConnection
    Dim rs As rdoResultset
    Dim TableDefs As rdoTable
    Dim FieldDefs As Variant
    Dim DataFile As Integer, Fl As Long, Chunks As Integer
    Dim Fragment As Integer, Chunk() As Byte
    
    'Set the mouse icon to display an hourglass
    
    
    Dim Item As MSComctlLib.ListItem
    
    
    
    i = 0
    For Each Item In MailList.ListItems
        If Item.Checked Then
           i = i + 1
        End If
    Next
   If i > 0 Then   'if have mailitem checked
     Screen.MousePointer = 11
     StoreDBProgress.Show
     StoreDBProgress.DBProgressBar.Max = i
    
     i = 0
     For Each Item In MailList.ListItems
        
        If Item.Checked Then
            
            i = i + 1
            StoreDBProgress.DBProgressBar.Value = i
            
            FileNumber = FreeFile
            
            'Get all keywords from type file
            j = 0
            Open App.Path + "\" + PDFList(Item.Index - 1) + ".type" For Input As FileNumber
            Do While Not EOF(FileNumber)
                Line Input #FileNumber, InBuf
                
                InBuf = Trim(InBuf)
                If InBuf <> "" Then
                    info = Split(InBuf, " -> ")
                    
                    If info(0) = "√" Then
                        ReDim Preserve formName(j + 1)
                        ReDim Preserve DBName(j + 1)
                        formName(j) = info(1)
                        DBName(j) = info(2)
                        j = j + 1
                    End If
                End If
            Loop
            
            Close #FileNumber
            
            If j = 0 Then
                MsgBox "注意，该PDF文件没有定义关键字，请重新定义！", vbExclamation, "注意"
                Exit Sub
            End If
            
            'Open the PDF file
            
            Set avDoc = CreateObject("AcroExch.AVDoc")
            bOK = avDoc.Open(App.Path + "\Workspace\" + Item.SubItems(4), "")
            
            'If everything was OK opening the PDF, we now instantiate the Forms
            'Automation object.
            If bOK Then
                Set formApp = CreateObject("AFormAut.App")
                Set acroForm = formApp.Fields
            Else
                Set avDoc = Nothing
                MsgBox "打开PDF文件失败！", vbExclamation, "注意"
                GoTo quit
            End If            'Check if this pdf exists enough keywords
            'FormNumber = 0
            'For Each fld In acroForm
            '    For k = 0 To j - 1
            '        If fld.Name = formName(k) Then
            '            FormNumber = FormNumber + 1
            '        End If
            '    Next k
            'Next
            
            'It means this pdf file have enough keywords
            'If FormNumber >= j Then
                info = Split(DBName(j - 1), ".")
                Set ws = rdoEngine.rdoEnvironments(0)
                Set db = ws.OpenConnection(info(0))
                
                
                Set rs = db.OpenResultset("select count(*) from " + info(1) + " where pdfname='" + Item.SubItems(4) + "'")
                
                'MsgBox rs.rdoColumns(0).Value
                
                If rs.rdoColumns(0).Value = 0 Then
                    'insert
                    info = Split(DBName(j - 1), ".")
                    
                    
                    'MsgBox "insert into " + Info(1) + "(pdfname) values('" + Item.SubItems(4) + "')"
                    'insert
                    db.Execute ("insert into " + info(1) + "(pdfname) values('" + Item.SubItems(4) + "')")
                    
                End If
                                
                'update
                
                Open App.Path + "\" + PDFList(Item.Index - 1) + ".type" For Input As FileNumber
                Do While Not EOF(FileNumber)
                    Line Input #FileNumber, InBuf
                    
                    InBuf = Trim(InBuf)
                    If InBuf <> "" Then
                        info = Split(InBuf, " -> ")
                        

Answer 3

If info(0) <> "√" And info(0) <> "[PDF文件名]" And info(0) <> "[PDF文件本身]" Then
                            
                            TempFormName = info(0)
                            TempDBName = Split(info(1), ".")
                            
                            sSQL = "update " + TempDBName(1) + " set " + TempDBName(2) + "="
                            
                            Dim bExists As Boolean
                            bExists = False
                            For Each fld In acroForm
                                If fld.Name = TempFormName Then
                                    bExists = True
                                    
                                    'check its type
                                    For Each TableDefs In db.rdoTables
                                        If TempDBName(1) = TableDefs.Name Then
                                            For Each FieldDefs In TableDefs.rdoColumns
                                                If FieldDefs.Name = TempDBName(2) Then
                                                    'char
                                                    If FieldDefs.Type = rdTypeCHAR Or FieldDefs.Type = rdTypeVARCHAR Then
                                                        sSQL = sSQL + "'" + fld.Value + "' where pdfname='" + Item.SubItems(4) + "'"
                                                    Else 'number
                                                        If Len(fld.Value) <> 0 Then
                                                            sSQL = sSQL + fld.Value + " where pdfname='" + Item.SubItems(4) + "'"
                                                        Else
                                                            sSQL = sSQL + "0 where pdfname='" + Item.SubItems(4) + "'"
                                                        End If
                                                    End If
                                                    
                                                    'exit loop
                                                    Exit For
                                                End If
                                            Next FieldDefs
                                            
                                            'exit loop
                                            Exit For
                                        End If
                                    Next TableDefs
                                    
                                    'exit loop
                                    Exit For
                                End If
                            Next
                            
                            If Not bExists Then
                                sSQL = sSQL + "'无'"
                            End If
                            
                            'MsgBox sSQL
                            'update
                            db.Execute (sSQL)                        End If
                    End If
                Loop
                
                Close #FileNumber
                
                'close the resultset
                rs.Close
                
                'process pdf filename and pdf
                Open App.Path + "\" + PDFList(Item.Index - 1) + ".type" For Input As FileNumber
                Do While Not EOF(FileNumber)
                    Line Input #FileNumber, InBuf
                    
                    InBuf = Trim(InBuf)
                    If InBuf <> "" Then
                        info = Split(InBuf, " -> ")
                        
                        If info(0) = "[PDF文件本身]" Then
                            TempDBName = Split(info(1), ".")
                            
                            'the result of query
                            Set rs = db.OpenResultset("select * from " + TempDBName(1) + " where pdfname='" + Item.SubItems(4) + "'", rdOpenKeyset, rdConcurRowVer)
                            
                            If rs.RowCount <> 0 Then
                                rs.Edit
                                DataFile = 100
                                Open App.Path + "\Workspace\" + Item.SubItems(4) For Binary Access Read As DataFile
                                Fl = LOF(DataFile)    ' Length of data in file
                                If Fl = 0 Then Close DataFile: Exit Do
                                Chunks = Fl \ ChunkSize
                                Fragment = Fl Mod ChunkSize
                                rs.rdoColumns(TempDBName(2)).AppendChunk Null
                                ReDim Chunk(Fragment)
                                Get DataFile, , Chunk()
                                rs.rdoColumns(TempDBName(2)).AppendChunk Chunk()
                                ReDim Chunk(ChunkSize)
                                For k = 1 To Chunks
                                   Get DataFile, , Chunk()
                                   rs.rdoColumns(TempDBName(2)).AppendChunk Chunk()
                                Next k
                                Close DataFile
                                rs.Update
                            End If
                            
                            'exit loop
                            Exit Do
                        End If
                    End If
                Loop                db.Close
                ws.Close
                
            'End If
                    
            Set avDoc = Nothing
            
        End If
    Next
    
    Screen.MousePointer = 4
    Unload StoreDBProgress
    MsgBox "注意，PDF文件入库结束！", vbInformation, "注意"
End If
    GoTo Ok
    
quit:    MsgBox "注意，入库过程出现错误，请修改文档的内容！", vbExclamation, "注意"
    Screen.MousePointer = 4
    Unload StoreDBProgressOk:End Sub