Jump to content

Não consigo resolver este erro, ao testar


FMC
 Share

Recommended Posts

Olá comunidade estou a realizar um projecto final sobre ficheiros, para a disciplina LP.

Eu resolvi, realizar uma simulação de um programa de administração de um aeroporto, onde ele simula, o registo de clientes,voos e fornecedores e ainda vou adicionar sistema de compra e manutenção de aviões e bilhetes, mas ainda está muito incompleto.

Eu uso para colocar o código o Gedit, e para compilar o FPC 2.6.4, no ubuntu 15.10.

Program Pzim ;
uses Crt;
const
Caminhocliente='/home/fmc/Documentos/Escola/LP/cliente.dat';
CaminhoFornecedore='/home/fmc/Documentos/Escola/LP/fornecedores.dat';
Caminhovoo='/home/fmc/Documentos/Escola/LP/voo.dat';
type
dad_data=array[1..5] of integer; // Dia/mes/Ano
dad_morada=record
localidade:string[30];
rua:string[30];
cp:String[20];
distrito:string[30];
end;
dad_cliente=record
id:integer;
Nome:string[50];
nascimento:dad_data;
mora:dad_morada;
num_civil:integer;
end;
dad_fornecedor=record
id:integer;
Nome:string[50];
empresa:string[50];
morada:dad_morada;
Telemovel:integer;
end;
dad_voos=record
id:integer;
aviao:string;
destino:string;
partida:dad_data;
num_lugares:integer;
LugaresDisponiveis:integer;
preco:integer;
end;

fc=file of dad_cliente;
FF=file of dad_fornecedor;
FV=file of dad_voos;
var
ficheiros_Clientes:fc;
ficheiros_fornecedor:FF;
ficheiros_voos:FV;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////-> Funções Existe Ficheiros
function existe_fic_clientes:boolean;
Begin
assign(ficheiros_Clientes,Caminhocliente);
{$I-}     //Erros desativados
reset(ficheiros_Clientes);
close(ficheiros_Clientes);
{$I+}     //Erros Activados
existe_fic_clientes:=(ioresult=0);
end;
function existe_fic_fornecedor:boolean;
Begin
assign(ficheiros_fornecedor,CaminhoFornecedore);
{$I-}
reset(ficheiros_fornecedor);
close(ficheiros_fornecedor);
{$I+}
existe_fic_fornecedor:=(ioresult=0);
end;
function existe_fic_voo:boolean;
Begin
assign(ficheiros_voos,Caminhovoo);
{$I-}
reset(ficheiros_voos);
close(ficheiros_voos);
{$I+}
existe_fic_voo:=(ioresult=0);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////-> Clientes

procedure Digitar_Cliente(var entrada:dad_cliente );
Begin
clrscr;
writeln('+-+-+-+-+-+-+-+-+ |Registo de um novo cliente| +-+-+-+-+-+-+-+-+ '); writeln;
write('Introduza o seu nome: '); readln(entrada.Nome);
writeln;
write('Numero Civil: ');     readln(entrada.num_civil);
writeln;
write('Qual o dia que voce nasceu: '); readln(entrada.nascimento[1]);
writeln;
write('Qual o Mês: ');     readln(entrada.nascimento[2]);
writeln;
write('Qual o ano: ');     readln(entrada.nascimento[3]);
writeln;
write('Localidade: ');     readln(entrada.mora.localidade);
writeln;
write('Rua: ');     readln(entrada.mora.rua);
writeln;
write('Codigo de postal: ');     readln(entrada.mora.cp);
writeln;
write('Distrito: ');     readln(entrada.mora.distrito);
writeln;

end;
procedure Monstrar_cliente(var entrada:dad_cliente );
Begin
clrscr;
writeln('+-+-+-+-+-+-+-+-+ |Cliente actual| +-+-+-+-+-+-+-+-+ '); writeln;

writeln('Id: ', entrada.id);
writeln;
writeln('Nome :',entrada.nome);
writeln;
writeln('Numero Civil :',entrada.num_civil);
writeln;
writeln('Data de nascimento: ', entrada.nascimento[1],' / ',entrada.nascimento[2],' / ',entrada.nascimento[3]);
write('Localidade: ', entrada.mora.localidade);
writeln;
write('Rua: ',entrada.mora.rua);
writeln;
writeln('Codigo de postal: ',entrada.mora.cp);
writeln;
writeln('Distrito: ',entrada.mora.distrito);
writeln;
readkey;
end;

