sexta-feira, 10 de agosto de 2012

Arquivo deverá ser do tipo Text e a variável do tipo String


Arquivos em disco.

IX.1 - O tipo File

O tipo file ou arquivo, é uma estrutura constituída de elementos do mesmo tipo dispostos seqüencialmente. Essa estrutura é utilizada para comunicação com o meio externo, principalmente com discos magnéticos.

IX.1.1 - Definição do tipo File

A sintaxe geral para definir uma variável com esse tipo de estrutura é:

                Type Arquivo = File of <Tipo>;

                Var a : Arquivo

Após as declarações  acima, a variável 'a' passa a representar um arquivo de elementos do tipo <Tipo>.

        Exemplos:

        Exemplo 1: Arquivo com números inteiros:

                Type Arq = File Of Integer;
                Var  Arquivo : Arq;

        Ou

                Var Arquivo : File Of Integer;

        Exemplo 2: Arquivo de números reais:

                Type Arq = File Of Real;
                Var  Arquivo : Arq;
        Exemplo 3: Arquivo de records:

                Type Pessoa = Record
                                  Nome   : String[30];
                                  Idade   : Integer;
                                  Sexo    : Char;
                                  Altura   : Real;
                              End;

                Var Arquivo : File Of Pessoa;

         e assim por diante...

IX.2 - Procedimentos para operações em arquivos

O acesso a arquivos sempre segue a mesma seqüência, a saber:

        1-) Abertura do arquivo
        2-) Leitura e/ou escrita de dados no arquivo
        3-) Fechamento do arquivo

Para tanto, existem diversas procedures para executar tais operações e que passaremos a examinar agora.

IX.2.1 - Assign

Esta procedure tem a finalidade de atribuir um nome lógico ao arquivo físico, ou seja, ao nome do arquivo em disco. Sintaxe:

                Assign(Variável_do_tipo_file,Nome_do_arquivo);

        Exemplo:

Program Exemplo;
        Uses CRT;
        Type Arquivo = File Of Integer;
        Var Arq : Arquivo;
        Begin
                Assign(Arq,'B:EXEMPLO.DTA');

(* a partir desse instante, todas as operações de escrita ou leitura que forem realizadas com a variável Arq, será automaticamente feitas no arquivo EXEMPLO.DTA no drive B *)

                . . .
                . . .
        End.

IX.2.2 - Abertura de arquivos ( Rewrite e Reset )

        Para abrir arquivos, dispomos de duas procedures, a saber:

Rewrite(<Arq>);

Esta procedure apaga o arquivo em disco associado à variável Arq e cria um novo arquivo.
Exemplo:

        Program Exemplo;
        Uses CRT;
        Type Arquivo = File Of Integer;
        Var Arq : Arquivo;
        Begin
                Assign(Arq,'B:EXEMPLO.DTA');
                Rewrite(Arq);
                (* Após estas declarações, teremos um novo arquivo no drive  B com o nome 'EXEMPLO.DTA' *)
                . . .
                . . .
        End.

Reset(Arq);

{Esta procedure abre o arquivo em disco associado à variável Arq para leitura ou escrita. Esta procedure parte do princípio que o arquivo exista em disco, caso ele não exista, haverá erro. }

Exemplo:

        Program Exemplo;
        Uses CRT;
        Type Arquivo = File Of Integer;
        Var Arq : Arquivo;
        Begin
                Assign(Arq,'B:EXEMPLO.DTA');
                Reset(Arq);

(* Após estas declarações, o arquivo no drive B com o nome 'EXEMPLO.DTA' está aberto e pronto para as operações de entrada e saída *)
                . . .
                . . .
        End.

IX.2.3 - Escrevendo e lendo dados no arquivo ( Write,Read )

A procedure utilizada para escrever dados em um arquivo é Write. Sua sintaxe é:

Write(Arq,var);

Os dados são gravados seqüencialmente no arquivo, ou seja, um após o outro e isto é feito automaticamente pela procedure Write. Para tanto a linguagem Pascal mantém um apontador de registro de arquivo que aponta sempre para o número de registro, onde será gravado ou lido um dado.



Exemplo:

Program Exemplo;
        Uses CRT;
        Type Arquivo = File Of Integer;
        Var Arq : Arquivo;
            i   : Integer;
        Begin
                Assign(Arq,'B:EXEMPLO.DTA');
                Rewrite(Arq);
                For i:=1 to 100 do Write(Arq,i);
(* com a instrução acima, teríamos escrito seqüencialmente no arquivo B:EXEMPLO.DTA os números de 1 a 100 *)
                . . .
                . . .
        End.

