temp.bas

Some scheduling software.

'                        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
'
'