procedure esc_clientes;
var auxiliar:dad_cliente;
Begin
assign(ficheiros_Clientes,Caminhocliente);

if existe_fic_clientes then
reset(ficheiros_Clientes)
else
rewrite(ficheiros_Clientes);
Digitar_Cliente(auxiliar);
seek(ficheiros_Clientes,filesize(ficheiros_Clientes)); //Vai para a ultimo posição do ficheiro
auxiliar.id:=filepos(ficheiros_Clientes);
write(ficheiros_Clientes,auxiliar); //Escreve o registo no ficheiro
close(ficheiros_Clientes);
end;
procedure l_clientes;
var auxiliar:dad_cliente;
Begin
assign(ficheiros_Clientes,Caminhocliente);
reset(ficheiros_Clientes);
while not (eof(ficheiros_Clientes)) do //Se não chegar ao fim do ficheiro
Begin
read(ficheiros_Clientes,auxiliar); //Le o que está no ficheiro
Monstrar_cliente(auxiliar);
end;
close(ficheiros_Clientes);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////-> Fornecedores

procedure Digitar_Fornecedor(var entrada:dad_fornecedor);
Begin
clrscr;
writeln('+-+-+-+-+-+-+-+-+ |Registo de um novo fornecedor| +-+-+-+-+-+-+-+-+ '); writeln;

write('Nome do fornecedor: '); readln(entrada.nome);
writeln;
write('Numero de Telefone/telemovel: '); readln(entrada.Telemovel);
writeln;
write('Empresa: ');     readln(entrada.empresa);
writeln;
write('Localidade: ');     readln(entrada.morada.localidade);
writeln;
write('Rua: ');     readln(entrada.morada.rua);
writeln;
write('Codigo de postal: '); readln(entrada.morada.cp);
writeln;
writeln('Distrito: ');     readln(entrada.morada.distrito);
writeln;
readkey;
end;

procedure Monstrar_Fornecedor(var entrada:dad_fornecedor);
Begin
writeln('+-+-+-+-+-+-+-+-+ |Fornecedor actual| +-+-+-+-+-+-+-+-+ '); writeln;

writeln('Id: ', entrada.id);
writeln;
writeln('Nome do fornecedor: ',entrada.nome);
writeln;
writeln('Telefone/telemovel: ',entrada.Telemovel);
writeln;
writeln('Empresa: ',entrada.empresa);
writeln;
writeln('Localidade: ', entrada.morada.localidade);
writeln;
writeln('Rua: ',entrada.morada.rua);
writeln;
writeln('Codigo de postal: ',entrada.morada.cp);
writeln;
writeln('Distrito: ',entrada.morada.distrito);
readkey;
end;
procedure esc_fornecedor;
var auxiliar:dad_fornecedor;
Begin
assign(ficheiros_fornecedor,CaminhoFornecedore);

if existe_fic_fornecedor then
reset(ficheiros_fornecedor)
else
rewrite(ficheiros_fornecedor);
Digitar_Fornecedor(auxiliar);
seek(ficheiros_fornecedor,filesize(ficheiros_fornecedor)); //Vai para a ultimo posição do ficheiro
auxiliar.id:=filepos(ficheiros_fornecedor);
write(ficheiros_fornecedor,auxiliar); //Escreve o registo no ficheiro
close(ficheiros_fornecedor);
end;

procedure l_fornecedor;
var auxiliar:dad_fornecedor;
Begin
assign(ficheiros_fornecedor,CaminhoFornecedore);
reset(ficheiros_fornecedor);
while not (eof(ficheiros_fornecedor)) do //Se não chegar ao fim do ficheiro
Begin
read(ficheiros_fornecedor,auxiliar); //Le o que está no ficheiro
Monstrar_Fornecedor(auxiliar);
end;
close(ficheiros_fornecedor);
end;
////////////////////////////////////////////////////////////////////////////////////////////////////////////////////-> Voos
procedure Digitar_voo(var entrada:dad_voos);
Begin
clrscr;
writeln('+-+-+-+-+-+-+-+-+ |Registo de um novo voo| +-+-+-+-+-+-+-+-+ '); writeln;


write('Avião: ');     readln(entrada.aviao);
writeln;

write('Destino: '); readln(entrada.destino);
writeln;
writeln('Partida!');
write('Dia: ');     readln(entrada.partida[1]);
write('Mes: ');     readln(entrada.partida[2]);
write('Ano: ');     readln(entrada.partida[3]);
write('Hora: '); readln(entrada.partida[4]);
write('Minutos: '); readln(entrada.partida[5]);
writeln;

