src.txt.bak

Some scheduling software.

                    L2 = InStr(L1, str2, "</pdf:Keywords>", vbBinaryCompare)
                    L3 = Len("<pdf:Keywords>")
                    If L1 <> 0 And L2 <> 0 Then
                        tmp(4) = Mid(str2, L1 + L3, L2 - L3 - L1)
                        T4 = 1
                        If (T1 + T2 + T3 + T4 = 4) Then
                            Close 1
                            ExtractDocInfo = tmp
                            Exit Function
                        End If
                    End If
                End If
            End If
        Next i
    End If
    Close 1
    ExtractDocInfo = tmp
    
    Exit Function
    
ErrorHandle:
    ExtractDocInfo = tmp
    Close 1
    ErrorLog "Error in function ExtractDocInfo()"
    Exit Function
End Function

Public Function WriteRecords(str As String, objFlexGrid As MSFlexGrid, Optional booPathIsFileName As Boolean) As Boolean
Dim i As Long, j As Integer
Dim lRows As Long, iCols As Integer
Dim strFileName As String
Dim strTemp As String
Dim fnum As Integer

    On Error GoTo ErrorHandle
    
    If booPathIsFileName = True Then
        strFileName = str
    Else
        strFileName = str
        j = InStr(1, strFileName, "\", vbBinaryCompare)
        While (j <> 0)
            strTemp = strFileName
            If j <> Len(strFileName) Then
                strFileName = Mid(strTemp, 1, j - 1) & "_" & Mid(strTemp, j + 1, Len(strTemp) - j)
            Else
                strFileName = Mid(strTemp, 1, j - 1)
            End If
            j = InStr(1, strFileName, "\", vbBinaryCompare)
        Wend
        
        j = InStr(1, str, ":", vbBinaryCompare)
        While (j <> 0)
            strTemp = strFileName
            If j <> Len(strFileName) Then
                strFileName = Mid(strTemp, 1, j - 1) & Mid(strTemp, j + 1, Len(strTemp) - j)
            Else
                strFileName = Mid(strTemp, 1, j - 1)
            End If
            j = InStr(1, strFileName, ":", vbBinaryCompare)
        Wend
        
        strFileName = App.path & "\data\" & strFileName & ".dap"
    End If
    
    boo = WriteInitial(strFileName)
    If boo = True Then
        lRows = objFlexGrid.Rows
        iCols = objFlexGrid.Cols
        fnum = FreeFile
        Open strFileName For Append As fnum
        With objFlexGrid
            For i = 1 To lRows - 1
                If Trim(.TextMatrix(i, 1)) <> "" Then
                    strTemp = "<FileName> " & .TextMatrix(i, 1) & "</FileName>"
                    strTemp = IIf(Trim(.TextMatrix(i, 2)) = "", strTemp, strTemp & "<Title> " & .TextMatrix(i, 2) & "</Title>")
                    strTemp = IIf(Trim(.TextMatrix(i, 3)) = "", strTemp, strTemp & "<Author> " & .TextMatrix(i, 3) & "</Author>")
                    strTemp = IIf(Trim(.TextMatrix(i, 4)) = "", strTemp, strTemp & "<Subject> " & .TextMatrix(i, 4) & "</Subject>")
                    strTemp = IIf(Trim(.TextMatrix(i, 5)) = "", strTemp, strTemp & "<Keywords> " & .TextMatrix(i, 5) & "</Keywords>")
                    Write #fnum, strTemp & Chr(10)
                End If
            Next i
        End With
        DoEvents
        Close #fnum
    Else: End If
    
    Exit Function

ErrorHandle:
    Close #fnum
    WriteRecords = False
    ErrorLog "Error in function WriteRecords()"
    Exit Function
End Function

Public Function WriteInitial(str As String) As Boolean
' First 16 lines are used as document information
Dim fnum As Integer

    On Error GoTo ErrorHandle
    fnum = FreeFile
    Open str For Output As fnum

    Write #fnum, "PDF Browser V1.00" & Chr(10)
    Write #fnum, "Creation Date " & Date & Chr(10)
    Write #fnum, "Creator " & "NIL " & Chr(10)
    Write #fnum, "Allowed List: " & "NIL " & Chr(10)
    
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    Write #fnum, "Empty Line " & Chr(10)
    
    Close #fnum
    WriteInitial = True
    Exit Function

ErrorHandle:
    Close #fnum
    WriteInitial = False
    ErrorLog "Error in function WriteInitial(" & str & ")"
    Exit Function
End Function

Public Function LoadData(str As String, objFlexGrid As MSFlexGrid, Optional strIsCollName As Boolean) As Boolean
Dim strFileName As String, strTemp As String, strTemp1 As String
Dim i As Long, j As Integer
Dim fnum As Integer
Dim L1 As Integer, L2 As Integer, L3 As Integer
Dim A1 As Integer

    On Error GoTo ErrorHandle
    If strIsCollName = True Then
        strFileName = str
    Else
        strFileName = str
        j = InStr(1, strFileName, "\", vbBinaryCompare)
        While (j <> 0)
            strTemp = strFileName
            If j <> Len(strFileName) Then
                strFileName = Mid(strTemp, 1, j - 1) & "_" & Mid(strTemp, j + 1, Len(strTemp) - j)
            Else
                strFileName = Mid(strTemp, 1, j - 1)
            End If
            j = InStr(1, strFileName, "\", vbBinaryCompare)
        Wend
        
        j = InStr(1, str, ":", vbBinaryCompare)
        While (j <> 0)
            strTemp = strFileName
            If j <> Len(strFileName) Then
                strFileName = Mid(strTemp, 1, j - 1) & Mid(strTemp, j + 1, Len(strTemp) - j)
            Else
                strFileName = Mid(strTemp, 1, j - 1)
            End If
            j = InStr(1, strFileName, ":", vbBinaryCompare)
        Wend
        strFileName = App.path & "\data\" & strFileName & ".dap"
    End If
        
    If strFileName = "" Then
        LoadData = False
        GoTo ErrorHandle
    End If
    
    i = 2
    fnum = FreeFile
    Open strFileName For Input As fnum
    With objFlexGrid
        While Not EOF(fnum)
            Input #fnum, strTemp
            A1 = 0
            
            .TextMatrix(i - 1, 0) = i - 1
            
            L1 = InStr(1, strTemp, "<FileName> ", vbBinaryCompare)
            L2 = InStr(1, strTemp, "</FileName>", vbBinaryCompare)
            L3 = Len("<FileName> ")
            If L1 <> 0 And L2 <> 0 Then
                strTemp1 = Mid(strTemp, L1 + L3, L2 - L1 - L3)
                .TextMatrix(i - 1, 1) = strTemp1
                A1 = 1
            End If
            
            L1 = InStr(1, strTemp, "<Title> ", vbBinaryCompare)
            L2 = InStr(1, strTemp, "</Title>", vbBinaryCompare)
            L3 = Len("<Title> ")
            If L1 <> 0 And L2 <> 0 Then
                strTemp1 = Mid(strTemp, L1 + L3, L2 - L1 - L3)
                .TextMatrix(i - 1, 2) = strTemp1
            End If
            
            L1 = InStr(1, strTemp, "<Author> ", vbBinaryCompare)
            L2 = InStr(1, strTemp, "</Author>", vbBinaryCompare)
            L3 = Len("<Author> ")
            If L1 <> 0 And L2 <> 0 Then
                strTemp1 = Mid(strTemp, L1 + L3, L2 - L1 - L3)
                .TextMatrix(i - 1, 3) = strTemp1
            End If
            
            L1 = InStr(1, strTemp, "<Subject> ", vbBinaryCompare)
            L2 = InStr(1, strTemp, "</Subject>", vbBinaryCompare)
            L3 = Len("<Subject> ")
            If L1 <> 0 And L2 <> 0 Then
                strTemp1 = Mid(strTemp, L1 + L3, L2 - L1 - L3)
                .TextMatrix(i - 1, 4) = strTemp1
            End If
            
            L1 = InStr(1, strTemp, "<Keywords> ", vbBinaryCompare)
            L2 = InStr(1, strTemp, "</Keywords>", vbBinaryCompare)
            L3 = Len("<Keywords> ")
            If L1 <> 0 And L2 <> 0 Then
                strTemp1 = Mid(strTemp, L1 + L3, L2 - L1 - L3)
                .TextMatrix(i - 1, 5) = strTemp1
            End If
            
            If A1 = 1 Then
                i = i + 1
                .Rows = i
            End If
        Wend
    End With
    DoEvents
    Close #fnum
    LoadData = True
    
    Exit Function
ErrorHandle:
    Close #fnum
    LoadData = False
    ErrorLog "Error in function LoadData()"
    Exit Function
End Function

Public Function ErrorLog(str As String)
' This function logs all errors
Dim fnum As Integer
    On Error GoTo ErrorHandle
    fnum = FreeFile
    Open "error.log" For Append As fnum
    Write #fnum, str & Chr(10)
    Close #fnum
    Exit Function
ErrorHandle:
    Close #fnum
    Exit Function
End Function

Public Function FormResize()
    
    On Error GoTo ErrorHandle
    With frmPDFBrowser
        If .Height <= 5000 Or .Width <= 5000 Then
    '        .Height = 12000
    '        .Width = 12000
        Else
            .SSTab.Height = .Height - 700
            .SSTab.Width = .Width - 350
            .FlexGrid.Width = .SSTab.Width - 300
            .FlexGrid.Height = .SSTab.Height - .frameFolder.Height - 500
            .frameFolder.Top = .FlexGrid.Top + .FlexGrid.Height
            .frameFolder.Left = .FlexGrid.Left
            .FrameProgress.Left = .frameFolder.Left + .frameFolder.Width + 100
            .FrameProgress.Top = .frameFolder.Top
            .pdfdoc.Width = .SSTab.Width - 300
            .pdfdoc.Height = .SSTab.Height - 500
            .FrameProgress.Width = .FlexGrid.Width - .frameFolder.Width - 100
            .lblIndicator.Width = .FrameProgress.Width - 200
            .txtField.Width = .lblIndicator.Width
            .cmdSaveChanges.Left = .txtField.Left + .txtField.Width - .cmdSaveChanges.Width
            
            .FlexGrid1.Width = .SSTab.Width - 300
            .FlexGrid1.Height = .SSTab.Height - .frameDocInfo.Height - 500
            .frameDocInfo.Top = .FlexGrid1.Top + .FlexGrid1.Height
            .frameDocInfo.Left = .FlexGrid1.Left
            .frameDocInfo.Width = .FlexGrid1.Width
            .txtTitle.Left = .frameDocInfo.Left
            .txtTitle.Width = .frameDocInfo.Width / 4 - 50
            .txtAuthor.Left = .txtTitle.Left + .txtTitle.Width
            .txtAuthor.Width = .txtTitle.Width
            .txtSubject.Left = .txtAuthor.Left + .txtAuthor.Width
            .txtSubject.Width = .txtAuthor.Width
            .txtKeywords.Left = .txtSubject.Left + .txtSubject.Width
            .txtKeywords.Width = .txtSubject.Width
            .lblTitle.Left = .txtTitle.Left
            .lblAuthor.Left = .txtAuthor.Left
            .lblSubject.Left = .txtSubject.Left
            .lblKeywords.Left = .txtKeywords.Left
            .lblFileName.Width = .frameDocInfo.Width - .cmdSaveCatalog.Width - 300
            .cmdSaveCatalog.Left = .lblFileName.Left + .lblFileName.Width + 100
            .SSTab.Tab = 1
            .Refresh
            .SSTab.Tab = 2
            .Refresh
            .SSTab.Tab = 0
            .Refresh
        End If
    End With
    
    Exit Function
ErrorHandle:
    ErrorLog "Error in function FormResize()"
    Exit Function
End Function

Public Function Initialize()
' Initialises program state
Dim str As String
Dim boo As Boolean
    
    On Error GoTo ErrorHandle
    FormResize
    ResetFlexGrid frmPDFBrowser.FlexGrid
    ResetFlexGrid frmPDFBrowser.FlexGrid1
    
    str = GetSetting("AcrobatBrowser", "data", "Last Accessed Collection")
    If str = "" Then
        str = App.path & "data\default.dap"
        WriteRecords str, frmPDFBrowser.FlexGrid1, True
        frmPDFBrowser.strCollName = str
    Else
        boo = LoadData(str, frmPDFBrowser.FlexGrid1, True)
        If boo Then
            frmPDFBrowser.strCollName = str
        Else
            frmPDFBrowser.strCollName = "default.dap"
        End If
    End If
    DoEvents
    Exit Function
    
ErrorHandle:
    ErrorLog "Error in function Initialize()"
    Exit Function
End Function


Public Function ResetFlexGrid(objFlexGrid As MSFlexGrid)
' Reset FlexGrid state.
    On Error GoTo ErrorHandle
    With objFlexGrid
        .Rows = 2
        .Cols = 6
        .WordWrap = True
        .TextMatrix(0, 1) = "File Name"
        .TextMatrix(0, 2) = "Title"
        .TextMatrix(0, 3) = "Author"
        .TextMatrix(0, 4) = "Subject"
        .TextMatrix(0, 5) = "Keywords"
'       .CellWidth = 1000
    End With
    
    Exit Function
ErrorHandle:
    ErrorLog "Error in function ResetFlexGrid()"
    Exit Function
End Function