domingo, 30 de janeiro de 2011

Banco de dados

PROGRAM BANCODADOS;
USES CRT;
TYPE pessoa = RECORD
nome : string[40];
fone : integer;
endereco : string[40];
rg : integer;
ativo : integer;
END;
pesso = FILE Of pessoa;

VAR LISTA, AUXILIAR : pesso;
PESSOAS, AUX : pessoa;
NOME1 : STRING[40];
FONE1 : INTEGER;
ENDERECO1 : STRING[40];
RG1 : INTEGER;
P,K,I,POSICAO : INTEGER;
ACHOU : BOOLEAN;
SAIR : BOOLEAN;
OPCAO : INTEGER;
RGPRO : INTEGER;
ACHOURG : BOOLEAN;
RGALT : INTEGER;
NOMEALT : STRING[40];
FONEALT : INTEGER;
ENDALT : STRING[40];
ACHOURGALT : BOOLEAN;


PROCEDURE EXCLUSAO;
BEGIN

CLRSCR;
ASSIGN (LISTA,'PESSOAS.DAT');
RESET (LISTA);
ASSIGN (AUXILIAR,'AUXILIO.DAT');
REWRITE (AUXILIAR);
K := FILESIZE(LISTA);
WRITELN ('DIGITE O RG A SER EXCLUIDO');
READLN(RG1);
ACHOU := FALSE;
READ (LISTA,PESSOAS);
WHILE (ACHOU = FALSE) AND (NOT EOF (LISTA)) DO
BEGIN
IF PESSOAS.RG = RG1
THEN BEGIN
ACHOU := TRUE;
POSICAO := FILEPOS(LISTA) -1;
END;
READ (LISTA,PESSOAS);
END;
IF ACHOU = TRUE
THEN BEGIN
K := 0;
SEEK(LISTA,K);
WHILE K < POSICAO DO
BEGIN
SEEK(LISTA,K);
READ(LISTA,PESSOAS);
AUX.NOME := PESSOAS.NOME;
AUX.FONE := PESSOAS.FONE;
AUX.ENDERECO := PESSOAS.ENDERECO;
AUX.RG := PESSOAS.RG;
WRITE(AUXILIAR,AUX);
K := K + 1;
END;
K := POSICAO + 1;
WHILE K <= FILESIZE(LISTA) - 1 DO
BEGIN
SEEK(LISTA,K);
READ(LISTA,PESSOAS);
AUX.NOME := PESSOAS.NOME;
AUX.FONE := PESSOAS.FONE;
AUX.ENDERECO := PESSOAS.ENDERECO;
AUX.RG := PESSOAS.RG;
WRITE(AUXILIAR,AUX);
K := K + 1;
END;
REWRITE(LISTA);
RESET(AUXILIAR);
WHILE NOT EOF(AUXILIAR) DO
BEGIN
READ(AUXILIAR, AUX);
PESSOAS.NOME := AUX.NOME;
PESSOAS.FONE := AUX.FONE;
PESSOAS.ENDERECO := AUX.ENDERECO;
PESSOAS.RG := AUX.RG;
WRITE(LISTA,PESSOAS);
END;
WRITELN ('DADO EXCLUIDO');
READLN;
END
ELSE WRITELN ('ESTE RG NAO ESTA CADASTRADO');READLN;
CLOSE(LISTA);
CLOSE(AUXILIAR);
END;{fim procedure exclusao fisica}


PROCEDURE INCLUSAO;
BEGIN
CLRSCR;
ASSIGN (LISTA,'PESSOAS.DAT');
RESET (LISTA);
K := FILESIZE (LISTA);
WRITELN ('DIGITE O NOME A SER INCLUIDO ');
READLN (NOME1);
WRITELN ('DIGITE O FONE A SER INCLUIDO');
READLN (FONE1);
WRITELN ('DIGITE ENDERECO A SER INCLUIDO');
READLN (ENDERECO1);
WRITELN ('DIGITE O RG A SER INCLUIDO');
READLN (RG1);