write('Numero de Lugares: '); readln(entrada.num_lugares);
writeln;
write('Preço de cada bilhete: '); readln(entrada.preco);

end;

procedure Monstrar_voo(var entrada:dad_voos);
Begin
clrscr;
writeln('+-+-+-+-+-+-+-+-+ |voo actual| +-+-+-+-+-+-+-+-+ '); writeln;

writeln('Id: ',entrada.id);
writeln;

writeln('Avião: ',entrada.aviao);
writeln;

writeln('Destino: ',entrada.destino);
writeln;
writeln('Partida!');
writeln('Dia: ',entrada.partida[1]);
writeln('Mes: ',entrada.partida[2]);
writeln('Ano: ',entrada.partida[3]);
writeln('Hora: ',entrada.partida[4]);
writeln('Minutos: ',entrada.partida[5]);
writeln;

writeln('Numero de Lugares: ',entrada.num_lugares);
writeln;
writeln('Preço de cada bilhete: ',entrada.preco);
readkey;
end;
procedure esc_voo;
var auxiliar:dad_voos;
Begin
assign(ficheiros_voos,Caminhovoo);

if existe_fic_voo then
reset(ficheiros_voos)
else
rewrite(ficheiros_voos);
Digitar_voo(auxiliar);
seek(ficheiros_voos,filesize(ficheiros_voos)); //Vai para a ultimo posição do ficheiro
auxiliar.id:=filepos(ficheiros_voos);
write(ficheiros_voos,auxiliar); //Escreve o registo no ficheiro
close(ficheiros_voos);
end;

procedure l_voo;
var auxiliar:dad_voos;
Begin
assign(ficheiros_voos,Caminhovoo);
reset(ficheiros_voos);
while not (eof(ficheiros_voos)) do //Se não chegar ao fim do ficheiro
Begin
read(ficheiros_voos,auxiliar); //Le o que está no ficheiro
Monstrar_voo(auxiliar);
end;
close(ficheiros_voos);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////-> Pesquisar
procedure Pesquisar_por_empresa_fornecedor;
var entrada:string[50]; sinal:boolean; aux:dad_fornecedor; opcao:integer;
Begin
assign(ficheiros_fornecedor,CaminhoFornecedore);
reset(ficheiros_fornecedor);
repeat
sinal:=false;


writeln('Numero Civil: '); readln(entrada);
while not(eof(ficheiros_fornecedor)) do
Begin
read(ficheiros_fornecedor,aux);
if (entrada = aux.empresa ) then
Begin
Monstrar_Fornecedor(aux);
readkey;
sinal:=true;
end;
end;
if (sinal=false)then
Begin
writeln('Nenhum fornecedor com esse numero civil, o que deseja realizar?');
writeln('1-> Registar um novo fornecedor.');
writeln('2-> Inserir novamente o numero civil');
writeln('3-> Voltar para o menu');
write('A sua opção: '); readln(opcao);
if (opcao=1) then
esc_fornecedor;
end;

until((opcao = 3) or (sinal = true));
close(ficheiros_fornecedor);
end;

procedure Pesquisar_por_Num_civil_cliente;
var entrada:integer; auxiliar:boolean; aux:dad_cliente; op:integer;
Begin
assign(ficheiros_Clientes,Caminhocliente);
reset(ficheiros_Clientes);
repeat
auxiliar:=false;
seek(ficheiros_Clientes,0);
entrada:=0;

writeln('Numero Civil: '); readln(entrada);
while not(eof(ficheiros_Clientes)) do
Begin
read(ficheiros_Clientes,aux);
if (entrada = aux.num_civil ) then
Begin
Monstrar_cliente(aux);
readkey;
auxiliar:=true;
end;
end;
if (auxiliar=false)then
Begin
writeln('Nenhum cliente com esse numero civil, o que deseja realizar?');
writeln('1-> Registar um novo cliente.');
writeln('2-> Inserir novamente o numero civil');
writeln('3-> Voltar para o menu');
write('A sua opção: '); readln(op);
if (op=1) then
esc_clientes;
end;

until((op = 3) or (auxiliar = true));
close(ficheiros_Clientes);
end;