Como já dissemos anteriormente, a linguagem Pascal mantém um apontador de registro que indica o próximo registro que será lido ou escrito, e toda vez que fazemos uma leitura ou escrita num registro, o apontador é incrementado de um, isto é automático. No entanto, dispomos de uma procedure que nos permite alterar o valor desse apontador e portanto, nos permite acessar qualquer registro que quisermos. Essa procedure chama-se Seek. A propósito, o número do primeiro registro é zero. A sintaxe desta procedure é:

        Seek(Arq,número_do_registro);

        Para ler dados do arquivo,dispomos da procedure Read cuja sintaxe é:

        Read(Arq,Var);

        Exemplo:

Program Exemplo;
        Uses CRT;
        Type Arquivo = File Of Integer;
        Var Arq : Arquivo;
            i   : Integer;
        Begin
                Assign(Arq,'B:EXEMPLO.DTA');
                Rewrite(Arq);
                For i:=1 to 100 do Write(Arq,i);
                Seek(Arq,0);  (* posiciona o apontador de registro no registro número 0 *)
                Read(Arq,i);  (* a variável i fica igual ao conteúdo do registro número 0 que no presente exemplo valeria 1,a propósito,
                              o apontador de registro já está valendo 1 *)
                Read(Arq,i);  (* i agora está valendo 2 *)
                . . .
                . . .
        End.

IX.2.4 - Fechamento do arquivo

Como já foi visto, após a abertura do arquivo, leitura e/ou escrita de dados, devemos fechá-lo. Para tanto, dispomos da procedure close cuja sintaxe é:

Close(Arq);

        Exemplos de programas:

        Exemplo 1:

PROGRAMA Grava --> Lê números do teclado e em seguida os grava num arquivo em disco AUTOR : Thelmo J. M. Mesquita

        Program grava;
        Uses CRT;
        Var arquivo : File Of Integer;
            i       : Integer;
        Begin
           ClrScr;
           Assign(arquivo,'arquivo.dta');
           ReWrite(arquivo);
           Repeat
              Write('Numero --> ');
              Readln(i);
              Write(arquivo,i);
           Until i=0;
           Close(arquivo);
        End.

(* O próximo programa lê os números gravados pelo programa anterior *)

PROGRAMA : Le.pas ---> Le numeros de um arquivo em disco
         AUTOR    : Thelmo J. M. Mesquita

        Program le;
        Uses CRT;
        Var arquivo : File Of Integer;
            i       : Integer;
        Begin
           ClrScr;
           Assign(arquivo,'arquivo.dta');
           Reset(arquivo);
           Repeat
              Read(arquivo,i);
              Writeln(i);
           Until i=0;
           Close(arquivo);
        End.

        Exemplo 2:

Program Exemplo_2;
        Uses CRT;
{Programa que grava num arquivo em disco, o quadrado dos números de 0 a 100 e depois permite consulta através da instrução seek}

        Var Arq : File of Real;
            i : Integer;
            s : real;
        Begin
           Assign(Arq,'Arquivo.dta');
           Rewrite(Arq);
           For i:=0 to 100 do Begin
                                 s:=i*i;
                                 Write(Arq,s);
                              End;
           Close(Arq);
           Reset(Arq);
           ClrScr;
           While i>=0 do
           Begin
              Write('Numero --> ');
              Readln(i);
              if (i>=0) And (i<=100)
                 Then Begin
                         seek(Arq,i);
                         Read(Arq,s);
                         Writeln;
                         Writeln(s:10:0);
                         Writeln;
                      End;
          End;
          Close(Arq);
        End.

        Exemplo 3:

ARQUIVO.PAS : Este programa tem a finalidade de gerenciar um arquivo em disco cujos registros contém dois campos, a saber:
                       NOME   : 20 caracteres
                       IDADE  : integer

         O programa apresenta inicialmente o seguinte menu:
                       1 - ) Sair do programa
                       2 - ) Entrar com registros
                       3 - ) Listar todos os registros
                       4 - ) Pesquisa por nome
(*$I-*) (* esta diretiva de compilação tem a finalidade de indicar ao compilador que os erros de I/O  (entrada/saída)  serão verificados pelo programador, ou seja, se houver algum erro de I/O durante a execução do programa, o programa não irá abortar. Para que o programador saiba se uma determinada operação de I/O funcionou corretamente, ele deverá verificar o valor da variável IORESULT. Se ela for diferente de zero, então ocorreu algum erro e o programador deverá então tomar alguma providência *)

        Program Exemplo_De_Arquivo;
        Uses CRT;
        Type Pessoa = Record
                         Nome   : String[20];
                         Idade  : Integer;
                      End;
             Frase  = String[80];
        Var  Arquivo    : File Of Pessoa;
             P               : Pessoa;
             escolha      : Integer;
        Procedure Linha; (* traça uma linha na posição atual do
                            cursor *)
        Var i : Integer;
        Begin
           For i:=1 to 80 Do Write('-');
        End;
        Procedure Centro(S:Frase); (* centra string S na tela *)
        Var x:integer;
        Begin
           x:=40+(Length(S)) DIV 2; (* lenght retorna o número de
                                       caracteres do parâmetro *)
           Writeln(S:x);
        End;
        Procedure InReg; (* procedimento p/ incluir registros *)
        Var resposta:char;
        Begin
           ClrScr;
           Linha;
           Centro('ROTINA PARA ENTRAR REGISTROS');
           Reset(arquivo);
