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.
