Read / write different Records data from / to Untyped files in Pascal? - binaryfiles

I've a programming project in my college.
Using a File type for storing data is allowed, and I did exactly like this one: pascal-programming
And, here's what I achieved so far:
I tried to write the Records data into Untyped files instead and it worked
I want to override a function with dynamic parameter (e.g: I can switch which Record I want to process, in this case there's 2 different "Records").
Open(var f: File; var data)
data = represent can receive "anything". cmiiw
The reason why I did this, I don't think it's a good idea to recreate the same function over and over, e.g: when using 3 or more different "Records"
I also encountered a problem that the files can't store or backup the actual binary files to the temporary "Records" variable, it always give the 0 values.
go to my github source code
my solution here doesn't provide any generic related procedures (check the last sentences):
program test_untyped;
{ A crude database recording }
uses crt;
type
Temployee = record
name : string[20];
address : string[40];
phone : string[15];
age : byte;
salary : longint;
end;
arr_employee = array[1..100] of Temployee;
var
F : File;
c : char;
// r : Temployee;
r, realR : arr_employee;
s : string;
i, j, n : integer;
procedure fRead;
begin
seek(F, 0);
i := 0;
repeat
clrscr;
inc(i);
writeln('increment: ', i); readln;
writeln('File position : ',filepos(F));
blockRead(F, r[i], sizeOf(Temployee));
writeln('Name = ', r[i].name); { Input data }
writeln('Address = ', r[i].address);
writeln('Phone = ', r[i].phone);
writeln('Age = ', r[i].age);
writeln('Salary = ', r[i].salary);
write('Show data again (Y/N) ?');
repeat
c:=upcase(readkey); { Ask user : Input again or not }
until c in ['Y','N'];
writeln(c);
// realR[i] := r[i]; // backup, to show later
until c='N';
end; // end fRead
procedure fWrite;
begin
seek(F, filesize(F));
repeat
clrscr;
inc(i);
writeln('berapa nilai i: ', i);
writeln('File position : ',filepos(F));
write('Name = '); readln(r[i].name); { Input data }
write('Address = '); readln(r[i].address);
write('Phone = '); readln(r[i].phone);
write('Age = '); readln(r[i].age);
write('Salary = '); readln(r[i].salary);
blockWrite(F, r[i], sizeOf(Temployee)); { Write data to file }
write('Input data again (Y/N) ?');
repeat
c:=upcase(readkey); { Ask user : Input again or not }
until c in ['Y','N'];
writeln(c);
until c='N';
end;
// procedure fDelete;
// var
// nama: string;
// delElement: integer;
// tempR: Temployee;
// begin
// seek(F, 0);
// write('search your data by name: '); readln(nama);
// while not eof(F) do
// begin
// writeln('file position: ', filePos(F));
// blockRead(F, tempR, sizeOf(Temployee));
// if (nama = tempR.name) then
// begin
// delElement := filePos(F);
// end else
// begin
// // seek(F, )
// blockWrite(F, tempR, sizeOf(Temployee));
// end;
// end;
// end; // end fDelete
procedure fDisplay;
begin
writeln('nilai i saat ini: ', i); readln;
for j := 1 to i do
begin
clrscr;
writeln('Name = ', r[j].name); { Input data }
writeln('Address = ', r[j].address);
writeln('Phone = ', r[j].phone);
writeln('Age = ', r[j].age);
writeln('Salary = ', r[j].salary);
readln;
end;
end;
begin
clrscr;
// write('Input file name to record databases : '); readln(s);
s := 'coba1.dat';
assign(F,s); { Associate it }
{$I-}
reset(F, sizeOf(Temployee)); { First, open it }
{$I+}
n:=IOResult;
if n<>0 then { If it's doesn't exist then }
begin
{$I-}
rewrite(F, sizeOf(Temployee)); { Create it }
{$I+}
n:=IOResult;
if n<>0 then
begin
writeln('Error creating file !'); halt;
end;
end
else
begin { If it exists then }
n:=filesize(F); { Calculate total record }
// seek(F,n); { Move file pointer PAST the last record }
end;
fileMode := 2;
reset(F, sizeOf(Temployee));
fRead;
fWrite;
// fDelete;
fDisplay;
close(F);
end.
I'm wondering is the Pascal can be any good to use a generic programming? at least for this semester using Pascal in my college XD
Thank you and Best Regards,
EDIT:
Pascal still doesn't support Generic Programming 'till the day I posted this question. So sad, really.
You might wanna consider read this references instead.

I don't understand the main issue here, but would suggest using a typed file instead of an untyped one.
An untyped file is much harder to maintain, and provides (in my eyes) no benefits.
Consider the code:
type
Temployee = record
name : string[20];
address : string[40];
phone : string[15];
age : byte;
salary : longint;
end;
VAR
fEmployee : File Of Temployee;
Employees : ARRAY[0..100] Of Temployee;
Employee : Temployee;
PROCEDURE OpenEmployeeFile(CONST TheFileName:AnsiString);
BEGIN
AssignFile(fEmployee,TheFileName);
IF FileExistsUTF8(TheFileName) { *Converted from FileExists* }
THEN Reset(fEmployee)
ELSE Rewrite(fEmployee);
END;
PROCEDURE CloseEmployeeFile;
BEGIN
Close(fEmployee);
END;
FUNCTION ReadEmployee(Position:WORD): Temployee;
BEGIN
Seek(fEmployee,Position);
Read(fEmployee,Result);
END;
PROCEDURE WriteEmployee(CONST Employee:Temployee; Position:WORD);
BEGIN
Seek(fEmployee,Position);
Write(fEmployee,Employee);
END;
Error handling not implemented.
Code samples as a guideline, not complete.
It provides a basic skeleton for opening and closing the employee-file, as well as reading and writing at specific positions (specific records) in the file.
Open file.
Write all the records you want.
Close file.
Or.
Open file.
Read all the records you want.
Close file.

Related

Remove Linked List Elements -pascal

I have a problem with prosedeur supression() when inserting an etudent (more than one) and deleted by suprrision Procedure and make a search about that item I delete the program and I guess the problem is in ? prosedur supression()`. Look at it first.
I wish that clear thank u guys now
declartion to types student and moudle and note
Program liste_des_etudiants;
Type
date = Record
jour,mois,anee : Integer;
End;
ptr_etu = ^etudiant;
etudiant = Record
matricule : String;
nom,prenom,adress : String;
date_n : date;
suiv : ptr_etu;
End;
ptr_mod = ^module;
module = Record
code,libelle : String;
credit,coeff : Integer;
suiv : ptr_mod;
End;
ptr_note = ^note;
note = Record
matricule : String;
code : String;
note : Integer;
suiv : ptr_note;
End;
Var
choix : String;
liste_etudiant : ptr_etu ;
liste_note : ptr_note;
liste_module : ptr_mod;
Procedure supression etudent
Procedure supression(Var etu:ptr_etu;module:ptr_mod;note:ptr_note );
var
choix,matr,code : String;
current,prvious,Next: ptr_etu;
current_note,privous_note :ptr_note;
privous_code,current_code: ptr_mod;
begin
Repeat
Repeat
Writeln('pour supression un etudiant tapez 1');
Writeln('pour supression un note tapez 2');
Writeln('pour supression un module tapez 3');
Writeln('pour sortir tapez e ');
Readln(choix);
Until ((choix='1') Or (choix='2') Or (choix='3') Or (choix='e') Or (choix='E'));
If (choix='1') Then
Begin
// I guess the porblem is here but i don't know is it
// initcation de node
current := etu ;
Writeln('donner son matricule') ;
Readln(matr);
// traitement to the if the node we wanna delet is the
// first one
While((etu<>Nil) And(etu^.matricule=matr))Do
etu:= etu^.suiv;
While ((current<>Nil) and (current^.suiv<>nil)) Do
Begin
next:=etu^.suiv;
if (next^.matricule=matr) then
begin
current^.suiv:=next^.suiv;
end
Else
current:=current^.suiv;
end;
if (current =nil) then
writeln('l ''''etudiant n''''est pas trouvee');
Until ((choix='e') Or(choix='E'));
end;
Main
Begin
Repeat
Repeat
Writeln('tapez:');
Writeln('1):pour insertion');
Writeln('2):pour modification');
Writeln('3):pour supression');
Writeln('4):pour recherche');
Writeln('(e)pour sortir');
Readln(choix);
Until ((choix='1') Or (choix='2') Or (choix='3') Or (choix='4') Or (choix='e'));
If (choix='1') Then
insertion(liste_etudiant, liste_module,liste_note)
Else If (choix='2') Then
modification(liste_etudiant, liste_module,liste_note)
Else If (choix='3') Then
supression(liste_etudiant,liste_module,liste_note)
Else if (choix='4') Then
recherche(liste_etudiant, liste_module,liste_note)
Until ((choix='e') Or (choix='E'));
End.

Is it possible to open a Text File in Pascal several times in the same program?

I am trying to make a program that allow me to read a text file and then print it in the terminal.
I just put the simplified parts below so that you see how I think it should work.
My problem is that if for example I open the file a.txt then b.txt it works.
But when I want to open a.txt again, the program stops with an error 217. Same if I want to open another file name c.txt for example. I've spent days on this problem but I do not know where it comes from. I looked on the internet and erorr 217 seems to be related to a non-existing file ? but it is not the case for me...
The error seems to occur on the 'assign' function.
To clarify :
'key' is a Char,
'map' is a two dimension dynamic array of a Record Type.
Repeat
readln(key);
name := key +'.txt';
fileLoading(name, map, maxX, maxY);
Until key = 'l';
...
procedure fileLoading (name : String; var map : PPObjet; var maxX,maxY : Integer);
var
fichier : Text;
i, j : Integer;
chaine : String;
begin
if (FileExists(name)) then
begin
assign(fichier, name);
reset(fichier);
read(fichier,maxX);
readln(fichier,maxY);
if (maxX < 1) or (maxX > MAX) or (maxY < 1) or (maxY > MAX) then
begin
writeln('Tailles invalides');
halt();
end;
allocationTab(maxX, maxY, map);
while (not eof(fichier)) do
begin
for j := 1 to maxY do
begin
readln(fichier,chaine);
for i := 1 to maxX do
begin
case chaine[i] of
'0' : begin
map[j][i].solide := false;
map[j][i].nature := 'v';
map[j][i].valeur := chaine[i];
end;
'1' : begin
map[j][i].solide := true;
map[j][i].nature := 'm';
map[j][i].valeur := chaine[i];
end;
'2'..'9' : begin
map[j][i].solide := false;
map[j][i].nature := 's';
map[j][i].valeur := chaine[i];
end;
end;
end;
end;
end;
end
else
begin
writeln('Erreur le fichier n''existe pas');
halt();
end;
close(fichier);
end;
...
This is the first time I ask a question on stack overflow and I'm not really familiar with it, so I hope my problem is clear enough, as well as my english.
Thanks in advance for all the help you may bring.
try setting
filemode:=0;
before your assign/reset

Wrong use of 'file of char'

Im having problems with this code, I have two file of char, one is filed with information about books, and the other is empty, i have to write in SAL some information from S and then show the total of how many books match the first 2 digits of the code and how many are R and how many are T. The code, does write the information form S to Sal, but when its supposed to show the totals it appears ERORR 100 on screen. I read about it and it says that it is a problem with 'Disk read error' and that *This error typically occurs, if you "seed" a non-existent record of a typed file and try to read/write it. *, i really dont undertand.
I've benn trying to figure it out, but I haven't been able to. I notice that if I dont put 'WHILE NOT EOF(S) DO' the error does not appear, but of course i need the while, if someone is able to point out my mistakes i would really apreciate it.
This is the code:
uses crt;
var
i : byte;
s,sal: file of char;
v,l1,l2: char;
cs,cn,cl: integer;
pn,ps,tot: integer;
BEGIN
cs:=0; cn:=0; i:=0; cl:=0;
Assign (s, 'C:\Users\te\Documents\s.txt');
{$I-}
Reset (s);
{$I+}
if IOResult <> 0 then
begin
writeln('Error');
halt(2);
end;
Assign (sal, 'C:\Users\te\Documents\sal.txt');
{$I-}
Rewrite (sal);
IOResult;
{$I+}
if IOResult <> 0 then
halt(2);
writeln('Please write the code of the book, only 2 digits');
read(L1);read(L2);
read(s,v);
while (not eof(s)) do
begin
for i:=1 to 2 do
read(s,v);
if (v = '0') then
begin
read(s,v);
if (v = '1') or (v = '2') then
begin
for i:=1 to 5 do
read(s,v);
if (v = 'R') then
begin
read(s,v);
cs:= cs + 1;
end
else
begin
if (v = 'T') then
begin
cn:= cn + 1;
read(s,v);
end;
end;
while (v <> '-') do
read(s,v);
while (v = '-') do
read(s,v);
if (v = L1) then
begin
write(sal, v);
read(s,v);
if (v = L2) then
begin
write(sal,v);
read(s,v);
cl:= cl + 1;
end;
end;
while ( v <> '/') do
begin
write(sal,v);
read(s,v);
end;
write(sal, '-');
end
else
begin
for i:= 1 to 5 do
read(s,v);
if (v = 'R') then
cs:= cs + 1
else
cn:= cn + 1;
if (v = L1) then
read(s,v);
if (v = L2) then
begin
cl:= cl + 1;
read(s,v);
end;
end;
end
else
begin
for i:= 1 to 5 do
read(s,v);
if (v = 'R') then
cs:= cs + 1
else
cn:= cn + 1;
if (v = L1) then
read(s,v);
if (v = L2) then
begin
cl:= cl + 1;
read(s,v);
end;
end;
end;
tot:= cs + cn;
ps:= (cs * 100) div tot;
pn:= (cn * 100) div tot;
writeln('TOTAL ',cl);
writeln();
writeln(ps,'% and',pn,'%');
The file S content:
02022013Rto kill a mockingbird-1301/02012014Tpeter pan-1001/02032013Thowto-2301/02012012Tmaze runner-1001/02012012Tmaze runner-1001/02012012Tmaze runner-1001/$
I really just need someone else's point of view on this code, I think maybe the algorithm is flawed.
Thanks
(After your edit, i see that your code now compiles w/o error in FPC, so I'm glad you've managed to fix the error yourself)
As this is obviously coursework, I'm not going to fix your code for you and in any case the wayEven so, I'm afraid you are going about this is completely wrong.
Basically, the main thing wrong with your code is that you are trying to control what happens as your read the source file character by character. Quite frankly, that's a hopeless way of trying to do it, because it makes the execution flow unnecessarily complicated and littered with ifs, buts and loops. It also requires you to keep mental track of what you are trying to do at any given step, and the resulting code is inherently not self-documenting - imagine if you came back to your code in six months, could you tell at a glance how it works and what it does? I certsinly couldn't personally.
You need to break the task down in a different way. Instead of analysing the problem from the bottom up ("If I read this character next, then what I need to do next is ...') do it from the top down: Although your input file is a file of char, it contains a series of strings, separated by a / character and finally terminated by a $ (but this terminator does not really matter). So what you need to do is to read these strings one-by-one; once you've got one, check whether it's the one you're looking for: if it is. process it however you need to, otherwise read the next one until you reach the end of the file.
Once you have successfully read one of the book strings, you can then split it up into the various fields it's composed of. The most useful function for doing this splitting is probably Copy, which lets you extract substrings from a string - look it up in the FPC help. I've included functions ExtractTitle and ExtractPreamble which show you what you need to do to write similar functions to extract the T/R code and the numeric code which follows the hyphen. Btw, if you need to ask a similar q in the future, it would be very helpful if you include a description of the layout and meaning of the various fields in the file.
So, what I'm going to show you is how to read the series of strings in your S.Txt by building them character-by-character. In the code below, I do this using a function GetNextBook which I hope is reasonable self-explanatory. The code uses this function in a while loop to fill the BookRecord string variable. Then, it simply writes the BookRecord to the console. What your code should do, of course, is to process the BookRecord contents to see if it is the one you are looking for and then do whether the remainder of your task is.
I hope you will agree that the code below is a lot clearer, a lot shorter and will be a lot easier to extend in future than the code in your q. They key to structuring a program this way is to break the program's task into a series of functions and procedures which each perform a single sub-task. Writing the program that way makes it easier to "re-wire" the program to change what it does, without having to rewrite the innards of the functions/procedures.
program fileofcharproject;
uses crt;
const
sContents = '02022013Rto kill a mockingbird-1301/02012014Tpeter pan-1001/02032013Thowto-2301/02012012Tmaze runner-1001/02012012Tmaze runner-1001/02012012Tmaze runner-1001/$';
InputFileName = 'C:\Users\MA\Documents\S.Txt';
OutputFileName = 'C:\Users\MA\Documents\Sal.Txt';
type
CharFile = File of Char; // this is to permit a file of char to be used
// as a parameter to a function/procedure
function GetNextBook(var S : CharFile) : String;
var
InputChar : Char;
begin
Result := '';
InputChar := Chr(0);
while not Eof(S) do begin
Read(S, InputChar);
// next, check that the char we've read is not a '/'
// if it is a '/' then exit this while loop
if (InputChar <> '/') then
Result := Result + InputChar
else
Break;
end;
end;
function ExtractBookTitle(BookRecord : String) : String;
var
p : Integer;
begin
Result := Copy(BookRecord, 10, Length(BookRecord));
p := Pos('-', Result);
if p > 0 then
Result := Copy(Result, 1, p - 1);
end;
procedure AddToOutputFile(var OutputFile : CharFile; BookRecord : String);
var
i : Integer;
begin
for i := 1 to Length(BookRecord) do
write(OutputFile, BookRecord[i]);
write(OutputFile, '/');
end;
function ExtractPreamble(BookRecord : String) : String;
begin
Result := Copy(BookRecord, 1, 8);
end;
function TitleMatches(PartialTitle, BookRecord : String) : Boolean;
begin
Result := Pos(PartialTitle, ExtractBookTitle(BookRecord)) > 0;
end;
var
i : Integer; //byte;
s,sal: file of char;
l1,l2: char;
InputChar : Char;
BookFound : Boolean;
cs,cn,cl: integer;
pn,ps,tot: integer;
Contents : String;
BookRecord : String;
PartialTitle : String;
begin
// First, create S.Txt so we don't have to make any assumptions about
// its contents
Contents := sContents;
Assign(s, InputFileName);
Rewrite(s);
for i := 1 to Length(Contents) do begin
write(s, Contents[i]); // writes the i'th character of Contents to the file
end;
Close(s);
cs:=0; cn:=0; i:=0; cl:=0;
// Open the input file
Assign (s, InputFileName);
{$I-}
Reset (s);
{$I+}
if IOResult <> 0 then
begin
writeln('Error');
halt(2);
end;
// Open the output file
Assign (sal, OutputFileName);
{$I-}
Rewrite (sal);
IOResult;
{$I+}
if IOResult <> 0 then
halt(2);
// the following reads the BookRecords one-by-one and copies
// any of them which match the partial title to sal.txt
writeln('Enter part of a book title, followed by [Enter]');
readln(PartialTitle);
while not Eof(s) do begin
BookRecord := GetNextBook(S);
writeln(BookRecord);
writeln('Preamble : ', ExtractPreamble(BookRecord));
writeln('Title : ', ExtractBookTitle(BookRecord));
if TitleMatches(PartialTitle, BookRecord) then
AddToOutputFile(sal, BookRecord);
end;
// add file '$' to sal.txt
write(sal, '$');
Close(sal);
Close(s);
writeln('Done, press any key');
readln;
end.

Pascal error 'call by var for arg no.1 has to match exactly'

I learning to make a program that gets data from a txt file and places it in arrays.
the following are its types :
type
ekspedisi = record
nmeksp : string; // Nama Ekspedisi
jlp : string; // Jenis layanan pengiriman
biaya : integer; // Biaya pengiriman per kg
lp : integer; // per hari
end;
ekspedisiku = record
nom : array [1..100] of ekspedisi;
end;
and a simple algorithm
procedure getDaftarEkspedisi(var kirim : ekspedisiku);
var
i,j,k : integer;
eksp : text;
init : string;
garis : array [1..100] of integer;
mark : string;
jeks : integer;
count : integer;
begin
assign(eksp,'ekspedisi.txt');
reset(eksp);
i := 0;
k := 1;
j := 1;
mark := '|';
jeks := 10;
writeln('Loading ekspedisi.. ');
while(not(eof(eksp))) do
begin
readln(eksp,init);
i := i + 1;
for j := 1 to length(init) do
begin
if init[j] = mark then
begin
garis[k] := j;
k := k + 1;
end;
end;
for i := 1 to jeks do
begin
count := ((i-1)*5);
kirim.nom[i].nmeksp := copy(init,garis[1+count] + 2,garis[2+count]-garis[1+count]-2);
kirim.nom[i].jlp := copy(init,garis[2+count] + 2,garis[3+count]-garis[2+count]-2);
val(copy(init,garis[3+count] + 2,garis[4+count]-garis[3+count]-2),kirim.nom[i].biaya);
val(copy(init,garis[4+count] + 2,garis[5+count]-garis[4+count]-2),kirim.nom[i].lp);
end;
close(kirim);
writeln('loading sukses.');
end;
end;
from that code, i get the following error
<166,13>Error: Call by var for arg no.1 has to match exactly : got "ekspedisiku" expected "Text"
curiously, line 166 is only
close(kirim);
any help is appreciated.
You need to pass the file handle to close, so:
close(kirim);
should be:
close(eksp);
It also looks like you're closing the file at the wrong place in your function. It should most likely be after the while loop, so you need to change:
close(kirim);
writeln('loading sukses.');
end;
end;
to:
end;
close(kirim);
writeln('loading sukses.');
end;
Note that this mistake probably happened because your identation is messed up - if you're careful with formatting your code properly then you won't be so likely to make this kind of error.

how to get a variable out of a procedure in the right way in PASCAL?

I'm following an internet course on the basics of programming. After making a diagram I convert it to code, right now this is PASCAL language.
I'm having a problem with procedures and can't find an answer, nor in the course, nor with some google-ing.
I want to get a variavble back form a procedure. Right now iIhave a working piece of code but I think this is not the good way of working. Here's an extract of the code:
program WELKEWAGEN;
// declare your variables here
var T, N, KM, vari, prijsDW, prijsBW, jrenGEBR, taksDW, taksBW, prijsB, verbrBW, prijsD, verbrDW : real;
procedure OPHALEN(para : string);
begin
repeat
writeln('geef de ', para , ' op');
readln(vari);
until (vari > 0);
end;
begin
//this is the main program but there is more code ofcourse
OPHALEN('prijs benzinewagen');
prijsBW := vari;
//...
end.
Now the internet course says I should program it like this:
begin
//...
prijsBW := OPHALEN('prijs benzinewagen');
//...
end.
But this is not working.
I get following errors:
WELKEWAGEN.pas(24,14) Error: Incompatible types: got "untyped" expected "Real"
WELKEWAGEN.pas(50) Fatal: There were 1 errors compiling module, stopping
pas(24,14) is this line: prijsBW := OPHALEN('prijs benzinewagen');
Procedures don't return values, so the syntax
prijsBW := OPHALEN('prijs benzinewagen');
is invalid.
If you want to return a value, you need to define a function instead:
function OPHALEN(para : string): Real;
var
Res: Real;
begin
Res := 0;
repeat
writeln('geef de ', para , ' op');
readln(Res);
until (Res > 0);
OPHALEN := Res;
end;
Note that the (bad) global variables you're using mean you don't have to return anything at all, because a procedure can access and change that global variable directly (but you have no way of knowing when the procedure is finished):
procedure OPHALEN(para : string);
begin
vari := 0;
repeat
writeln('geef de ', para , ' op');
readln(vari);
until (vari > 0);
end;
Modern Pascal dialects (such as Delphi and FreePascal) allow a cleaner syntax for the return value of functions by using an automatically declared function result variable of the proper type for you, named Result (because that's what it is - the result of the function):
function OPHALEN(para : string): Real;
begin
Result := 0;
repeat
writeln('geef de ', para , ' op');
readln(Result);
until (Result > 0);
end;
If you need to return multiple values, you can use var parameters, which allow them to be changed inside the function.
procedure OPHALEN(para: string; var RetVal: Real);
begin
RetVal := 0;
repeat
writeln('geef de ', para , ' op');
readln(RetVal);
until (RetVal > 0);
end;
Your original code (and the examples I've provided above) all fail to allow the user to cancel, BTW. There should be some way to exit the loop for the user; otherwise, your code just endlessly loops, writing para to the screen and then waiting for input. This has a tendency to annoy users.

Resources