procedure Pesquisar_por_Destino_voo;
var entrada:string[50]; aux2:boolean; aux:dad_voos; op:integer;
Begin
assign(ficheiros_voos,Caminhovoo);
reset(ficheiros_voos);
repeat
aux2:=false;

writeln('Destino: '); readln(entrada);
while not(eof(ficheiros_voos)) do
Begin
read(ficheiros_voos,aux);
if (entrada = aux.destino ) then
Begin
Monstrar_voo(aux);
readkey;
aux2:=true;
end;
end;
if (aux2=false)then
Begin
writeln('Nenhum voo com esse destino, o que deseja realizar?');
writeln('1-> Registar um novo voo.');
writeln('2-> Inserir novamente o destino');
writeln('3-> Voltar para o menu');
write('A sua opção: '); readln(op);
if (op=1) then
esc_voo;
end;

until((op = 3) or (aux2 = true));
close(ficheiros_Clientes);
end;

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////-> Menus

procedure MENU;
var opcao:integer;

Begin
repeat
clrscr;
writeln('+-+-+-+-+-+-+-+-+ |Menu Principal| +-+-+-+-+-+-+-+-+ '); writeln;
writeln('(1) //////////////////-> Registar um cliente ');
if existe_fic_clientes then
Begin
writeln('(2) //////////////////-> Escrever todos os clientes ');
writeln('(3) //////////////////-> Pesquisar um cliente');
end;
writeln('.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,');
writeln('(4) //////////////////-> Registar um fornecedor ');
if existe_fic_fornecedor then
Begin
writeln('(5) //////////////////-> Escrever todos os fornecedor ');
writeln('(6) //////////////////-> Pesquisar um fornecedor');
end;
writeln('.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,');
writeln('(7) //////////////////-> Registar um Voo ');
if existe_fic_voo then
Begin
writeln('(8) //////////////////-> Escrever todos os voos ');
writeln('(9) //////////////////-> Pesquisar um voo');
end;
writeln('.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,.,');
writeln('(10) //////////////////-> Sair');
writeln('Escreve a tua opção, respetivamente ao numero');
writeln('A tua opção: '); readln(opcao);

case opcao of
1:
Begin
clrscr;
esc_clientes;
writeln;
writeln;

end;
2:
Begin
clrscr;
if existe_fic_clientes then
l_clientes;

end;
3:
Begin
clrscr;
if existe_fic_clientes then
Pesquisar_por_Num_civil_cliente;

end;
4:
Begin
clrscr;
esc_fornecedor;


end;
5:
Begin
clrscr;
if existe_fic_fornecedor then
l_fornecedor;

end;
6:
Begin
clrscr;
if existe_fic_fornecedor then
Pesquisar_por_empresa_fornecedor;

end;
7:
Begin
clrscr;
esc_voo;


end;
8:
Begin
clrscr;
if existe_fic_voo then
l_voo;

end;
9:
Begin
clrscr;
if existe_fic_voo then
Pesquisar_por_Destino_voo;

end;

end;
until (opcao = 10);
writeln('Saiu com sucesso no programa, obrigado por utiiza-lo!');
readkey;
clrscr;
end;

Begin
clrscr;
MENU;

end.

O problema é o seguinte, sempre que vou pesquisar sobre um cliente, fornecedor ou voo, e que ele não encontro nenhum resultado, ele dá para mim 3 opções, e sempre que escolho para criar mais um, ele pede para inserir e depois grava no ficheiro e depois vai pedir outra vez o valor a pesquisar (fiz isso para um sistema de compras, que ainda não fiz ), coloco e depois erro.

O estúpido é que só acontece ás vezes!

Erro():

Runtime error 103 at $00000000004027DD

$00000000004027DD

$0000000000402CF3

$0000000000402D5B

$0000000000400180

Já agora como coloco as cores de programação no forum?

Edited by nunopicado
Sintax Highlight

"The greatest mistake you can make in this life is to be continually fearing you will make one."

Elbert Hubbard -

 

Link to comment
Share on other sites

Para as cores, edita o teu post e vê o que te coloquei à frente da palavra CODE.

Basta meter CODE=Pascal e já fica com cores.

Quanto ao erro, possivelmente estás a fechar o ficheiro em algum lado e não o abres novamente para gravar a segunda vez. Mas só analisando o código.

E neste sentido, deixa que te diga, indentação é coisa bonita. 🙂 O teu código parece um prato de esparguete e tentar seguir um fio é obra.

Indenta SEMPRE o teu código. É mais fácil para outros que o leiam, e é mais fácil para ti.