IF K = 0
THEN BEGIN
PESSOAS.NOME := NOME1;
PESSOAS.FONE := FONE1;
PESSOAS.ENDERECO := ENDERECO1;
PESSOAS.RG := RG1;
WRITE (LISTA,PESSOAS);

WRITELN ('DADOS INCLUIDOS');
READLN;
CLRSCR;

END
ELSE BEGIN
I := 0;
ACHOU := FALSE;
POSICAO := 0;
RESET (LISTA);
WHILE (I <= (K-1)) DO
BEGIN
READ (LISTA,PESSOAS);
IF PESSOAS.RG = RG1
THEN BEGIN
ACHOU := TRUE;
I := K + 2;
END
ELSE BEGIN
IF RG1 < PESSOAS.RG
THEN BEGIN
POSICAO := FILEPOS(LISTA) - 1;
I := K + 2;
END
ELSE BEGIN
I := I + 1;
SEEK (LISTA,I);
END;
END;
END;
IF ACHOU = TRUE
THEN WRITELN ('ESTE RG JA ESTA CADASTRADO')
ELSE BEGIN
IF I = FILESIZE(LISTA)
THEN BEGIN
SEEK(LISTA, FILESIZE(LISTA));
PESSOAS.NOME := NOME1;
PESSOAS.FONE := FONE1;
PESSOAS.ENDERECO := ENDERECO1;
PESSOAS.RG := RG1;
WRITE(LISTA,PESSOAS);
WRITELN ('DADO INCLUIDO');
END
ELSE BEGIN
P := FILESIZE(LISTA) - 1;
WHILE P >= POSICAO DO
BEGIN
SEEK (LISTA,P);
READ(LISTA,PESSOAS);
WRITE(LISTA,PESSOAS);
P := P - 1;
END;
SEEK(LISTA,POSICAO);
PESSOAS.NOME := NOME1;
PESSOAS.FONE := FONE1;
PESSOAS.ENDERECO := ENDERECO1;
PESSOAS.RG := RG1;
WRITE (LISTA,PESSOAS);
WRITELN ('DADOS INCLUIDOS');
READLN;
CLRSCR;
END;
END;
END;
CLOSE(LISTA);
END;



PROCEDURE CONSULTA;
BEGIN
CLRSCR;
ASSIGN(LISTA,'PESSOAS.DAT');
RESET(LISTA);
WHILE NOT EOF(LISTA) DO
BEGIN
READ(LISTA,PESSOAS);
WRITELN('NOME = ',PESSOAS.NOME);
WRITELN('FONE = ',PESSOAS.FONE);
WRITELN('ENDERE€O = ',PESSOAS.ENDERECO);
WRITELN ('RG = ',PESSOAS.RG);
READLN;
END;
CLOSE (LISTA);
READLN;
END;



PROCEDURE CONSULTAFOR;
BEGIN
CLRSCR;
ASSIGN(LISTA,'PESSOAS.DAT');
RESET(LISTA);
ACHOURG := FALSE;
CLRSCR;
WRITELN ('DIGITE O RG PROCURADO:');
WRITELN;
READLN (RGPRO);
CLRSCR;

WHILE NOT EOF(LISTA) DO
BEGIN
READ(LISTA,PESSOAS);
IF PESSOAS.RG = RGPRO
THEN BEGIN
WRITELN('NOME = ',PESSOAS.NOME);
WRITELN('FONE = ',PESSOAS.FONE);
WRITELN('ENDERE€O = ',PESSOAS.ENDERECO);
WRITELN ('RG = ',PESSOAS.RG);
READLN;
ACHOURG := TRUE;
END;
END;

IF (ACHOURG = FALSE) THEN BEGIN
CLRSCR;
WRITELN ('ESTE RG NAO ESTA CADASTRADO.');
READLN;
END;

CLOSE(LISTA);
READLN;
END;



