Year 2000 in a Nutshell
by Norman Shakespeare



This errata page lists errors outstanding in the most recent printing.  


If you have any error reports or technical questions, you can send them to
booktech@oreilly.com.  (Please specify the printing date of your copy.)


This page was updated on April 16, 1999.


Here's a key to the markup:

        [page-number]: serious technical mistake
        {page-number}: minor technical mistake
        <page-number>: important language/formatting problem
        (page-number): language change or minor formatting problem
        ?page-number?: reader question or request for clarification



Confirmed errors:


{136} The column labeled Indx1, 

reads:  1,1,1,6,6,6,5

Should read: 1,1,1,3,3,3,5


{281-288} Replace the code after Code Mudule Functions with:

 Option Explicit

Global CurrentFileName$, InputFile1$, OutputFile1$, _
  OutputFileNum1%, InputFileNum1%
Global tt1(5000) As String, tt2(5000) As String
Global LCount1%, Lcount2%
Global Linecounter%
Global EmergencyStop%
Global SStrings(500) As String
Global SSubs(500) As String
Global Findings(5000) As String
Global subsIndex%
Global stringsIndex%
Global i%, Ins$
Global mm2&
Global AppPath      'new & change all app.paths
Global Default_Editor


Sub InitArrays()
    Dim X
    On Error GoTo ErrInitArrays
    'initialise 3 arrays
    'search-strings, subroutine names
    'and output
    For X = 0 To 500
        SStrings(X) = ""
        SSubs(X) = ""
    Next
    For X = 0 To 5000
        Findings(X) = ""
    Next
    stringsIndex = 0
    InputFileNum1 = FreeFile
    'read searchstrings into array
    If Right(AppPath, 1) = "\" Then
       Open AppPath & "SString.txt" For Input As InputFileNum1
    Else
       Open AppPath & "\SString.txt" For Input As InputFileNum1
    End If
    While Not EOF(InputFileNum1)
        Line Input #InputFileNum1, Ins
        Ins = Trim(Ins)
        'next if/end
        If Len(Ins) > 0 Then
            SStrings(stringsIndex) = Ins
            stringsIndex = stringsIndex + 1
        End If
    Wend
    Close InputFileNum1
    subsIndex = 0
    InputFileNum1 = FreeFile
    'read subroutine heading into array
    If Right(AppPath, 1) = "\" Then
       Open AppPath & "SSubs.txt" For Input As InputFileNum1
    Else
       Open AppPath & "\SSubs.txt" For Input As InputFileNum1
    End If
    While Not EOF(InputFileNum1)
        Line Input #InputFileNum1, Ins
        Ins = Trim(Ins)
        'new few
        If Len(Ins) > 0 Then
            SSubs(subsIndex) = Ins
            subsIndex = subsIndex + 1
        End If
    Wend
    Close InputFileNum1
    Exit Sub
ErrInitArrays:
    MsgBox "Error accessing Search Strings " & Err
    Exit Sub
End Sub

Sub Main()
'    Default_Editor = GetProfile("Default_Editor")
'    frmY2K1.Show
End Sub



Function notCurrencyFloat(locc%, sstring$)
    Dim II$, xx%, qq$, kk$, flag%, OFlag%
    Dim locc2%
    If Not (IsNumeric(sstring)) Then
        notCurrencyFloat = True
        Exit Function
    End If
    locc2 = locc
    II = Ins
    'expand funtionality to accommodate
    'variations on 18,19,19xx etc. here
    Do
        OFlag = True
        flag = False
        qq = ""
        xx = 0
        kk = Mid$(II, locc2 + xx, 1)
        'build numeric string inc. decimals
        While kk = "." Or kk = "," Or IsNumeric(kk)
            xx = xx + 1
            qq = qq & kk
            kk = Mid$(II, locc2 + xx, 1)
        Wend
        'occurrence contains a decimal point
        If InStr(qq, ".") > 0 Or InStr(qq, ",") > 0 Then
            flag = True
            OFlag = False
        End If
        If flag Then
            'look at remainder of string
            II = Mid$(II, locc2 + xx, Len(II) - locc2 + xx)
            locc2 = InStr(1, II, sstring, 1)
            If locc2 > 0 Then
                flag = True    'another instance
            Else
                flag = False
            End If
        End If
    Loop While flag
    notCurrencyFloat = OFlag