(*Neste trecho do programa, iremos utilizar uma função nova : FILESIZE(arq) retorna quantos registros possui o arquivo "arq"     *)
           Seek(arquivo,FileSize(arquivo));  (* posiciona o apontador de registros no final do arquivo *)
           resposta:='s';
           Linha;
           While resposta='s' Do
           Begin
              gotoxy(1,5);clreol; (* limpa até final da linha *)
              gotoxy(1,6);clreol;
              gotoxy(1,5);
              Buflen:=20; (* estou limitando o buffer do teclado  em 20 caracteres, o normal é 126 *)
              Write('Nome da pessoa ---> ');
              Readln(P.Nome);
              Buflen:=2;
              clreol;
              Write('Idade da pessoa --> ');
              Readln(P.Idade);
              Linha;
              Write(arquivo,P);
              Write('Deseja Continuar ? -->':50);
              Readln(resposta);
           end;
           close(arquivo);
           Buflen:=126;
        End;
        Procedure LiReg; (* procedimento para listar os registros na tela *)
        Begin
           Reset(arquivo);
           Clrscr;
           Linha;
           writeln('NOME':15,'IDADE':18);
           linha;
           While not eof(arquivo) do
           Begin
              read(arquivo,P);
              Writeln(P.nome:21,' - - - ',P.idade);
           end;
           Linha;
           Close(arquivo);
           Write('Digite uma tecla --> ');
           repeat until keypressed;
        End;
        Procedure PeNo;  (* pesquisa por nome *)
        Var nome : string[20];
        Begin
           Reset(arquivo);
           nome:='1';
           While nome<>'0' Do
           Begin
              Clrscr;
              Linha;
              Centro('PESQUISA POR NOME');
              linha;
              Write('Nome (0=fim) --> ');
              Readln(nome);
              if nome<>'0'
              Then Begin
                      linha;
                      seek(arquivo,0);
                      While not eof(arquivo) do
                      Begin
                         read(arquivo,P);
                         if Pos(nome,P.nome)<>0
                            Then Writeln(P.nome:21,' - - - ',P.idade);
                      End;
                      Linha;
                      Write('Digite uma tecla --> ');
                      repeat until keypressed;
                   End;
           End;
           close(arquivo);
        End;

(* aqui começa o nosso programa, inicialmente devemos verificar se o arquivo "arquivo.dta" existe, se não existir, então ele deverá ser criado *)

        Begin
           Assign(arquivo,'arquivo.dta');
           Reset(arquivo);
           If IOresult <> 0 Then ReWrite(arquivo);
           Close(arquivo);
           Repeat
              ClrScr;
              Linha;
              Writeln('..... Programa para gerenciar um arquivo contendo nomes e');
              Writeln('      idades de pessoas');
              Writeln('..... Escrito em 06/09/93 por Thelmo J.M.Mesquita');
              Linha;
              Gotoxy(24,12);Writeln('1 - Sair do programa');
              Gotoxy(24,14);Writeln('2 - Entrar com registros');
              Gotoxy(24,16);Writeln('3 - Listar todos os registros');
              Gotoxy(24,18);Writeln('4 - Pesquisar por nome');
              Gotoxy(33,10);LowVideo;
              Writeln('SUA ESCOLHA :');NormVideo;
              Repeat
                Gotoxy(47,10);
                read(escolha);
              Until (escolha > 0 ) and (escolha < 5);
              Case escolha of
                 2 : InReg;
                 3 : LiReg;
                 4 : PeNo;
              end;
           Until escolha=1;
           ClrScr;
           Gotoxy(33,12);Writeln('T C H A U . . . . . ');
        End.


        Exemplo 4:

{Este programa tem a finalidade de gerenciar um arquivo em disco com a seguida estrutura:}

                       Nome  : frase;
                       Idade  : Integer;
                       Sexo   : Char;
                       Altura  : Real;
        Program Arquivo;
        Uses CRT;
        Type Frase  = string[20];
             Pessoa = Record
                         Nome   : frase;
                         Idade   : Integer;
                         Sexo    : Char;
                         Altura  : Real;
                      End;
        Var Arq : File Of Pessoa;
            escolha : char;
            p : pessoa;
            s : frase;
        Procedure tecla;
        Begin
           Write(chr(7));
           Write('Digite uma tecla --> ');
           Repeat until keypressed;
        End;
        Procedure Linha;
        Var i:byte;
        Begin
           For i:=1 to 80 do write('-');
        End;
        Function Maiuscula(s:frase):frase;
        var i:byte;
        Begin
           for i:=1 to length(s) do s[i]:=upcase(s[i]);
           maiuscula:=s;
        end;
        Function Acha_Nome(s:frase):integer;
        Label fim;
        Begin
           Acha_Nome:=-1;
           While not eof(arq) do
              Begin
                 Read(arq,p);
                 if pos(s,p.nome) > 0 Then Begin
                                              Acha_Nome:=Filepos(arq)-1;
                                              Goto fim;
                                           End;
              End;
        fim:
        End;
        Procedure Consulta;
        Var escolha : Char;
        Procedure lireg;
        Begin
           Seek(Arq,0);
           ClrScr;
           Linha;
           lowvideo;
           Writeln('NOME':18,'IDADE':12,'SEXO':5,'ALTURA':10);
           Normvideo;
           linha;
           While not eof(arq) do
           Begin
              Read(arq,p);
              With p do
                 Writeln(nome:22,idade:6,sexo:5,altura:10:2);
           End;
           linha;
           tecla;
        End;
        Procedure peno;
        label fim;
        Begin
           Repeat
              clrscr;
              write('Nome para pesquisa (0=fim) -> ');
              readln(s);
              s:=maiuscula(s);
              if s='0' then goto fim;
              Seek(Arq,0);
              ClrScr;
              Linha;
              lowvideo;
              Writeln('NOME':18,'IDADE':12,'SEXO':5,'ALTURA':10);
              Normvideo;
              linha;
              While not eof(arq) do
              Begin
                 Read(arq,p);
                 if pos(s,p.nome)>0 then
                 With p do
                    Writeln(nome:22,idade:6,sexo:5,altura:10:2);
              End;
              linha;
              tecla;
        fim:
           until s='0';
        End;
        Procedure lidade;
        label fim;
        var i1,i2:byte;
        Begin
           Repeat
              clrscr;
              write('Idade no.1 (0=fim) -> ');
              readln(i1);
              if i1=0 then goto fim;
              write('Idade no.2 ---------> ');
              readln(i2);
              Seek(Arq,0);
              ClrScr;
              Linha;
              lowvideo;
              Writeln('NOME':18,'IDADE':12,'SEXO':5,'ALTURA':10);
              Normvideo;
              linha;
              While not eof(arq) do
              Begin
                 Read(arq,p);
                 if ((p.idade>=i1) and (p.idade<=i2)) then
                 With p do
                    Writeln(nome:22,idade:6,sexo:5,altura:10:2);
              End;
              linha;
              tecla;
        fim:
           until i1=0;
        End;
        Procedure lisexo;
        label fim;
        var s:char;
        Begin
           Repeat
              clrscr;
              write('Sexo para pesquisa (0=fim) -> ');
              readln(s);
              s:=maiuscula(s);
              if s='0' then goto fim;
              Seek(Arq,0);
              ClrScr;
              Linha;
              lowvideo;
              Writeln('NOME':18,'IDADE':12,'SEXO':5,'ALTURA':10);
              Normvideo;
              linha;
              While not eof(arq) do
              Begin
                 Read(arq,p);
                 if p.sexo=s then
                 With p do
                    Writeln(nome:22,idade:6,sexo:5,altura:10:2);
              End;
              linha;
              tecla;
        fim:
           until s='0';
        End;
        Procedure lialtura;
        label fim;
        var i1,i2:real;
        Begin
           Repeat
              clrscr;
              write('Altura no.1 (0=fim) -> ');
              readln(i1);
              if i1=0 then goto fim;
              write('Altura no.2 ---------> ');
              readln(i2);
              Seek(Arq,0);
              ClrScr;
              Linha;
              lowvideo;
              Writeln('NOME':18,'IDADE':12,'SEXO':5,'ALTURA':10);
              Normvideo;
              linha;
              While not eof(arq) do
              Begin
                 Read(arq,p);
                 if ((p.altura>=i1) and (p.altura<=i2)) then
                 With p do
                    Writeln(nome:22,idade:6,sexo:5,altura:10:2);
              End;
              linha;
              tecla;
        fim:
           until i1=0;
        End;
        Begin
           Repeat
              ClrScr;
              Gotoxy(32,3);LowVideo;Write('MENU DE CONSULTA');NormVideo;
              Gotoxy(23, 6);Write('1 - Voltar ao menu anterior');
              Gotoxy(23,8);Write('2 - Listar todos os registros na tela');
              Gotoxy(23,10);Write('3 - Pesquisa por nome');
              Gotoxy(23,12);Write('4 - Listar Registros  de  pessoas com');
              Gotoxy(27,13);Write('certa idade');
              Gotoxy(23,15);Write('5 - Listar Registros  de  pessoas  de');
              Gotoxy(27,16);Write('determinado sexo');
              Gotoxy(23,18);Write('6 - Listar registros  de  pessoas  de');
              Gotoxy(27,19);Write('certa altura');
              Gotoxy(32,21);Write('SUA ESCOLHA -> ');
              Repeat
                 escolha:=readkey;
              Until escolha IN ['1','2','3','4','5','6'];
              Write(chr(7));
              Case escolha of
                 '2' : lireg;
                 '3' : peno;
                 '4' : lidade;
                 '5' : lisexo;
                 '6' : lialtura;
              End;
           Until escolha='1';
        End;
        Procedure Altera;
        Var escolha : Char;
        Procedure Inreg;
        Label fim;
        Begin
           seek(Arq,filesize(Arq));
           ClrScr;
           Gotoxy(25,6);LowVideo;
           Write('INTRODUCAO DE UM NOVO REGISTRO');NormVideo;
           Gotoxy(5, 9);Write('NOME (0=fim) --> ');
           Gotoxy(5,11);Write('IDADE ---------> ');
           Gotoxy(5,13);Write('SEXO ----------> ');
           Gotoxy(5,15);Write('ALTURA --------> ');
           Repeat
              Gotoxy(26, 9);write('....................');
              Gotoxy(26,11);write('...');
              Gotoxy(26,13);write('.');
              Gotoxy(26,15);write('....');
              Gotoxy(26, 9);Read(p.nome);
              If p.nome='0' Then Goto Fim;
              Gotoxy(26,11);Read(p.idade);
              Gotoxy(26,13);Read(p.sexo);
              Gotoxy(26,15);Read(p.altura);
              p.nome:=maiuscula(p.nome);
              p.sexo:=maiuscula(p.sexo);
              Write(Arq,p);
        Fim:
           Until p.nome='0';
        End;
        Procedure Delreg;
        label fim;
        var r,i:integer;
            resp,resposta:char;
            temp:file of pessoa;
        Begin
           seek(arq,0);
           Repeat
              ClrScr;
              Gotoxy(25,2);LowVideo;
              Write('ROTINA PARA DELETAR REGISTROS');NormVideo;
              Gotoxy(10,6);Write('Nome (0=fim) --> ');
              Readln(s);
              s:=maiuscula(s);
              if s='0' then goto fim;
              repeat
                 r:=acha_nome(s);
                 if r=-1
                 Then Begin
                         Gotoxy(40,23);
                         lowvideo;
                         write('FIM DE ARQUIVO. . ');
                         normvideo;
                         seek(arq,0);
                         tecla;
                      End
                 Else Begin
                         gotoxy(10, 6);clreol;Write('NOME ...: ',p.nome);
                         gotoxy(10, 8);clreol;Write('IDADE ..: ',p.idade);
                         gotoxy(10,10);clreol;write('SEXO ...: ',p.sexo);
                         gotoxy(10,12);clreol;write('ALTURA .: ',p.altura:6:2);
                         gotoxy(1,16) ;clreol; write('POSSO DELETAR -->');
                         Readln(resposta);
                         resposta:=maiuscula(resposta);
                         if (resposta='S')
                            Then Begin
                                    assign(temp,'tempor');
                                    rewrite(temp);
                                    seek(arq,0);
                                    while not eof(arq) do
                                       if filepos(arq)<>r
                                          then begin
                                                  read(arq,p);
                                                  write(temp,p);
                                               end
                                           else read(arq,p);
                                    close(arq);
                                    close(temp);
                                    erase(arq);
                                    rename(temp,'dados.dta');
                                    reset(arq);
                                 end
                            else Begin
                                    gotoxy(1,16);clreol;
                                    write('CONTINUA A PESQUISA ? --> ');
                                    readln(resp);
                                    resp:=maiuscula(resp);
                                    if  (resp='N')
                                       Then r:=-1;
                                  End;
                      end;
              until r=-1;
        fim:
           Until s='0';
        End;
        Procedure Modreg;
        label fim;
        var r,i:integer;
            resp,resposta:char;
            temp:file of pessoa;
        Begin
           seek(arq,0);
           Repeat
              ClrScr;
              Gotoxy(25,2);LowVideo;
              Write('ROTINA PARA MODIFICAR REGISTROS');NormVideo;
              Gotoxy(10,6);Write('Nome (0=fim) --> ');
              Readln(s);
              s:=maiuscula(s);
              if s='0' then goto fim;
              repeat
                 r:=acha_nome(s);
                 if r=-1
                 Then Begin
                         Gotoxy(40,23);
                         lowvideo;
                         write('FIM DE ARQUIVO. . ');
                         normvideo;
                         seek(arq,0);
                         tecla;
                      End
                 Else Begin
                         gotoxy(10, 6);clreol;Write('NOME ...: ',p.nome);
                         gotoxy(10, 8);clreol;Write('IDADE ..: ',p.idade);
                         gotoxy(10,10);clreol;write('SEXO ...: ',p.sexo);
                         gotoxy(10,12);clreol;write('ALTURA .: ',p.altura:6:2);
                         gotoxy(1,16) ;clreol; write('MODIFICA ? ----->');
                         Readln(resposta);
                         resposta:=maiuscula(resposta);
                         if (resposta='S')
                            Then Begin
                                    gotoxy(20, 6);
                                    read(p.nome);clreol;
                                    gotoxy(20, 8);
                                    read(p.idade);clreol;
                                    gotoxy(20,10);read(p.sexo);
                                    clreol;
                                    gotoxy(22,12);
                                    read(p.altura);clreol;
                                    p.nome:=maiuscula(p.nome);
                                    p.sexo:=maiuscula(p.sexo);
                                    seek(arq,r);
                                    write(arq,p);
                                 end
                            else Begin
                                    gotoxy(1,16);clreol;
                                    write('CONTINUA A PESQUISA ? --> ');
                                    readln(resp);
                                    resp:=maiuscula(resp);
                                    if  (resp='N')
                                       Then r:=-1;
                                  End;
                      end;
              until r=-1;
        fim:
           Until s='0';
        End;
        Begin
           Repeat
              Clrscr;
              Gotoxy(27,10);Write('1 - Voltar ao menu anterior');
              Gotoxy(27,12);Write('2 - Entrar com um registro');
              Gotoxy(27,14);Write('3 - Deletar um registro');
              Gotoxy(27,16);Write('4 - Modificar um registro');
              Gotoxy(31,7);Lowvideo;Write('MENU DE ALTERACAO');NormVideo;
              Gotoxy(32,19);Write('SUA ESCOLHA -> ');
              Repeat
                 escolha:=readkey;
              Until escolha IN ['1','2','3','4'];
              Write(chr(7));
              Case escolha of
                 '2' : Inreg;
                 '3' : Delreg;
                 '4' : Modreg;
              End;
           Until escolha='1';
        End;
        Begin
           Assign(Arq,'dados.dta');
           (*$I-*)
           Reset(Arq);
           If IORESULT <> 0 Then Rewrite(Arq);
           (*$I+*)
           Repeat
              ClrScr;
              Gotoxy(29,10);Write('1 - Sair do programa');
              Gotoxy(29,12);Write('2 - Consulta de dados');
              Gotoxy(29,14);Write('3 - Alteracao de dados');
              Gotoxy(33,7);LowVideo;Write('MENU PRINCIPAL');NormVideo;
              Gotoxy(32,17);Write('SUA ESCOLHA -> ');
              Repeat
                 escolha:=readkey;
              Until escolha IN ['1','2','3'];
              Write(chr(7));
              Case escolha of
                 '2': Consulta;
                 '3': Altera;
              End;
           Until escolha='1';
           Close(Arq);
           ClrScr;
        End.