PROCEDURE ALTERACAO;
BEGIN
CLRSCR;
ASSIGN(LISTA,'PESSOAS.DAT');
RESET(LISTA);
K := FILESIZE(LISTA);
I := 0;
ACHOURGALT := FALSE;
WRITELN('DIGITE O RG QUE DESEJA ALTERAR');
READLN(RGALT);
WHILE (I <= K-1) DO
BEGIN
SEEK(LISTA,I);
READ(LISTA,PESSOAS);
IF (PESSOAS.RG = RGALT) THEN BEGIN
POSICAO := I;
I := K + 1;
ACHOURGALT := TRUE;
END
ELSE BEGIN
I := I + 1;
END;

IF (ACHOURGALT = TRUE) THEN BEGIN
WRITELN('DIGITE O NOVO NOME ');
READLN(NOMEALT);
WRITELN('DIGITE O NOVO TELEFONE');
READLN(FONEALT);
WRITELN ('DIGITE O NOVO ENDERE€O');
READLN (ENDALT);
PESSOAS.NOME := NOMEALT;
PESSOAS.FONE := FONEALT;
PESSOAS.ENDERECO := ENDALT;
SEEK(LISTA,POSICAO);
WRITE(LISTA,PESSOAS);
WRITELN('ALTERACAO EFETUADA');
READLN;
END;
END; {fim do while}

IF (ACHOURGALT = FALSE) THEN BEGIN
WRITELN('RG NAO CADASTRADO');
READLN;
END;

CLOSE (LISTA);
READLN;
END;


PROCEDURE CRIACAO;
BEGIN


ASSIGN (LISTA,'PESSOAS.DAT');
REWRITE (LISTA);
CLOSE (LISTA);
END;{fim procedure}




BEGIN {---------PROG PRINCIPAL--------}

CLRSCR;
SAIR := FALSE;

REPEAT {--------ENGINE DO PROGRAMA----}

OPCAO := 0;
CLRSCR;
WRITELN ('O ARQUIVO JA EXISTE 1-SIM, 2-NAO .');
READLN (OPCAO);
IF (OPCAO = 2) THEN BEGIN
CRIACAO;
END;
OPCAO := 0;
CLRSCR;

WRITELN ('ESCOLHA A OPERACAO :');
WRITELN;
WRITELN ('1- SAIR.');
WRITELN ('2- INCLUSAO ORDENADA.');
WRITELN ('3- EXCLUSAO FISICA.');
WRITELN ('4- CONSULTA GERAL.');
WRITELN ('5- CONSULTA FORMULADA.');
WRITELN ('6- ALTERACAO.');
WRITELN;
READLN (OPCAO);

IF (OPCAO = 6) THEN BEGIN
ALTERACAO;
END;

IF (OPCAO = 5) THEN BEGIN
CONSULTAFOR;
END;

IF (OPCAO = 4) THEN BEGIN
CONSULTA;
END;

IF (OPCAO = 2) THEN BEGIN
INCLUSAO;
END;

IF (OPCAO = 3) THEN BEGIN
EXCLUSAO;
END;

IF (OPCAO = 1) THEN BEGIN
SAIR := TRUE;
END;


UNTIL SAIR = TRUE;

READLN;
END.

4 comentários:

  1. Super bem explicado, código bem comentado. Muito bem companheiro. Por isso ninguém acessa esse lixo.

    ResponderExcluir
  2. Mano pior que é verdade, se o blog foi feito para iniciante deveria explicar melhor.

    ResponderExcluir
  3. Por que vcs "Anônimos" não estudam o codigo em si, fazendo comparações, pesquisando, se baseando, o cara fez o codigo inteiro, testem, vejam e analisem... oh geração preguiçosa. Gosto muito do site e está até favoritado e tem me ajudado muito. E tenho apenas 3 meses de Logica de Programação!

    ResponderExcluir
  4. Contribuição muito top, muito obrigado pelo codigo-fonte.
    continue assim compartilhando conhecimento.

    ResponderExcluir