End Function


Sub MainProcess(way)
    Dim LC%, FC%, k%, X%, subroutine$, FS&, locc%, tt$, _
        CharCase%, dd%, ee%
    Dim ShortOut$
    Dim occtot%, MM&, mm3%
  '  On Error GoTo errMainProcess
    InitArrays
    InputFileNum1 = FreeFile
    LC = 0
    FC = 0
    X = 0
    Open InputFile1 For Input As InputFileNum1
    MM = FileLen(InputFile1)
    frmY2K1.txtBytes.Text = Format(MM, "#,###,###")
    DoEvents
    frmY2K1.txtBytes.Refresh
    mm3 = 0
    frmY2K1.ProgressBar1.Value = 0
    Dim tmp%
    tmp = 0
    'scan whole file
    While Not EOF(InputFileNum1)
        'increment progress bar
        If way Then
            'If mm3 = 10 ^ mm2 Then
                tmp = tmp + 1
                'new next
                If tmp < frmY2K1.ProgressBar1.Max Then
                    frmY2K1.ProgressBar1.Value = tmp
                End If
                'mm3 = 0
            'End If
            'mm3 = mm3 + 1
            DoEvents
        End If
        If EmergencyStop Then GoTo bb:
        'skip past blank lines
        Do
            Line Input #InputFileNum1, Ins
            Ins = Trim(Ins)
        Loop Until (Len(Ins) > 0 Or EOF(InputFileNum1)) _
             And Left(Ins, 1) <> "~"
        LC = LC + 1
        If way Then
            frmY2K1.txtCurrentLOCs.Text = LC
            frmY2K1.txtCurrentLOCs.Refresh
            frmY2K1.txtToTalLocs.Text = _
               frmY2K1.txtToTalLocs.Text + 1
            frmY2K1.txtToTalLocs.Refresh
        End If
        Ins = Trim(Ins)
        Linecounter = Linecounter + 1
        'check if inpur string is a subroutine name
        For i = 0 To subsIndex - 1
            If InStr(1, SSubs(i), Ins, 1) Then
                subroutine = SSubs(i)
                Linecounter = 0
                FC = FC + 1
                If way Then
                    frmY2K1.txtCurrentFuncs.Text = FC
                    frmY2K1.txtCurrentFuncs.Refresh
                    frmY2K1.txtTotalFuncs.Text = _
                       frmY2K1.txtTotalFuncs.Text + 1
                    frmY2K1.txtTotalFuncs.Refresh
                End If
                GoTo AA
            End If
        Next
        If EmergencyStop Then GoTo bb:
        'check input string for date occurrences
        For k = 0 To stringsIndex - 1
            If EmergencyStop Then GoTo bb:
            Ins = UCase(Ins)
            SStrings(k) = UCase(SStrings(k))
            locc = InStr(1, Ins, SStrings(k), 1)
            If locc > 0 Then
                'skip processing if only currentcy float
                If notCurrencyFloat(locc, SStrings(k)) Then
                    'save string containing occurrence,
                    'shorten to first
                    '50 chars if too long
                    Findings(X) = Trim(subroutine) & "--" & Trim(Ins)
                    dd = Len(Findings(X))
                    ee = Len(SStrings(k))
                    If dd > 50 Then
                    ''new 50 to 48
                        Findings(X) = Left$(Findings(X), 48) & _
                        " " & Left$(SStrings(k), 9) & Space(10 - ee) _
                        & " #" & Linecounter
                    Else
                        Findings(X) = Findings(X) & Space(50 - dd) _
                        & " " & Left$(SStrings(k), 9) & Space(10 - ee)
_
                        & " #" & Linecounter
                    End If
                    X = X + 1
                    'update screen
                    If way Then
                        frmY2K1.txtCurrentOCCs.Text = X
                        frmY2K1.txtCurrentOCCs.Refresh
                        frmY2K1.txtToTOCCS.Text = _
                           frmY2K1.txtToTOCCS.Text + 1
                        frmY2K1.txtToTOCCS.Refresh
                    End If
                End If
            Exit For
            End If
        Next
        If EmergencyStop Then GoTo bb:
AA:
    Wend
        frmY2K1.txtCurrentOCCs.Text = X
        frmY2K1.txtCurrentOCCs.Refresh
        'frmY2K1.txtToTOCCS.Text = frmY2K1.txtToTOCCS.Text + x
        frmY2K1.txtToTOCCS.Refresh
        frmY2K1.txtToTalFiles.Text = frmY2K1.txtToTalFiles.Text + 1
        frmY2K1.txtToTalFiles.Refresh
bb:
        Close InputFileNum1
            If X > 1 Then
            'dump findings array to file
            OutputFileNum1 = FreeFile
            'new few
            If Len(CurrentFileName) > 6 Then
                OutputFile1 = Left(CurrentFileName, _
                (Len(CurrentFileName) - 2)) & _
                frmY2K1.txtToTalFiles.Text & ".txt"
            Else
                OutputFile1 = CurrentFileName & _
                   frmY2K1.txtToTalFiles.Text & ".txt"
            End If
            'new next 20..
            Dim tDir$, Myname$, MyPath, FoundFlag
            If Right(AppPath, 1) = "\" Then
               MyPath = AppPath
            Else
               MyPath = AppPath & "\"
            End If
            Myname = Dir(MyPath, vbDirectory)
            'Retrieve the first entry.
            FoundFlag = False
            Do While Myname <> "" And Not (FoundFlag)
            'Start the loop.
            'Ignore the current directory and the
            'encompassing directory.
                If Myname <> "." And Myname <> ".." Then
                'Use bitwise comparison to make sure
                'MyName is a directory.
                    If (GetAttr(MyPath & Myname) And vbDirectory) _
                        = vbDirectory Then
                        If Myname = "OUTFILES" Then
                            FoundFlag = True
                        End If
                    End If
                End If
                Myname = UCase(Dir)    ' Get next entry.
            Loop
            If FoundFlag Then
               If Right(AppPath, 1) = "\" Then
                  Open AppPath & "outfiles\" & OutputFile1 _
                    For Output As OutputFileNum1
               Else
                  Open AppPath & "\outfiles\" & OutputFile1 _
                    For Output As OutputFileNum1
               End If
            Else
                If Right(AppPath, 1) = "\" Then
                   MkDir AppPath & "outfiles"
                   Open AppPath & "outfiles\" & OutputFile1 _
                     For Output As OutputFileNum1
                Else
                   MkDir AppPath & "\outfiles"
                   Open AppPath & "\outfiles\" & OutputFile1 _
                     For Output As OutputFileNum1
                End If
            End If
            Write #OutputFileNum1, OutputFile1
            Write #OutputFileNum1, ""
            Write #OutputFileNum1, ""
            For i = 0 To X - 1
                Write #OutputFileNum1, Findings(i)
                k = Len(Findings(i))
            Next
            Close OutputFileNum1
        End If
        Exit Sub
errMainProcess:
    MsgBox "Error in MainProccess " & Err & " was generated by " _
            & Err.Source & Chr(13) & Err.Description
    Exit Sub
End Sub


Sub Setup(way%)

Dim intCtr As Integer
Dim lngPos As Long, lngStart As Long
Dim strPath As String, strTemp As String
Dim strFile() As String
    '"way" indicates display method for scan process
    '0 = fast dont update screen every line
    '1 = slow, update screen every line
    Dim Myname$, MyPath$, X%, Y&, TotalBytes&
    AppPath = App.Path
    frmY2K1.mnuInputFiles.Enabled = False
    frmY2K1.cmdStop.Enabled = True
    'init counters
    frmY2K1.txtToTalLocs.Text = 0
    frmY2K1.txtToTalFiles.Text = 0
    frmY2K1.txtToTOCCS.Text = 0
    frmY2K1.txtTotalFuncs.Text = 0
    EmergencyStop = False
intCtr = 0
TotalBytes = 0
strTemp = frmY2K1.cdlgOpen.FileName
frmY2K1.cdlgOpen.FileName = ""
lngPos = InStr(1, strTemp, Chr$(0))
If lngPos > 0 Then
   strPath = Left(strTemp, lngPos - 1)
   ' Parse files
   lngStart = lngPos + 1
   Do
      ReDim Preserve strFile(intCtr)
      lngPos = InStr(lngStart, strTemp, Chr(0))
      If lngPos > 0 Then
         strFile(intCtr) = Mid(strTemp, lngStart, lngPos - lngStart)
         lngStart = lngPos + 1
      Else
         strFile(intCtr) = Mid(strTemp, lngStart)
      End If
      intCtr = intCtr + 1
   Loop While lngPos > 0
