temp.bas

Some scheduling software.

Attribute VB_Name = "temp"
Option Explicit


'    Write #fnum, "Eye-Care V1.00" & Chr(10)
'    Write #fnum, "Creation Date " & Date & Chr(10)
'    str =
'    Close #fnum
'    WriteInitial = True
'    Exit Function
'
'ErrorHandle:
'    Close #fnum
'    WriteInitial = False
'    ErrorLog "Error in function WriteInitial(" & str & ")"
'    Exit Function
'End Function
'End Function
'
'
'Public Function FG2_Select()
'' Select a cell and display Title, Author, Subject and Keywords in
'' the textboxes.
'Dim lRow As Long, lRows As Long
'Dim i As Integer
'    On Error GoTo ErrorHandle
'    With frmPDFBrowser
'        lRow = .FlexGrid1.row
'        lRows = .FlexGrid1.Rows
'        If lRow <> 0 And lRow <> lRows - 1 Then
'            .lblFileName = .FlexGrid1.TextMatrix(lRow, 1)
'            .txtTitle = .FlexGrid1.TextMatrix(lRow, 2)
'            .txtAuthor = .FlexGrid1.TextMatrix(lRow, 3)
'            .txtSubject = .FlexGrid1.TextMatrix(lRow, 4)
'            .txtKeywords = .FlexGrid1.TextMatrix(lRow, 5)
'        End If
'    End With
'
'    Exit Function
'ErrorHandle:
'    ErrorLog "Error in function FG2_Select()"
'    Exit Function
'End Function
'
'Public Function Add2Collection() As Boolean
'' Catches the selected row in FlexGrid and deposit into FlexGrid1
'Dim lRow As Long, lRow1 As Long, iCol As Integer, iCol1 As Integer
'Dim i As Long, InCollection As Boolean
'Dim lRows As Long, lRows1 As Long, iCols As Integer, iCols1 As Integer
'Dim boo As Boolean
'    On Error GoTo ErrorHandle
'    lRow = frmPDFBrowser.FlexGrid.row
'    iCol = frmPDFBrowser.FlexGrid.col
'    lRows1 = frmPDFBrowser.FlexGrid1.Rows
'    iCols1 = frmPDFBrowser.FlexGrid1.Cols
'    InCollection = False
'    With frmPDFBrowser
'        For i = 1 To lRows1 - 2
'            If .FlexGrid1.TextMatrix(i, 1) = .FlexGrid.TextMatrix(lRow, 1) Then
'                InCollection = True
'            End If
'        Next i
'        If InCollection = False Then
'            .FlexGrid1.Rows = lRows1 + 1
'            .FlexGrid1.TextMatrix(lRows1 - 1, 0) = lRows1 - 1
'            .FlexGrid1.TextMatrix(lRows1 - 1, 1) = .FlexGrid.TextMatrix(lRow, 1)
'            .FlexGrid1.TextMatrix(lRows1 - 1, 2) = .FlexGrid.TextMatrix(lRow, 2)
'            .FlexGrid1.TextMatrix(lRows1 - 1, 3) = .FlexGrid.TextMatrix(lRow, 3)
'            .FlexGrid1.TextMatrix(lRows1 - 1, 4) = .FlexGrid.TextMatrix(lRow, 4)
'            .FlexGrid1.TextMatrix(lRows1 - 1, 5) = .FlexGrid.TextMatrix(lRow, 5)
'            boo = WriteRecords(frmPDFBrowser.strCollName, .FlexGrid1, True)
'        End If
'    End With
'    Add2Collection = True
'
'    Exit Function
'ErrorHandle:
'    Add2Collection = False
'    ErrorLog "Error in function Add2Collection()"
'    Exit Function
'End Function
'
'Public Function OpenPDF()
'' Open selected row in FlexGrid and FlexGrid and opens in PDF Reader
'Dim lRow As Integer
'Dim str As String
'
'    On Error GoTo ErrorHandle
'    With objFG
'        lRow = .row
'        If lRow <> 0 And lRow <> .Rows - 1 Then
'            str = Trim(.TextMatrix(lRow, 1))
'            If str <> "" Then
'                frmPDFBrowser.pdfdoc.LoadFile Trim(str)
'                frmPDFBrowser.SSTab.Tab = 1
'                strOpenPDF = str
'                frmPDFBrowser.Caption = "Open File ... " & str
'                frmPDFBrowser.Refresh
'            End If
'        End If
'    End With
'    Exit Function
'
'ErrorHandle:
'    ErrorLog "Error in function OpenPDF()"
'    Exit Function
'End Function
'
'Public Function DeleteList(objFG As MSFlexGrid)
'' Deletes selected row.
'Dim lRows As Long, iCols As Integer
'Dim lRow As Long, iCol As Integer
'Dim i As Long
'
'    On Error GoTo ErrorHandle
'    With objFG
'        lRows = .Rows
'        iCols = .Cols
'        lRow = .row
'        iCol = .col
'        If lRow <> lRows - 1 Then
'            For i = lRow To lRows - 2
'                .TextMatrix(i, 1) = .TextMatrix(i + 1, 1)
'                .TextMatrix(i, 2) = .TextMatrix(i + 1, 2)
'                .TextMatrix(i, 3) = .TextMatrix(i + 1, 3)
'                .TextMatrix(i, 4) = .TextMatrix(i + 1, 4)
'                .TextMatrix(i, 5) = .TextMatrix(i + 1, 5)
'            Next i
'            .Rows = lRows - 1
'            WriteRecords Dir1.path, objFG
'        Else: End If
'    End With
'
'    Exit Function
'ErrorHandle:
'    ErrorLog "Error in function DeleteList()"
'    Exit Function
'End Function
'
'
'Public Function loadPDF(path As String, bolInclude As Boolean)
'Dim row As Long, col As Integer, i As Integer, j As Long
'Dim tmp As Variant
'Dim fol As Folder
'Dim fso As New FileSystemObject
'Dim fols As Folders
'Dim fils As Files
'Dim fil As File
'Dim tmp_arr(5) As String
'Dim InCollection As Boolean
'
'    On Error GoTo ErrorHandle
'
'    Set fol = fso.GetFolder(path)
'    Set fols = fol.SubFolders
'    Set fils = fol.Files
'
'    ReDim exten(0) As String
'    exten(0) = "pdf"
'
'    For Each fil In fils
'        DoEvents
'        For i = LBound(exten) To UBound(exten)
'            DoEvents
'            If fso.GetExtensionName(fil.path) = exten(i) Then
'                With frmPDFBrowser
'                    .lblIndicator.Caption = fol.path & "\" & fil.Name
'                    .Refresh
'                    row = .FlexGrid.Rows
'                    col = .FlexGrid.Cols
'
'                    InCollection = False
'                    For j = 1 To .FlexGrid1.Rows - 2
'                        If .FlexGrid1.TextMatrix(j, 1) = fil.path Then
'                            tmp_arr(0) = .FlexGrid1.TextMatrix(j, 1)
'                            tmp_arr(1) = .FlexGrid1.TextMatrix(j, 2)
'                            tmp_arr(2) = .FlexGrid1.TextMatrix(j, 3)
'                            tmp_arr(3) = .FlexGrid1.TextMatrix(j, 4)
'                            tmp_arr(4) = .FlexGrid1.TextMatrix(j, 5)
'                            tmp = tmp_arr
'                            InCollection = True
'                        End If
'                    Next j
'
'                    If Not InCollection Then
'                        tmp = ExtractDocInfo(fil.path)
'                    End If
'
'                    .FlexGrid.Rows = row + 1
'                    .FlexGrid.Cols = 6
'                    .FlexGrid.TextMatrix(row - 1, 0) = row - 1
'                    .FlexGrid.TextMatrix(row - 1, 1) = fil.path
'                    .FlexGrid.TextMatrix(row - 1, 2) = tmp(1)
'                    .FlexGrid.TextMatrix(row - 1, 3) = tmp(2)
'                    .FlexGrid.TextMatrix(row - 1, 4) = tmp(3)
'                    .FlexGrid.TextMatrix(row - 1, 5) = tmp(4)
'    '                .FlexGrid.CellWidth = Int(.FlexGrid.Width / 5)
'                    Set tmp = Nothing
'                End With
'            End If
'        Next i
'        DoEvents
'    Next fil
'
'    If bolInclude Then
'        For Each fol In fols
'            loadPDF fol.path, bolInclude
'        Next
'    End If
'
'    Exit Function
'ErrorHandle:
'    ErrorLog "Error in function loadPDF()"
'    Exit Function
'End Function
'
'Public Function ExtractDocInfo(str As String) As Variant
'' This module extracts Author, Subject, Title, and Keyword
'' from file str. ExtractDocInfo is returned as a 4 element
'' string array. If any element is not found, an empty string.
'
'Dim i As Integer, j As Integer, slice As Integer
'Dim L1 As Long, L2 As Long, L3 As Integer
'Dim str1 As String
'Dim str2 As String * 512
'Dim str3 As String * 8
'Dim ver As String
'Dim T1 As Integer, T2 As Integer, T3 As Integer, T4 As Integer
'Dim tmp(4) As String
'
'    On Error GoTo ErrorHandle
'    tmp(1) = ""
'    tmp(2) = ""
'    tmp(3) = ""
'    tmp(4) = ""
'    T1 = 0
'    T2 = 0
'    T3 = 0
'    T4 = 0
'
'    If Dir(str) <> "" Then
'        slice = 512
'        j = Int(FileLen(str) / slice)
'        j = j + 1
'
'        Open str For Binary Access Read As #1
'
'        Get #1, , str3
'        If (str3 = "%PDF-1.4") Then
'            ver = "1.4"
'        ElseIf (str3 = "%PDF-1.2") Then
'            ver = "1.2"
'        End If
'
'        For i = 1 To j
'            Get #1, , str2
'
'            If ver = "1.2" Then
'                L1 = InStr(1, str2, "/Title (", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, ")", vbBinaryCompare)
'                    L3 = Len("/Title (")
'                    If L1 <> 0 And L2 <> 0 Then
'                        tmp(1) = Mid(str2, L1 + L3, L2 - L3 - L1)
'                        T1 = 1
'                        If (T1 + T2 + T3 + T4 = 4) Then
'                            Close 1
'                            ExtractDocInfo = tmp
'                            Exit Function
'                        End If
'                    End If
'                End If
'
'                L1 = InStr(1, str2, "/Author (", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, ")", vbBinaryCompare)
'                    L3 = Len("/Author (")
'                    If L1 <> 0 And L2 <> 0 Then
'                        tmp(2) = Mid(str2, L1 + L3, L2 - L3 - L1)
'                        T2 = 1
'                        If (T1 + T2 + T3 + T4 = 4) Then
'                            Close 1
'                            ExtractDocInfo = tmp
'                            Exit Function
'                        End If
'                    End If
'                End If
'
'                L1 = InStr(1, str2, "/Subject (", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, ")", vbBinaryCompare)
'                    L3 = Len("/Subject (")
'                    If L1 <> 0 And L2 <> 0 Then
'                        tmp(3) = Mid(str2, L1 + L3, L2 - L3 - L1)
'                        T3 = 1
'                        If (T1 + T2 + T3 + T4 = 4) Then
'                            Close 1
'                            ExtractDocInfo = tmp
'                            Exit Function
'                        End If
'                    End If
'                End If
'
'                L1 = InStr(1, str2, "/Keywords (", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, ")", vbBinaryCompare)
'                    L3 = Len("/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
'
'                DoEvents
'            ElseIf ver = "1.4" Then
'                L1 = InStr(1, str2, "<pdf:Title>", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, "</pdf:Title>", vbBinaryCompare)
'                    L3 = Len("<pdf:Title>")
'                    If L1 <> 0 And L2 <> 0 Then
'                        tmp(1) = Mid(str2, L1 + L3, L2 - L3 - L1)
'                        T1 = 1
'                        If (T1 + T2 + T3 + T4 = 4) Then
'                            Close 1
'                            ExtractDocInfo = tmp
'                            Exit Function
'                        End If
'                    End If
'                End If
'
'                L1 = InStr(1, str2, "<pdf:Author>", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, "</pdf:Author>", vbBinaryCompare)
'                    L3 = Len("<pdf:Author>")
'                    If L1 <> 0 And L2 <> 0 Then
'                        tmp(2) = Mid(str2, L1 + L3, L2 - L3 - L1)
'                        T2 = 1
'                        If (T1 + T2 + T3 + T4 = 4) Then
'                            Close 1
'                            ExtractDocInfo = tmp
'                            Exit Function
'                        End If
'                    End If
'                End If
'
'                L1 = InStr(1, str2, "<pdf:Subject>", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, "</pdf:Subject>", vbBinaryCompare)
'                    L3 = Len("<pdf:Subject>")
'                    If L1 <> 0 And L2 <> 0 Then
'                        tmp(3) = Mid(str2, L1 + L3, L2 - L3 - L1)
'                        T3 = 1
'                        If (T1 + T2 + T3 + T4 = 4) Then
'                            Close 1
'                            ExtractDocInfo = tmp
'                            Exit Function
'                        End If
'                    End If
'                End If
'
'                L1 = InStr(1, str2, "<pdf:Keywords>", vbBinaryCompare)
'                If L1 <> 0 Then
'                    L2 = InStr(L1, str2, "</pdf:Keywords>", vbBinaryCompare)
'                    L3 = Len("<pdf:Keywords>")
'                    If L1 <> 0 And L2 <> 0 Then