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