IX.2.5 - Erase

        Esta procedure permite deletar um arquivo em disco. Sintaxe:

                Erase( Arq : File of tipo);

        ou

                Erase( Arq : File );

        Exemplo:

Program Exemplo;
        Uses CRT;
        Var arq : file;
        Begin
           assign(arq,'thelmo.001');
           erase(arq);
               (* após a execuçäo deste trecho de programa, o arquivo 'thelmo.001' seria eliminado do disco *)
        End.

IX.2.6 - Rename

        Procedure utilizada para trocar o nome de um arquivo. Sintaxe:

            Rename( Arq : File , Novo_Nome);
        onde
        Arq deve ser uma variável do tipo file e
        Novo_nome uma string.

        Exemplo:
Program Exemplo_2;
        Uses CRT;
        Var Arq : File;
        Begin
          Assign(Arq,'teste.001');
          Rename(Arq,'soma.dta');
(* após a execução deste trecho de programa, o arquivo 'thelmo.001' teria seu nome trocado para 'soma.dta' *)
        End.

IX.2.7 - BlockWrite e BlockRead

A procedure BlockRead lê um no. especificado de blocos de 128 bytes de um arquivo não tipado para uma variável. O n.º de registros lidos é retornado numa variável inteira que é opcional. BlockWrite Escreve ao invés de ler. Sintaxe:

        BlockWrite(Arquivo,Variável,No_de_Regs,Resultado);

        BlockRead(Arquivo,Variável,No_de_Regs,Resultado);

        Exemplo:

Program Exemplo;
        Uses CRT;

{Programa para copiar um arquivo para outro, em seguida é feita uma verificação se a cópia foi bem feita}

        Const Buf_Regs = 100;   (* Número de blocos de 128 bytes que serão transferidos pelo BlockRead ou pelo Block-Write *)
        Label FIM;
        Var Fonte,              (* Nome do arquivo fonte    *)
            Destino             (* Nome do arquivo destino  *)
                       : String[33];
            F,                  (* Nome lógico do arq. fonte *)
            D                   (* Nome lógico do arq. destino *)
                       : File;  (* Arquivos não tipados  *)
            No_Regs_restantes,  (* No. de  registros que faltam  para serem transferidos *)
            Regs_para_ler,      (* No. de registros que serão lidos e/ou escritos *)
            i,r,r1              (* Variáveis auxiliares *)
                       : Integer;
            Buffer,             (* Variável que receberá o blocos de registros lidos pelo Block-Read *)
            Buffer1             (* Idem ao anterior *)
                       : Array[1..12800] Of Byte;
        Procedure Erro(x:integer);
        Begin
           Writeln('. . . . . . Problemas com a copia');
           If x=1
              Then Writeln('. . . . . . Arquivos de tamanhos diferentes')
              Else Writeln('. . . . . . .Arquivos diferentes');
           Writeln('Tente novamente');
        End;
        Begin
           ClrScr;
           Lowvideo;
           Writeln('Copiador de arquivos':50);
           NormVideo;
           Write('Fonte ----> ');
           Readln(Fonte);
           Assign(F,Fonte);
        {$I-}                     (* já explicado em programa anterior *)
           Reset(F);
        {$I+}
           If IORESULT <> 0
              Then Begin
                      Writeln('..... Este arquivo não existe');
                      Writeln('..... Operacao nao realizada');
                      Goto FIM;
                   End;
           Write('Destino --> ');
           Readln(Destino);
           Assign(D,Destino);
           Rewrite(D);
           No_Regs_Restantes := Filesize(F);
        (* FileSize retorna o número de registros que contém o arquivo *)
           While No_Regs_Restantes > 0 do
              Begin
                 If Buf_Regs < No_Regs_Restantes
                    Then Regs_para_ler := Buf_regs
                    Else Regs_para_ler := No_Regs_Restantes;
                 BlockRead(F,Buffer,Regs_para_ler);
                 BlockWrite(D,Buffer,Regs_para_ler);
                 No_Regs_restantes := No_regs_restantes-Regs_para_ler;
              End;
           Close(F);
           Close(D);
           Reset(F);
           Reset(D);
           No_Regs_Restantes := Filesize(F);
           While No_Regs_Restantes > 0 do
              Begin
                 If Buf_Regs < No_Regs_Restantes
                    Then Regs_para_ler := Buf_regs
                    Else Regs_para_ler := No_Regs_Restantes;
                 BlockRead(F,Buffer,Regs_para_ler,r);
                 BlockRead(D,Buffer1,Regs_para_ler,r1);
                 No_Regs_restantes := No_regs_restantes-Regs_para_ler;
                 If r<>r1
                    Then Begin
                            Erro(1);
                            Goto FIM;
                         End;
                 For i:=1 to 128*r do
                    if buffer[i]<>buffer1[i]
                       Then Begin
                               Erro(2);
                               Goto FIM;
                            End;
              End;
        FIM:
        End.