Do que deu para ver, estás a fazer uma coisa mal:

O Assign só se faz uma vez para cada ficheiro.

Crias um procedimento, por exemplo InitFicheiros, e nele fazes todos os assigns, e todas as verificações se os ficheiros existe, e o rewrite caso não exista.

Se fizeres o rewrite, fazes logo de caminho o close.

Depois ao longo do programa, sempre que precisas de ler ou gravar algo num ficheiro, fazes Reset - operação de leitura ou escrita - Close.

Se usares sempre essa regra, dificilmente tens problemas com eles.

  • Vote 1

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Link to comment
Share on other sites

ola, olha acho que resolvi e implementei as tuas digas e obrigado por isso 😉, mas agora estou com um problema neste procedimento:

procedure Pesquisar_por_Destino_voo;
var entrada:string[50]; aux2:boolean; aux:dad_voos; opc:integer;
Begin

repeat
aux2:=false;
entrada:='';
write('Destino: '); readln(entrada);
reset(ficheiros_voos);
while not(eof(ficheiros_voos)) do
Begin
read(ficheiros_voos,aux);
if (entrada = aux.destino ) then
Begin
 Monstrar_voo(aux);
 readkey;
 aux2:=true;
end;
end;

if (aux2=false)then
Begin
 writeln('Nenhum voo com esse destino, o que deseja realizar?');
 writeln('1-> Registar um novo voo.');
 writeln('2-> Inserir novamente o destino');
 writeln('3-> Voltar para o menu');
 write('A sua opção: '); readln(opc);
 if (opc=1) then
 esc_voo;
end;

until((opc = 3) or (aux2 = true));
close(ficheiros_Clientes);
end;

Parece que sempre que não acho um resultado e escolho no menu a opção 2,3 do que realizar a operação, ele resolve dar erro, e também quando ele apresenta o resultado, depois o mesmo erro!

Este procedimento faz quase a mesma coisa, só que não embirra com o erro!

procedure Pesquisar_por_Num_civil_cliente;
var entrada:integer; auxiliar:boolean; aux:dad_cliente; op:integer;
Begin

repeat
auxiliar:=false;
entrada:=0;
clrscr;
write('Numero Civil: '); readln(entrada);
reset(ficheiros_Clientes);
while not(eof(ficheiros_Clientes)) do
Begin
read(ficheiros_Clientes,aux);
if (entrada = aux.num_civil ) then
Begin
 Monstrar_cliente(aux);
 readkey;
 auxiliar:=true;
end;
end;
if (auxiliar=false)then
Begin
 writeln('Nenhum cliente com esse numero civil, o que deseja realizar?');
 writeln('1-> Registar um novo cliente.');
 writeln('2-> Inserir novamente o numero civil');
 writeln('3-> Voltar para o menu');
 write('A sua opção: '); readln(op);
 if (op=1) then
 esc_clientes;
end;

until((op = 3) or (auxiliar = true));
close(ficheiros_Clientes);
end;

"The greatest mistake you can make in this life is to be continually fearing you will make one."

Elbert Hubbard -

 

Link to comment
Share on other sites

Tens o Reset dentro do repeat, e o Close fora.

Acerta isso e testa depois.

Se só usas o ficheiro no while, o close deve ficar imediatamente depois do end do while.

"A humanidade está a perder os seus génios... Aristóteles morreu, Newton já lá está, Einstein finou-se, e eu hoje não me estou a sentir bem!"

> Não esclareço dúvidas por PM: Indica a tua dúvida no quadro correcto do forum.

Link to comment
Share on other sites

Eu já tinha feito isso, não sei porque alterei e acho que foi para fazer teste, mas o erro não era esse, era iniciava como um ficheiro de voo e fechava um ficheiro Cliente é normal que quando bate-se lá ele dava erro, como eu sou uma falta a atenção.

Obrigado, por tudo!

Edited by FMC

"The greatest mistake you can make in this life is to be continually fearing you will make one."

Elbert Hubbard -

 

Link to comment
Share on other sites

Create an account or sign in to comment

You need to be a member in order to leave a comment

Create an account

Sign up for a new account in our community. It's easy!

Register a new account

Sign in

Already have an account? Sign in here.

Sign In Now
 Share

×
×
  • Create New...

Important Information

By using this site you accept our Terms of Use and Privacy Policy. We have placed cookies on your device to help make this website better. You can adjust your cookie settings, otherwise we'll assume you're okay to continue.