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.