IX.2.8 - Truncate

Esta procedure trunca o arquivo a partir do registro corrente.

        Sintaxe:

        Truncate(Arq);


        Exemplo:

        Program Exemplo;
        Uses CRT;
        Var a : file of integer;
            i : integer;
        Begin
           Assign(a,'Arquivo.Dta');
           Rewrite(a);
           For i:=1 to 100 do write(a,i);
           Close(a);
(* O arquivo 'Arquivo.Dta' contem 100 números inteiros de 1 até 100 *)
           Reset(a);
           Seek(a,10);
          truncate(a); (* o arquivo foi truncado a partir do registro 10 *)
           Seek(a,0);
           while not eof(a) do   (* eof() está explicado logo abaixo *)
           Begin
              read(a,i);
              writeln(i); (* será escrito de 1 até 10 no vídeo *)
           end;
        end.





IX.3 - Funções para operações em arquivos

IX.3.1 - Eof()

Esta função retorna um TRUE, caso tenha se alcançado um fim de arquivo, caso contrário, retorna um FALSE. Um exemplo de aplicação foi mostrado no último programa.

IX.3.2 - SeekEof()

Função semelhante ao Eof() exceto que ela pula brancos e tabulações, checando somente o marcador de fim de arquivo (CTRL-Z).

IX.3.3 - FilePos

Retorna o número do registro corrente. Lembramos novamente, que o primeiro registro recebe o número zero. Sintaxe:

        FilePos(Arquivo);

IX.3.4 - FileSize