Else
   lngPos = 1
   ReDim strFile(0)
   Do While lngPos > 0
      lngPos = InStr(lngPos, strTemp, "\")
      If lngPos > 0 Then
         strPath = Left(strTemp, lngPos - 1)
         strFile(0) = Mid(strTemp, lngPos + 1)
         lngPos = lngPos + 1
      End If
   Loop
End If
'for all selected files in the list
' get filesize
For intCtr = 0 To UBound(strFile)
   If Right(strPath, 1) = "\" Then
      Y = FileLen(strPath & strFile(intCtr))
   Else
       Y = FileLen(strPath & "\" & strFile(intCtr))
   End If
   TotalBytes = TotalBytes + Y
   'if file too big, exit
   If Y > 5000000 Then
      MsgBox "Individual File Size Limit of 5MB exceeded (" &
strFile(intCtr) & ") - Processing " & InputFile1 & " Aborted"
      frmY2K1.mnuprocess.Enabled = False
      frmY2K1.mnuInputFiles.Enabled = True
      Exit Sub
   End If
Next
    'format display
    frmY2K1.txtToTbytes = Format(TotalBytes, "#,###,###")
    'either setup progress bar limits or delay message
    If way Then
        mm2 = 0
        TotalBytes = TotalBytes / 28      'LOCs > 100
        While TotalBytes > 100
            TotalBytes = TotalBytes / 10
            mm2 = mm2 + 1
        Wend
        'frmY2K1.ProgressBar1.Max = TotalBytes
    Else
        Dim tmp%, hrs%, mins%
        tmp = TotalBytes / 3000
        hrs = tmp \ 3600
        mins = tmp \ 60
        If mins = 0 Then mins = 1
        If hrs > 1 Then
            MsgBox "This process could take up to " & hrs & " hour/s"
        Else
            MsgBox "This process could take " & mins & " minute/s"
        End If
    End If
frmY2K1.MousePointer = 11
'scan all files
For X = 0 To UBound(strFile)
   If EmergencyStop Then Exit For
   If Right(strPath, 1) = "\" Then
      InputFile1 = strPath & strFile(X)
   Else
       InputFile1 = strPath & "\" & strFile(X)
   End If
   CurrentFileName = strFile(X)
            ''new one
            CurrentFileName = Left(CurrentFileName, (InStr(1,
CurrentFileName, ".") - 1))
   frmY2K1.txtCurrentLOCs.Text = 0
   frmY2K1.txtCurrentOCCs.Text = 0
   frmY2K1.txtCurrentFuncs.Text = 0
   frmY2K1.Label8(4) = InputFile1
   MainProcess (way)
   DoEvents
Next

Beep:    Beep
    If EmergencyStop Then
        MsgBox "Process Aborted", 64
    Else
        MsgBox "Done", 64
    End If
    frmY2K1.ProgressBar1.Value = 0
    frmY2K1.MousePointer = 0
    frmY2K1.cmdStop.Enabled = False
    frmY2K1.mnuInputFiles.Enabled = True
    frmY2K1.mnuprocess.Enabled = False

End Sub


Function GetProfile(KeyName)
  Dim fnum As Integer
  Dim temp As String

  On Error GoTo Err_GetProfile

  fnum = FreeFile
  If Right(App.Path, 1) = "\" Then
     Open App.Path & "Year-2000.ini" For Input As fnum
  Else
     Open App.Path & "\" & "Year-2000.ini" For Input As fnum
  End If
  While Not EOF(fnum) And InStr(temp, KeyName) <> 1
    Line Input #fnum, temp
    If Left$(temp, 1) = "'" Then temp = ""  'comments
  Wend
  If InStr(temp, KeyName) = 1 Then
    GetProfile = Right(temp, (Len(temp) - InStr(temp, "=")))
  Else
    MsgBox KeyName & " not found in Year-2000.ini"
    GetProfile = ""
  End If
Exit_GetProfile:
  Close
  Exit Function
Err_GetProfile:
   MsgBox "Error # " & Str(Err.Number) & " was generated by " _
     & Err.Source & Chr(13) & Err.Description & " in GetProfile _
     while trying to open Year-2000.ini - possibly file not found?"
   Resume Exit_GetProfile
End Function