program biblioteca;
uses crt;
type premios = record {Tipo de premios}
ano: integer;
nome: string;
end;
livros = record {Tipo de livros}
titulo,autor,tipo,sub:string;
coded, numpag, ano: integer;
premio: array[1..3] of premios; {Livros tem premios}
end;
var armario:file of livros; {variaveis elucidativas}
{Valida e Gera INT!}
function validaint(par:string):integer;
var aux,cod:integer;
begin
val(par,aux,cod);
while(cod <> 0) do
begin
writeln('Valor Invalido. Tente novamente');
readln(par);
val(par,aux,cod);
end;
validaint:=aux;
end;
{foi mal, mas essa versao
rudimentar do bubblesort era a unica
que eu lembrava de cabeca :p }
procedure ordenalivro;
var b1,b2:file of livros;
a1,a2,a3:livros;
max,min,i,j:byte;
begin
max:=filesize(armario);
min:=0;
for i:=max downto 2 do
for j:=0 to max-2 do
begin
seek(armario,j);
read(armario,a1);
read(armario,a2);
if a1.titulo > a2.titulo then
begin
a3:=a1;
a1:=a2;
a2:=a3;
seek(armario,filepos(armario)-2);
write(armario,a1);
write(armario,a2);
{writeln('trocou'); }
end;
{writeln('debug');}
end;
end;
{procedure pra adicionar livros}
procedure adicionalivro(par:string);
var livro:livros;
i,j:byte;
aux:string;
begin
seek(armario,filesize(armario));
livro.titulo:=par;
livro.titulo[1]:=upcase(livro.titulo[1]);
writeln('Digite o nome do Autor do Livro');
readln(livro.autor);
writeln('Digite o tipo do livro (romance, ciencias, cultura, dicionario)');
readln(livro.tipo);
for i:=1 to length(livro.tipo) do
livro.tipo[i]:=upcase(livro.tipo[i]);
while (livro.tipo<>'ROMANCE') and (livro.tipo<>'CIENCIAS') and (livro.tipo<>'CULTURA') and (livro.tipo<>'DICIONARIO') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.tipo);
for i:=1 to length(livro.tipo) do
livro.tipo[i]:=upcase(livro.tipo[i]);
end;
if( livro.tipo = 'ROMANCE') then
begin
writeln('Em frances ou traducao?');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
while (livro.sub<>'FRANCES') and (livro.sub<>'TRADUCAO') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
end;
writeln('Quantos premios o livro granhou? Max. 3');
readln(aux);
j:=validaint(aux);
while (j>4) or (j<0) do
begin
writeln('Numero invalido. Maximo 3 premios');
readln(aux);
j:=validaint(aux);
end;
for i:=1 to j do
begin
writeln('Qual o nome do premio?');
readln(livro.premio[i].nome);
writeln('Qual o ano do premio?');
readln(aux);
livro.premio[i].ano:=validaint(aux);
end;
end;
if( livro.tipo = 'CIENCIAS') then
begin
writeln('Digite o subtipo(Fisica, Quimica, Biologia, Espaco, Medicina):');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
while (livro.sub<>'FISICA') and (livro.sub<>'QUIMICA') and (livro.sub<>'BIOLOGIA')
and (livro.sub<>'ESPACO') and (livro.sub<>'MEDICINA') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
end;
end;
if( livro.tipo = 'CULTURA') then
begin
writeln('Digite o subtipo(Atualidades, Historia, Filosofia, Sociologia):');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
while (livro.sub<>'ATUALIDADES') and (livro.sub<>'HISTORIA') and (livro.sub<>'FILOSOFIA')
and (livro.sub<>'SOCIOLOGIA') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
end;
end;
{aqui fica mais claro}
writeln('Digite o codigo do editor:');
readln(aux);
livro.coded:=validaint(aux);
writeln('Digite o numero de paginas:');
readln(aux);
livro.numpag:=validaint(aux);
writeln('Digite o ano do livro:');
readln(aux);
livro.ano:=validaint(aux);
write(armario,livro);
ordenalivro;
writeln('Livro adicionado com sucesso');
writeln('Aperte qualquer tecla para continuar');
readkey;
clrscr;
end;
{procedure que procura os livros
do tipo passado como parametro}
procedure procuralivro(aux:string);
var i,j:byte;
a:livros;
begin
for i:=1 to length(aux) do
aux[i]:=upcase(aux[i]);
seek(armario,0);
while not(eof(armario)) do
begin
read(armario,a);
if(a.tipo = aux) then
writeln(a.titulo);
end;
readkey;
end;
{procedimento que examina um livro
mostrando autor, categoria, subcategoria...
}
procedure lelivro(aux:string);
var i:byte;
a:livros;
begin
aux[1]:=upcase(aux[1]);
seek(armario,0);
while not(eof(armario)) do
begin
read(armario,a);
if(a.titulo = aux) then
begin
writeln(a.titulo);
writeln('Escrito em: ',a.ano);
if(a.tipo='DICIONARIO') then
writeln('Eh um dicionario');
if(a.tipo='CIENCIAS') then
writeln('Eh um livro de ',a.sub);
if(a.tipo='ROMANCE') then
if(a.sub='TRADUCAO') then
writeln('Eh um romance traduzido')
else writeln('Eh um romance em frances');
if(a.tipo='CULTURA') then
writeln('Eh um livro sobre cultura');
writeln('Escritor: ',a.autor);
writeln('Possui ',a.numpag,' paginas');
writeln('Cod. Editor: ',a.coded);
end;
end;
writeln('Pressione qualquer tecla para continuar');
readkey;
end;
{nem sei pq fiz esse menu edicao e nao fiz junto}
procedure menuedicao;
begin
writeln('1 - Editar nome do livro');
writeln('2 - Editar autor do livro');
writeln('3 - Editar ano do livro');
writeln('4 - Editar tipo do livro');
writeln('5 - Editar Codigo do Editor');
writeln('6 - Terminar edicao e voltar ao menu anterior');
end;
{procedure que altera o livro
cujo titulo eh passado por referencia
e depois, somente no final, ele atualiza
e faz as alteracoes}
procedure alteralivro(par: string);
var aux,livro:livros;
op:string;
op2:integer;
auxi:string;
i,j:byte;
begin
par[1]:=upcase(par[1]);
seek(armario,0);
while not(eof(armario)) do
begin
read(armario,aux);
if(aux.titulo = par) then
begin
repeat
menuedicao;
readln(op);
op2:=validaint(op);
while (op2>8) or (op2<0) do
begin
writeln('Opcao Invalida. Tente novamente');
readln(op);
op2:=validaint(op);
end;
case op2 of
1: begin
writeln('Digite o novo nome do livro');
readln(aux.titulo);
aux.titulo[1]:=upcase(aux.titulo[1]);
writeln('Alteracao efetuada com sucesso');
end;
2: begin
writeln('Digite o nome do autor do livro');
readln(aux.autor);
writeln('Alteracao efetuada com sucesso');
end;
3: begin
writeln('Digite o ano do livro');
readln(aux.ano);
writeln('Alteracao efetuada com sucesso');
end;
4: begin
writeln('Digite o tipo do livro (romance, ciencias, cultura, dicionario)');
readln(livro.tipo);
for i:=1 to length(livro.tipo) do
livro.tipo[i]:=upcase(livro.tipo[i]);
while (livro.tipo<>'ROMANCE') and (livro.tipo<>'CIENCIAS') and (livro.tipo<>'CULTURA') and (livro.tipo<>'DICIONARIO') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.tipo);
for i:=1 to length(livro.tipo) do
livro.tipo[i]:=upcase(livro.tipo[i]);
end;
if( livro.tipo = 'ROMANCE') then
begin
writeln('Em frances ou traducao?');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
while (livro.sub<>'FRANCES') and (livro.sub<>'TRADUCAO') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
end;
writeln('Quantos premios o livro granhou? Max. 3');
readln(auxi);
j:=validaint(auxi);
while (j>4) or (j<0) do
begin
writeln('Numero invalido. Maximo 3 premios');
readln(auxi);
j:=validaint(auxi);
end;
for i:=1 to j do
begin
writeln('Qual o nome do premio?');
readln(livro.premio[i].nome);
writeln('Qual o ano do premio?');
readln(auxi);
livro.premio[i].ano:=validaint(auxi);
end;
end;
if( livro.tipo = 'CIENCIAS') then
begin
writeln('Digite o subtipo(Fisica, Quimica, Biologia, Espaco, Medicina):');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
while (livro.sub<>'FISICA') and (livro.sub<>'QUIMICA') and (livro.sub<>'BIOLOGIA')
and (livro.sub<>'ESPACO') and (livro.sub<>'MEDICINA') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
end;
end;
if( livro.tipo = 'CULTURA') then
begin
writeln('Digite o subtipo(Atualidades, Historia, Filosofia, Sociologia):');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
while (livro.sub<>'ATUALIDADES') and (livro.sub<>'HISTORIA') and (livro.sub<>'FILOSOFIA')
and (livro.sub<>'SOCIOLOGIA') do
begin
writeln('Tipo invalido. Verifique o que voce digitou.');
readln(livro.sub);
for i:=1 to length(livro.sub) do
livro.sub[i]:=upcase(livro.sub[i]);
end;
end;
end;
{ 5: begin
writeln('Tenho que mecher aqui tmb');
end; }
5: begin
writeln('Digite o codigo do editor');
readln(aux.coded);
writeln('Alteracao efetuada com sucesso');
end;
end;
until(op2=6);
seek(armario,(filepos(armario)-1));
write(armario,aux);
ordenalivro;
end;
end;
writeln('Pressione qualquer tecla para continuar');
readkey;
clrscr;
end;
{essa foi a melhor do dia!
procedure que apaga livros!
usando o truncate do turbopascal
e como estamos em uma biblioteca
onde os livros sao ordenados
alfabeticamente nao existem
problemas no meu ponto de vista
ao se utilizar de tal tecnica}
procedure apagalivro(par:string);
var aux:livros; troca:livros;
swap:file of livros;
status:boolean;
begin
par[1]:=upcase(par[1]);
assign(swap,'c:\ap\livros.txt');
{$I-}
reset(swap);
{$I+}
if (ioresult <> 0) then rewrite(swap);
seek(armario,0);
status:=false;
if filesize(armario) > 0 then
while not(eof(armario)) do
begin
read(armario,aux);
if (aux.titulo = par) then
begin
status:=true;
assign(swap,'c:\ap\livros.txt');
{$I-}
reset(swap);
{$I+}
seek(swap,filesize(swap)-1);
read(swap,troca);
seek(armario,(filepos(armario)-1));
write(armario,troca);
seek(swap,filesize(armario)-1);
truncate(swap);
ordenalivro;
end;
end
else
begin
status:=true;
writeln('Nao existem livros a serem excluidos');
end;
if status=false then
writeln('Nao foi possivel excluir o seu livro pois ele nao foi encontrado.')
else writeln('Pressione qualquer tecla para continuar.');
readkey;
end;
{exibe o titulo de todos os livros}
procedure mostralivros;
var aux:livros;
begin
seek(armario,0);
while not(eof(armario)) do
begin
read(armario,aux);
writeln(aux.titulo);
end;
writeln('Pressione qualquer tecla para continuar');
readkey;
end;
{gera o menu que pode ser interagido com}
procedure geramenu;
var op3:integer;
aux:string;
begin
repeat
textcolor(white+blink); {boiolagem}
textbackground(blue); {frescura}
clrscr;
writeln('<<<< PROGRAMA BIBLIOTECA >>>>');
textcolor(yellow); {vale nota?}
writeln('1 - Adiciona livro');
writeln('2 - Alterar um livro');
writeln('3 - Apagar um livro');
writeln('4 - Pesquisar um livro');
writeln('5 - Mostra Livros');
writeln('6 - Ler Livro');
writeln('7 - SAIR');
readln(aux);
op3:=validaint(aux);
while (op3>7) or (op3<0) do
begin
writeln('Opcao Invalida. Tente novamente');
readln(aux);
op3:=validaint(aux);
end;
case op3 of
1: begin
writeln('Digite o titulo do livro que voce quer adicionar:');
readln(aux);
adicionalivro(aux);
end;
2: begin
writeln('Digite o titulo do livro que voce quer alterar');
readln(aux);
alteralivro(aux);
end;
3: begin
writeln('Digite o nome do livro que voce quer apagar:');
readln(aux);
apagalivro(aux);
end;
4: begin
writeln('Que tipo de livro voce deseja encontrar?');
writeln('Dicionario - Cultura - Romance - Ciencias');
readln(aux);
procuralivro(aux);
end;
5: mostralivros;
6: begin
writeln('Qual livro voce quer examinar?');
readln(aux);
lelivro(aux);
end;
end;
until op3=7;
end;
begin
assign(armario,'c:\ap\livros.txt');
{$I-}
reset(armario);
{$I+}
if (ioresult <> 0) then rewrite(armario);
geramenu;
{ truncate }
writeln('Obrigado por usar esse programa.');
readkey;
end.