Retorna o número de registros de determinado arquivo. Retorna zero se o arquivo estiver vazio. Caso o arquivo não seja tipado, então a função FileSize considera que os registros tenham 128 bytes cada um

        Sintaxe:
        FileSize(Arquivo);

Esta função em conjunto com a procedure Seek, nos permite colocar o apontador de registros para o final do arquivo. Isto é muito útil quando desejamos adicionar mais registros num arquivo. Para tanto, basta declarar a seguinte instrução:
        Seek(Arquivo,FileSize(Arquivo));

IX.3.5 - IORESULT

IORESULT é uma variável pré-definida no Turbo Pascal que assume determinados valores inteiros, quando algum erro de Entrada/Saída ocorre.

        IORESULT pode assumir os seguintes valores:

01       Arquivo não existe
02       Arquivo não foi aberto para entrada Provavelmente, você está tentando ler de um arquivo que ainda não foi aberto.
03       Arquivo não foi aberto para saída  Provavelmente, você está tentando escrever num arquivo que ainda não foi aberto.
04       Arquivo não aberto Este tipo de erro costuma acontecer quando tentamos utilizar as procedures BlockRead ou BlockWrite sem antes usarmos Reset ou Rewrite.
16       Erro no formato numérico Quando tentamos ler uma string de um arquivo texto, para uma variável numérica que não está de acordo com o formato numérico.
32       Operação não permitida para um dispositivo lógico. Por exemplo, você tenta ler de um arquivo que foi assinalado para a impressora.
33       Não permitido no modo direto.
34       Não permitido assinalação para arquivos standards.
144     Erro de comprimento de registros. Por exemplo, você tenta ler um registro que contém um número inteiro, e uma string para uma variável de estrutura diferente.
145     Seek dado para uma posição posterior ao final do arquivo.
153     Fim de arquivo foi alcançado antes de se encontrar o CTRL-Z.
240     Erro de escrita no disco.
241     Diretório cheio
242     Overflow do comprimento do arquivo.
243     Arquivo desapareceu.
Imagine que antes de se executar um close() você troque o disco.

IX.3.6 - LongFilePos

Esta função deve ser utilizada em lugar da FilePos quando o arquivo em questão tiver mais de 32K.

IX.3.7 - LongFileSize

Esta função deve ser utilizada em lugar de FileSize quando o arquivo em questão tiver mais de 32K.

IX.3.8 - LongSeek

Esta função deve ser utilizada em lugar de Seek para arquivos maiores de 32K.

IX.4 - Arquivos Textos

IX.4.1 - Definição

Os arquivos textos são utilizados para uma série de aplicações, que não são cobertas pelos arquivos, cujos conteúdos são dados binários. Exemplo: Wordstar, Word, Dbase III etc.
Para declarar um arquivo como sendo do tipo Texto, procedemos da seguinte forma:
                Var Arquivo : Text;
Após esta declaração, o Turbo Pascal aloca um buffer de 128 bytes para as operações de entrada e saída com relação ao arquivo. Nós podemos modificar o tamanho desse buffer da seguinte forma:

                Var Arquivo : Text[256];

Da mesma forma que nos arquivos não textos, devemos assinalar o nome lógico e em seguida, abrir o arquivo para então podermos ler ou escrever dados no arquivo.

IX.4.2 - Procedures e Functions para arquivos texto

IX.4.2.1 - Append

Esta procedure abre um arquivo do tipo texto para inclusão de dados no final do arquivo.

Sintaxe:

                Append(Arquivo);

IX.4.2.2 - Readln

Lê uma linha de dados de um arquivo de texto, isto é, lê dados do arquivo até que se encontre um fim de linha.

Sintaxe:

                Readln(Arquivo,Variável);

        Arquivo deverá ser do tipo Text e a variável do tipo String.

IX.4.2.3 - Writeln

Escreve uma linha de dados no arquivo, isto é, escreve dados e mais o fim de linha.

Sintaxe:

        Writeln(Arquivo,Variável);

        Arquivo deverá ser do tipo Text e a variável do tipo String.

        Exemplo:

Program Exemplo;
        Uses CRT;
        Var frase : String[200];
            a     : Text;
        Begin
           ClrScr;
           Assign(a,'arquivo.dta');
           ReWrite(a);
           Frase:=' ';
           While Frase<>'fim' do
           Begin
              Write('Frase --> ');
              Readln(frase);
              Writeln(a,frase);
           End;
           Close(a);
           Reset(a);
           ClrScr;
           While not eof(a) do
           Begin
              Readln(a,frase);
              Writeln(frase);
           End;
           Close(a);
        End.

IX.4.2.4 - Eoln

Esta função retorna um TRUE se foi alcançado um fim de linha no arquivo texto. Sintaxe:

        Eoln(arquivo);

        Onde arquivo tem que ser do tipo texto.

Nenhum comentário:

Postar um comentário