Year 2000 in a Nutshell

Errata for Year 2000 in a Nutshell

Submit your own errata for this product.


The errata list is a list of errors and their corrections that were found after the product was released. If the error was corrected in a later version or reprint the date of the correction will be displayed in the column titled "Date Corrected".

The following errata were submitted by our customers and approved as valid errors by the author or editor.

Color Key: Serious Technical Mistake Minor Technical Mistake Language or formatting error Typo Question Note Update



Version Location Description Submitted By Date Submitted Date Corrected
Printed
Page 136
The column labeled Indx1,

reads: 1,1,1,6,6,6,5 Should read: 1,1,1,3,3,3,5

Anonymous   
Printed
Page 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

Anonymous