Found this old sample program written in Turbo Pascal 6. My recollection is that it would process a file received from a factory in Italy and print a report. Notice the first line of code for declaring the amount of memory? Umm…those are BYTES in the first line, as in minimum of 8K, maximum of 384K
{$M 8192, 0, 384000} {************************************************************ Program: ITALYSUM Purpose: Print a list of styles with a summary by style Author : John H. Watson III Compile: Borland Turbo Pascal 6.0 Changed: 11/09/92 John Watson Use extended syntax on WriteLn to format numeric output right-adjusted. (e.g. "PairsNum:5" instead of just "PairsNum"). Changed: 11/15/92 John Watson Added style description to detail & summary print. Removed hardcoding of field lengths in ProcessData and replaced with constants. Replaced hardcoded page titles with constants. Change test of result of collection from "> 0" to "<> -1". Zero is a valid location in the collection and IndexOf will return a -1 if the search doesn't find anything. ************************************************************} PROGRAM ITALYSUM; USES Dos, Printer, Objects, StdPrint; CONST CopyrightText = 'Copyright (c) 1992 by John H. Watson III'; DetailTitle : String = 'Italy Data File Listing - Detail'; SummaryTitle : String = 'Italy Data File Listing - Summary'; VAR CopyrightStr : String[40]; CONST MaxLines = 60; Pagesize = 66; {******************************************************************** Define Objects ********************************************************************} TYPE pSummary = ^TSummary; TSummary = OBJECT(TObject) Pairs : Integer; Style : String[10]; SDesc : String[30]; CONSTRUCTOR Init(iPairs: Integer; iStyle: String; iSDesc: String); PROCEDURE Print; PROCEDURE Accumulate(iPairs: Integer); END; PStyleSummary = ^TStyleSummary; TStyleSummary = OBJECT(TSortedCollection) FUNCTION KeyOf(Item: Pointer): Pointer; VIRTUAL; FUNCTION Compare(Key1, Key2: Pointer): Integer; VIRTUAL; END; {******************************************************************** Global Variables ********************************************************************} VAR ErrorCode : Integer; F : File; GrandTotal : Longint; Path : PathStr; SummaryList : pStyleSummary; { define global instance } VAR FTime : Longint; { file time } FDT : DateTime; { DOS' date/time record structure } {******************************************************************** TSummary Object Methods ********************************************************************} CONSTRUCTOR TSummary.Init(iPairs: Integer; iStyle: String; iSDesc: String); BEGIN TObject.Init; { call ancestor's init first } Pairs := iPairs; Style := iStyle; SDesc := iSDesc; END; PROCEDURE TSummary.Accumulate(iPairs: Integer); BEGIN Pairs := Pairs + iPairs; END; PROCEDURE TSummary.Print; BEGIN WRITELN(LST,Pairs:5, ' ', Style, ' ', SDesc); END; {******************************************************************** TStyleSummary Methods ********************************************************************} { Define the key field for the collection. Since KeyOf expects a pointer and Style is a simple string we must use the "@" (address of) operator to generate the address (pointer). If Style was a pString, this would not be necessary. } FUNCTION TStyleSummary.KeyOf(Item: Pointer): Pointer; BEGIN KeyOf := @pSummary(Item)^.Style; END; FUNCTION TStyleSummary.Compare(Key1, Key2: Pointer): Integer; BEGIN IF pString(Key1)^ = pString(Key2)^ THEN Compare := 0 ELSE IF pString(Key1)^ < pString(Key2)^ THEN Compare := -1 ELSE Compare := +1; END; {******************************************************************** Miscellaneous Procedures and Functions ********************************************************************} FUNCTION OpenFile(VAR F:File; iName:PathStr): BOOLEAN; BEGIN ASSIGN(F, iName); {$I-} RESET(F, 1); {$I+} OpenFile := IOResult = 0; END {Open}; PROCEDURE Initialize; VAR Dir : DirStr; Name : NameStr; Extn : ExtStr; BEGIN CopyrightStr := CopyrightText; IF ParamCount = 0 THEN Path := 'ITALYDTA' ELSE Path := ParamStr(1); Path := FExpand(Path); { expand into full path string } FSplit(Path, Dir, Name, Extn); { split into components } IF (Name = '') OR NOT OpenFile(F, Path) THEN BEGIN WRITELN('ERROR: File not found (', Name, ').'); HALT(1); END; GetFTime(F, FTime); UnpackTime(FTime, FDT); GrandTotal := 0; LineCount := PageSize; SummaryList := New(pStyleSummary, Init(200, 50)); { create collection } END {Initialize}; PROCEDURE Terminate; BEGIN Close(F); Close(LST); Dispose(SummaryList, Done); END; PROCEDURE PrintHeading(iTitle: String); BEGIN IF NOT FirstPrint THEN EjectPage; VerticalTab(1); WriteLn(LST, iTitle); VerticalTab(1); IF FirstPrint THEN BEGIN WriteLn(LST, 'File: ', Path); WriteLn(LST, 'Date: ',FDT.Month,'/',FDT.Day,'/',FDT.Year, ' Time: ',FDT.Hour,':',FDT.Min); VerticalTab(1); END; IF FirstPrint THEN LineCount := 6 ELSE LineCount := LineCount + 3; FirstPrint := False; END; { Use ForEach iterator to display Summary information } PROCEDURE PrintSummary; PROCEDURE PrintSummaryObject(p : pSummary); FAR; BEGIN IF LineCount >= MaxLines THEN BEGIN PrintHeading(SummaryTitle); WriteLn(LST, 'Pairs Style Description'); WriteLn(LST, '----- ---------- -----------'); VerticalTab(1); LineCount := LineCount + 3; END; p^.Print; { Call object's print method } GrandTotal := GrandTotal + p^.Pairs; LineCount := LineCount + 1; END; BEGIN LineCount := MaxLines; { force initial headings to print } SummaryList^.ForEach(@PrintSummaryObject); VerticalTab(1); WriteLn(LST, GrandTotal:5, ' Grand Total'); EjectPage; END; { This procedure will read enough bytes to fill a record buffer. Since the record length exceeds 255 bytes, we cannot use ReadLn to read a record. To overcome this, the file is processed as an untyped file and BlockRead is used to fill the buffer. } PROCEDURE ProcessData; CONST PairsPos : Integer = 578; PairsLen : Integer = 5; OrdNoPos : Integer = 2; OrdNoLen : Integer = 9; RegNoPos : Integer = 131; RegNoLen : Integer = 6; SDescPos : Integer = 588; SDescLen : Integer = 30; StylePos : Integer = 313; StyleLen : Integer = 10; VAR Buffer : ARRAY[1..905] OF Char; { includes two extra bytes for CR/LF } BytesRead : Word; Location : Integer; { location in collection of existing summary object } NewObj, OldObj : pSummary; PairsNum : Integer; PairsStr : String[5]; OrdNo : String[9]; RegNo : String[6]; Style : String[10]; SDesc : String[30]; BEGIN BlockRead(F, Buffer, SizeOf(Buffer), BytesRead); WHILE (NOT EOF(F)) DO BEGIN { Extract individual fields from record buffer } Move(Buffer[StylePos], Style[1], StyleLen); Style[0] := Char(StyleLen); { force the proper string size } Move(Buffer[SDescPos], SDesc[1], SDescLen); SDesc[0] := Char(SDescLen); Move(Buffer[OrdNoPos], OrdNo[1], OrdNoLen); OrdNo[0] := Char(OrdNoLen); Move(Buffer[RegNoPos], RegNo[1], RegNoLen); RegNo[0] := Char(RegNoLen); Move(Buffer[PairsPos], PairsStr[1], PairsLen); PairsStr[0] := Char(PairsLen); Val(PairsStr, PairsNum, ErrorCode); { convert string to numeric } { Print detail line } IF LineCount >= MaxLines THEN BEGIN PrintHeading(DetailTitle); WriteLn(LST, 'Order No Reg No Pairs Style Description'); WriteLn(LST, '--------- ------ ----- ---------- -----------'); VerticalTab(1); LineCount := LineCount + 3; END; WRITELN(LST, OrdNo, ' ', RegNo, ' ', PairsNum:5, ' ', Style, ' ', SDesc); LineCount := LineCount + 1; { Now create a new instance of a summary object with these values } NewObj := New(pSummary, Init(PairsNum, Style, SDesc)); { Search the collection to see if it already exists } Location := SummaryList^.IndexOf(NewObj); IF Location <> -1 THEN BEGIN { If found, accumulate pairs } OldObj := SummaryList^.AT(Location); { get ptr to obj @ location } OldObj^.Accumulate(PairsNum); { call that obj's accumulate method } END ELSE SummaryList^.Insert(NewObj); { else add to collection } BlockRead(F, Buffer, SizeOf(Buffer), BytesRead); END; END {ProcessData}; BEGIN Initialize; ProcessData; PrintSummary; Terminate; END.
