Category : Files from Magazines
Archive   : VOL8N5.ZIP
Filename : BLCKRD.PAS
TYPE ProductT = RECORD
Part_Number : Integer;
Stock : Integer;
Price : Real;
Description : STRING[20];
(* ...
Other fields here ...
*)
END;
VAR
Product : ProductT;
Product_File : FILE OF ProductT;
APrice : Real;
FUNCTION Standard_Inventory_Value : Real;
(* File must be RESET before calling this function *)
VAR
Value : Real;
BEGIN
Seek(Product_File, 0); Value := 0.0;
WHILE NOT Eof(Product_File) DO
BEGIN
Read(Product_File, Product);
Value := Value+Product.Price*Product.Stock;
END;
Standard_Inventory_Value := Value;
END;
FUNCTION My_Inventory_Value : Real;
CONST BufferSize = 500;
VAR
Buffer : ARRAY[1..BufferSize] OF ProductT;
F : FILE ABSOLUTE Product_File;
Value : Real;
i, RecsInBuffer : Integer;
BEGIN
Seek(F, 0); Value := 0.0;
WHILE NOT Eof(F) DO
BEGIN
BlockRead(F, Buffer, BufferSize, RecsInBuffer);
FOR i := 1 TO RecsInBuffer DO
Value := Value+Buffer[i].Price*Buffer[i].Stock;
END;
My_Inventory_Value := Value;
END;
BEGIN
WriteLn('This program is strictly a demonstration.');
WriteLn('It does nothing useful of itself.');
Assign(Product_File, 'TEMP.$$$');
ReWrite(Product_File);
APrice := 1.0;
FillChar(product, SizeOf(Product), 0);
Product.Stock := 1;
(*You may replace 100.0 with a larger number if you wish.*)
WHILE APrice <= 100.0 DO
BEGIN
Product.Price := APrice;
Write(Product_File, Product);
APrice := APrice + 1;
END;
WriteLn('Typed-file function gives result ',Standard_Inventory_Value:1:4);
WriteLn('UNtyped-file function gives result ',My_Inventory_Value:1:4);
Close(Product_File);
Erase(Product_File);
END.
Very nice! Thank you for this wonderful archive. I wonder why I found it only now. Long live the BBS file archives!
This is so awesome! 😀 I’d be cool if you could download an entire archive of this at once, though.
But one thing that puzzles me is the “mtswslnkmcjklsdlsbdmMICROSOFT” string. There is an article about it here. It is definitely worth a read: http://www.os2museum.com/wp/mtswslnk/