Pascal/Delphi Projeto de pascal zim

[98GK]

Alguém consegue arranjar me o código?
 

Program loja_carrinho;
Type
  TProduto= record
  nome : String;
Cod:integer;
preco: real;
end;

Var
  n:Integer;
op:char;
st:string;
r:real;

const
  NOMEFICHEIRO='produto.dat';
NOMEFICHEIROC='carrinho';

procedure Criar(pNomeFicheiro:string);
var
  fich : file of TProduto;
begin
  Assign (fich, pNomeFicheiro);
Rewrite (fich);
close(fich);
end;

procedure insere(produto:TProduto;pNomeFicheiro:string);
var
  fich: file of TProduto;
Begin
  assign(fich,pNomeFicheiro);
reset(fich);
seek(fich, filesize(fich));
write(fich,produto);
close(fich);
end;

Procedure InsereProduto(cod:integer;nome:string;preco:real);
var
  op:char;
p:TProduto;
Begin
  P.nome:=nome;
P.preco:=preco;
P.Cod:=cod;
insere(p,NOMEFICHEIRO);
End;

Procedure InsereCarrinho(utilizador:string;nome:string;preco:real;cod:integer);
var
  p:TProduto;
Begin
  P.nome:=nome;
P.preco:=preco;
P.Cod:=cod;
insere(p,NOMEFICHEIROC + utilizador + '.dat');
End;

Procedure PercorreProduto(pNomeFicheiro:string);
var
  s:TProduto;
fich: file of TProduto;
Begin

  assign(fich,pNomeFicheiro);
reset(fich);
While not eof(fich) do    
  Begin
  read(fich,s);
Writeln (s.Cod,' => ', s.nome,' / Preço: ', s.Preco:2:2);
end;
close(fich);
End;

Procedure PercorreCarrinho(pUtilizador:string);
begin
  PercorreProduto(NOMEFICHEIROC + pUtilizador  + '.dat');

End;

Function ProcuraProduto(n:integer):TProduto;
var
  s:TProduto;
fich: file of TProduto;
enc:boolean;
Begin
  assign(fich,NOMEFICHEIRO);
reset(fich);
While (not eof(fich)) and (not enc) do
  Begin
  read(fich,s);
if s.Cod=n then
  begin
  enc:=true;
end;
end;

if enc then
  ProcuraProduto:=s
    else
    begin
    s.cod:=0;
ProcuraProduto:=s;
end;
close(fich);
End;

Function SomarCarrinho(pUtilizador:string) :real;
var
  p:TProduto;
soma:real;
fich: file of TProduto;
begin
  assign(fich,nomeficheiroc+ + pUtilizador + '.dat');
reset(fich);
while not eof (fich) do
  begin
  read(fich,p);
soma:=soma+P.preco;
end;
close(fich);
SomarCarrinho:=soma;
end;

procedure FinalizaEncomenda(pUtilizador:string);

var d:string;
begin
  writeln('Estes são os itens do seu carrinho');
PercorreCarrinho;
writeln;
writeln('O total do carrinho é ', SomarCarrinho(pUtilizador):2:2,'$');
writeln;
writeln('Insira a sua morada');
read(d);
writeln('O destino escolhido é ',d,' e chega nos próximos 3 dias');

end;

procedure AdicionaCarrinho;
var
  op:char;
p:TProduto;
begin
  repeat
  Write	('Código: ');
Readln ( n );
p:=ProcuraProduto(n);
if p.cod<>0 then
  begin
  insereCarrinho('001',p.nome,p.preco,p.cod);
end;
Write	('Deseja adicionar outro produto (s\n): ');
Readln (op);
until (op='n') or (op='N');
end;

Begin
  Repeat

  textcolor(red);

Writeln ('    ------------------------------');
Writeln ('    Bem vindo, o que deseja fazer?');
writeln ('    ------------------------------');
writeln ('    ##########################');
writeln ('    *7 - Criar Ficheiro      *');
Writeln ('    *1 - Insira um produto   *');
Writeln ('    *2 - Mostrar produtos    *');
Writeln ('    *3 - Adicionar ao carinho*');
Writeln ('    *4 - Limpar carrinho     *');
Writeln ('    *5 - Mostrar carrinho    *');
Writeln ('    *6 - Finalizar encomenda *');
writeln ('    *0 - terminar            *');
writeln ('    ##########################');

Readln (op);
clrscr;
textbackground (white);
textcolor(black);writeln('       98GKShop      ');textbackground (black);
writeln;
textcolor(white);
case op of
  '1':
Begin
  writeln('insira o seu produto');
Write	('Cod: ');
Readln ( n );
Write	('Nome: ');
Readln ( st );
Write	('Preço: ');
Readln ( r );
InsereProduto(n,st,r);
writeln;
textbackground( blue); writeln('pressione qualquer tecla para retornar ao menu');textbackground (black);
Readkey;
clrscr;

End;
'2':
Begin
  PercorreProduto(NOMEFICHEIRO);
writeln;
textbackground( blue);writeln('pressione qualquer tecla para retornar ao menu');textbackground (black);
Readkey;
clrscr;
end;
'3':
Begin
  WRITELN('Insira o código do produto que deseja');
AdicionaCarrinho;
writeln;
textbackground( blue);writeln('pressione qualquer tecla para retornar ao menu');textbackground (black);
Readkey;
clrscr;
end;
'4':
Begin
  criar(NOMEFICHEIROC+'001.dat');
writeln;
textbackground( blue);writeln('pressione qualquer tecla para retornar ao menu');textbackground (black);
Readkey;
clrscr;
End;
'5':
Begin
  PercorreCarrinho('001');
writeln;
textbackground( blue);writeln('pressione qualquer tecla para retornar ao menu');textbackground (black);
Readkey;
clrscr;
end;
'6':
Begin
  FinalizaEncomenda;
writeln;
textbackground( blue);writeln('pressione qualquer tecla para retornar ao menu');textbackground (black);
Readkey;
clrscr;
end;
'7':
begin
  criar(NOMEFICHEIRO);
criar(NOMEFICHEIROC + '001.dat');
clrscr;
end;

End;
Until op='0';
End.

 

programa teste (1).rar

[Simon Viegas]

@98GK, do que se trataria? É algum exercício ou algo do tipo?

Qual o enunciado do problema e até onde conseguiu fazer?

[98GK]

@Simon Viegas e um projeto que simula um carrinho de uma loja e so me falta arranjar o ultimo passo que e um eof eu suspeito que seja por o ficheiro estar vazio mas não estou a conseguir resolver

 

[Simon Viegas]

Poste o enunciado completo, código completo e em qual parte está com dúvida.