Iniciar sesiónCerrar
Correo:
Contraseña:
Entrar
Recordar sesión en este navegador
Iniciar sesiónIniciar sesiónCrear cuentaCrear cuenta
LWP » Foros » Pascal/Turbo Pascal » pascal registros

Pascal/Turbo Pascal - pascal registros

Volver
Nuevo Tema
<<>>
 
Vista:
sin imagen de perfil
Val: 6
Ha aumentado su posición en 2 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

pascal registros

Publicado por oscar (64 intervenciones) el 12/11/2012 15:12:05
Hola, a ver si me podeis ayudar, se me pide

1. Realizar un programa que abra un fichero de texto para lectura, y lo vaya leyendo línea a línea. Deberá presentar como resultado final el nombre del fichero, el número de líneas y el número de caracteres.

NOTA: Recuerde que en la posición cero de una cadena de caracteres se almacena la longitud, pero debe usar la orden ord para tratar esta longitud como un entero.


y el ej2

Realizar un programa que abra un fichero de texto, cree una copia del mismo y añada al final de la copia una cadena de caracteres.

El programa deberá:
1. Solicitar el nombre del fichero de entrada, y abrirlo para lectura.
2. Solicitar el nombre del fichero destino, comprobar que es distinto del nombre del fichero de entrada, y si es así abrirlo para escritura.
3. Solicitar la línea a añadir al final del fichero.
4. Leer línea a línea el fichero de entrada: en cada iteración del bucle leerá una línea del fichero de entrada y escribirá esa misma línea en el fichero destino.
5. Una vez alcanzado el final del fichero origen, se cerrará el mismo y a continuación, se añadirá una línea adicional al fichero destino. Tras añadir esta línea, se cerrará también el fichero destino.


y no se ni plantearlo...
gracias
Valora esta pregunta
Me gusta: Está pregunta es útil y esta claraNo me gusta: Está pregunta no esta clara o no es útil
0
Responder

pascal registros

Publicado por ramon (2158 intervenciones) el 12/11/2012 18:02:09
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
{A ver si esto te ayuda  te inserto un procedimiento para que te presente los archivos
 que tengas de texto para mejor manejo de los archivos }
 
program lector_texto;
   uses
      crt, dos;
   var
     f : text;
     nombreorigen, nombredestino : string;
 
 
 
 
   procedure presenta_ficheros_texto;
   var
     dirinfo : searchrec;
     nomarch : array[1..40] of string[12];
     t, ii : integer;
   begin
      FindFirst('*.txt', Archive, DirInfo);
      ii := 1;
      while DosError = 0 do
      begin
         nomarch[ii] := DirInfo.Name;
         ii := ii + 1;
         if ii > 40 then
         ii := 40;
         FindNext(DirInfo);
      end;
      for t := 1 to ii - 1 do
      writeln('    ',nomarch[t]);
      writeln;
   end;
 
   procedure leerfichero;
   var
     t : text;
     fichero : string;
     car : char;
     lineas, caracteres : longint;
   begin
      lineas := 0;
      caracteres := 0;
      clrscr;
      presenta_ficheros_texto;
      write('  Entre Nombre Fichero de Texto y Extension [xxxxxx.xxx] : ');
      readln(fichero);
      assign(t,fichero);
   {$I-} reset(t); {$I+}
   if ioresult <> 0 then
   begin
       clrscr;
       writeln('    El fichero no Existe Pulse [Enter]');
       readln;
       exit;
   end
 else
    begin
       while not Eof(t) do
       begin
         Read(t, car);
         if  Eoln(t) then
         lineas := lineas + 1
       else
         caracteres := caracteres + 1;
       end;
        close(t);
        clrscr;
        writeln('   El Nombre Del Archivo Es  : ',fichero);
        writeln('   Tiene Total De Lineas     : ',lineas);
        writeln('   Tiene Total De Caracteres : ',caracteres);
        writeln;
        writeln('   ----- Pulse [Enter] ------');
        readln;
    end;
   end;
 
   procedure copiaarchivo_y_inserta_cadena;
   var
     t, tt : text;
     car : char;
     fichero1, fichero : string;
     insercion : string[80];
     ins : integer;
   begin
      clrscr;
      presenta_ficheros_texto;
      write('  Entre Nombre Fichero A copiar y Extension [xxxxxx.txt] : ');
      readln(fichero);
      write('  Entre Nombre Fichero Nuevo y Extension [xxxxxx.txt] : ');
      readln(fichero1);
      assign(t,fichero);
   {$I-} reset(t); {$I+}
   if ioresult <> 0 then
   begin
       clrscr;
       writeln('    El fichero no Existe Pulse [Enter]');
       readln;
       exit;
   end
 else
    begin
       assign(tt,fichero1);
       rewrite(tt);
       while not Eof(t) do
       begin
         Read(t, car);
         write(tt,car);
       end;
       close(t);
       clrscr;
       write('   Entre Cadena a Insertar en Archivo : ');
       readln(insercion);
       for ins := 1 to length(insercion) do
       begin
          write(tt,insercion[ins]);
       end;
         close(tt);
     end;
   end;
 
 
    procedure menu;
    var
      tec : char;
    begin
       repeat
          clrscr;
          writeln(' ******* Menu General ********');
          writeln;
          writeln('  1 : Leer Archivo De Texto');
          writeln('  2 : Copiar Archivo De Texto');
          writeln('  3 : Salir');
          writeln;
          writeln(' <<<<<< Elija Opcion >>>>>>>');
          repeat
              tec := readkey;
          until tec in['1','2','3'];
       case tec of
    '1' : leerfichero;
    '2' : copiaarchivo_y_inserta_cadena;
      end;
    until tec = '3';
   end;
 
 
   begin
      clrscr;
      menu;
   end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 6
Ha aumentado su posición en 2 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

pascal registros

Publicado por oscar (64 intervenciones) el 12/11/2012 20:38:47
mmmm creo q no me sirve ramon, pq supuestamente tengo q hacerlo con esto q te adjunto , el segundo ejerc creo q es asi pero el primero hay cosas q no he dado

Tipo_fichero = file of Tipo_base; (* Define un tipo de fichero de Tipo_base *)
Tipo_fichero = Text;
assign(fichero, 'clase.txt');
reset(fichero);
rewrite(fichero);
close(fichero);


filepos(fichero);

seek(fichero, posicion);

ejemplo

Program Lab01;
Const
primhora = 1;
ulthora = 3; (* 24 *)
Type
lecturas = array[primhora..ulthora] of integer;
Tfichero = file of integer;
Var
temperatura : lecturas;
(* Almacena temperaturas cada hora *)
opc : integer;
(* Opción del menu elegida *)
nombre : string;
(* Almacena nombre del fichero de datos *)

Procedure graba_fichero(nombre: string; VAR medidas :lecturas);
Var
i : integer;
fichero : Tfichero;
Begin

assign(fichero, nombre);
rewrite(fichero);

for i:= primhora to ulthora do
write(fichero, medidas[i]);

close(fichero);

End;


Procedure lee_fichero(nombre: string ;VAR medidas :lecturas);
Var
i: integer;
fichero : Tfichero;
Begin
i := 0;

assign(fichero, nombre);
reset(fichero);

while ( not(eof(fichero)) AND (i < ulthora) ) do begin
i := i+1;
read(fichero, medidas[i]);
end;

close(fichero);
End;


pero yo no se hacerlo
y en el primer ejercicio yo no he utilizado nunca dirinfo nomarch, findnext....y no lo hemos estudiado

el segundo creo q si que seria asi..
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

pascal registros

Publicado por ramon (2158 intervenciones) el 12/11/2012 21:02:46
Espera te acaro lo que comentas solo es para tu información a la hora de entrar el archivo que
te presente los que tienes disponibles que sean de texto no para otra cosa,
los puedes quitar ya que son aparte del proceso.


procedure presenta_ficheros_texto;
var
dirinfo : searchrec;
nomarch : array[1..40] of string[12];
t, ii : integer;
begin
FindFirst('*.txt', Archive, DirInfo);
ii := 1;
while DosError = 0 do
begin
nomarch[ii] := DirInfo.Name;
ii := ii + 1;
if ii > 40 then
ii := 40;
FindNext(DirInfo);
end;
for t := 1 to ii - 1 do
writeln(' ',nomarch[t]);
writeln;
end;

esto como todas sus referencias a el lo puedes anular ya que como te comento es solo como
información para ti.

Referente a lo que pones primero el Tipo_fichero = file of Tipo_base; (* Define un tipo de fichero de Tipo_base *) se refiere a un archivo de registro no de testo,
Esto si Tipo_fichero = Text; se refiere a testo.

Esto es para registros seek(fichero, posicion);

lo cual me deja un poco perdido pero intentare entender lo que me pides .
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 6
Ha aumentado su posición en 2 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

pascal registros

Publicado por oscar (64 intervenciones) el 12/11/2012 21:44:29
No se ramon, yo ando muy perdido con esto solo se lo q pone el tema, pero no tengo ni idea por eso te decia q al menos se q esas cosas no las he utilizado solo se q el ejemplo es este

(*!!!!!!!!!!!!!!!! Funciones de uso de ficheros !!!!!!!!!!!!!!!!!!!!!!!!*)
(*!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!*)
(* Almacena datos leidos en un fichero *)
Procedure graba_fichero(nombre: string; VAR medidas :lecturas);
Var
i : integer;
fichero : Tfichero;
Begin
assign(fichero, nombre);
rewrite(fichero);

for i:= primhora to ulthora do
write(fichero, medidas[i]);

close(fichero);
End;

(* Lee datos de fichero *)
Procedure lee_fichero(nombre: string ;VAR medidas :lecturas);
Var
i: integer;
fichero : Tfichero;
Begin
i := 0;

assign(fichero, nombre);
reset(fichero);

while ( not(eof(fichero)) AND (i<ulthora) ) do begin
i := i+1;
read(fichero, medidas[i]);
end;

close(fichero);
End;

pero no tengo ni idea de como se hace ninguno de los dos ejercicios...es q ni idea
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

pascal registros

Publicado por ramon (2158 intervenciones) el 13/11/2012 16:08:18
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
{A ver si esto nos abre  camino}
 
 uses
      crt;
   Const
     primhora = 1;
     ulthora = 12; (* 24 *)
   Type
     lecturas = array[primhora..ulthora] of integer;
     Tfichero = file of integer;
   Var
    temperatura : lecturas;
    opc : integer;
    nombre : string;
 
  Procedure graba_fichero(nombre: string; VAR medidas :lecturas);
  Var
    i : integer;
    fichero : Tfichero;
  Begin
     assign(fichero, nombre);
     rewrite(fichero);
     for i := primhora to ulthora do
     begin
     write(fichero, medidas[i]);
     end;
     close(fichero);
   End;
 
(* Lee datos de fichero *)
   Procedure lee_fichero(nombre: string ;VAR medidas : lecturas);
   Var
     i : integer;
    fichero : Tfichero;
   Begin
      i := 0;
      assign(fichero, nombre);
      reset(fichero);
    while ( not(eof(fichero)) AND (i < ulthora) ) do {Aqui leemos todo el}
                         {archivo completo sin opcion a elejir una posicion}
    begin
      i := i + 1;
     read(fichero, medidas[i]);
   end;
     close(fichero);
  End;
 
  procedure leer_posicion_individual(nombre : string; num : integer);
  var
     fichero : Tfichero;
  begin
      assign(fichero,nombre);
  {$I-} reset(fichero); {$I+} {Comprovacion de Error de Archivo}
  if ioresult <> 0 then  {Comprueva si el archivo existe 0 = existe}
  begin
      {Si no existe Tomamos medidar ejemplo}
      writeln('El archivo pedido no Existe pulse [Enter]');
      readln;
  end
else
   begin
      {Si Existe continuamos ejecucion}
      {A hora si podemos tomar el que queramos del array}
      seek(fichero,num - 1); {Porque menos 1 porque los registros enpiezan}
                             { en la posicion 0 no en la 1}
      read(fichero,temperatura[num]);
      close(fichero);
      clrscr;
      writeln('   El Contenido de ',num,' Es : ',temperatura[num]);
      writeln;
      writeln('..... Pulse [Enter] ....');
   end;
  end;
 
  procedure menu;
  var
    tec : char;
    pos : integer;
  begin
     repeat
       clrscr;
       writeln('*****  Menu General *****');
       writeln;
       writeln('  1 : Rellenar Array');
       writeln('  2 : Guardar Array');
       writeln('  3 : Ver array');
       writeln('  4 : Leer una Posicion solo');
       writeln('  5 : Salir');
       writeln;
       writeln('  <<<< Elija Opcion >>>>');
       repeat
        tec := readkey;
       until tec in['1','2','3','4','5'];
    case tec of
   '1' : begin
            for opc := primhora to ulthora do
             begin
               temperatura[opc] := opc * 2;
             end;
             clrscr;
             writeln('---- Datos Insertados Pulse [Enter] -----');
             readln;
         end;
   '2' : begin
            clrscr;
            write('   Entre Nombre Para El Archivo : ');
            readln(nombre);
            graba_fichero(nombre,temperatura);
            writeln;
            writeln('///// Archivo Guardado Pulse [Enter] ///////');
         end;
   '3' : begin
           clrscr;
           write('   Entre Nombre Del Archivo : ');
           readln(nombre);
             lee_fichero(nombre,temperatura);
          clrscr;
          for opc := primhora to ulthora do
          writeln(' Dato [ ',opc,' ] = ',temperatura[opc]);
          writeln;
          writeln;
          writeln('\\\\\ Final de Carga Pulse [Enter] \\\\\');
          readln;
         end;
    '4' : begin
           clrscr;
           write('   Entre Nombre Del Archivo : ');
           readln(nombre);
           write('   Entre N§ De La Posicion : ');
           readln(pos);
           leer_posicion_individual(nombre,pos);
           readln;
          end;
     end;
     until tec = '5';
  end;
 
  begin
     clrscr;
     menu;
  end.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 6
Ha aumentado su posición en 2 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

pascal registros

Publicado por oscar (64 intervenciones) el 15/11/2012 00:09:29
Y no hay forma mas sencilla de hacer esto? algo asi?
para el eje1

Program leer;
Uses Crt;
Var
texto:text;
Begin
Assign(texto,'prueba.txt');
rewrite(texto)
WriteLn(texto,'Hola prueba');
Read(texto);
close(texto);
End.


de todas maneras me dice, refresco
Realizar un programa que abra un fichero de texto para lectura, y lo vaya leyendo línea a línea. Deberá presentar como resultado final el nombre del fichero, el número de líneas y el número de caracteres.

NOTA: Recuerde que en la posición cero de una cadena de caracteres se almacena la longitud, pero debe usar la orden ord para tratar esta longitud como un entero.

sigo sin entenderlo...no se si tengo q crear yo primero el fichero q va a leer y si es asi no se como crearlo ni como especificarle la ruta para q lo abra o se crea primero y luego se ese...entonces no se como quedaria...
q me puedes decir?
gracias
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar
sin imagen de perfil
Val: 6
Ha aumentado su posición en 2 puestos en Pascal/Turbo Pascal (en relación al último mes)
Gráfica de Pascal/Turbo Pascal

pascal registros

Publicado por oscar (64 intervenciones) el 15/11/2012 00:49:28
llegue a hacer esto

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
Program Archivo;
Uses Crt;
var Archiv : text; {Variable tipo archivo de texto}
Nombre : String;
 
Procedure CreaArchivo;
begin
Assign(Archiv,'C:\prueba.txt'); {Asigna variable "Archiv" a Pueba.txt}
ReWrite(Archiv); {Crea el archivo}
Writeln(Archiv,'Este es un archivo de prueba'); Writeln(Archiv,'Tema 9'); {Escribe nombres}
Writeln(Archiv,'Finalizando casi el curso'); Writeln(Archiv,'La progrmación es muy costosa de aprender'); {en el archivo }
end;
 
begin
ClrScr; {Limpia la pantalla}
CreaArchivo; {Llama al Procedimiento "CreaArchivo"}
Reset(Archiv); {Abre el archivo. Vamos a escribir en el.}
Readln(Archiv, Nombre); Writeln(Nombre); {Lee del archivo y mete lo }
Readln(Archiv, Nombre); Writeln(Nombre); {leido a la variable Nombre}
Readln(Archiv, Nombre); Writeln(Nombre); {Luego muestra en pantalla }
Readln(Archiv, Nombre); Writeln(Nombre);
Repeat Until KeyPressed; {Repita hasta que se presione una tecla}
Close(Archiv); {Cierra el archivo. Esto es importante}
end.
 
PROCEDURE leer_archivo(nombre_fichero:String);
VAR
archivo:Text;
contador_lineas:Integer;
contador_caracteres:Integer;
linea:String;
BEGIN
Assign(archivo, nombre_fichero);
Reset(archivo);
 
contador_lineas := 0;
contador_caracteres := 0;
 
WHILE NOT EOF(archivo) DO BEGIN
READLN(archivo, linea);
contador_lineas := contador_lineas + 1;
contador_caracteres := contador_caracteres + ORD(linea[0]);
 WRITELN(linea);
Close(archivo);
WRITELN('Se leyo el archivo ' + nombre_fichero);
WRITELN('Cantidad de lineas: ', contador_lineas);
WRITELN('Cantidad de caracteres: ', contador_caracteres);
END;
 
BEGIN
leer_archivo('C:\prueba.txt’');
readln;
END.


y claro el primer procedimiento sin fallo, el segundo creo q no me hace nada al menos dps de presentar el archivo, de leerlo se va de pantalla....
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar

pascal registros

Publicado por ramon (2158 intervenciones) el 15/11/2012 21:44:33
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
{Funciona}
 
Program Archivo;
Uses Crt;
var
  Archiv : text; {Variable tipo archivo de texto}
  Nombre : String;
 
   Procedure CreaArchivo;
   begin
     Assign(Archiv,'C:\prueba.txt'); {Asigna variable "Archiv" a Pueba.txt}
     ReWrite(Archiv); {Crea el archivo}
     Writeln(Archiv,'Este es un archivo de prueba');
     Writeln(Archiv,'Tema 9'); {Escribe nombres}
     Writeln(Archiv,'Finalizando casi el curso');
     Writeln(Archiv,'La progrmación es muy costosa de aprender'); {en el archivo }
     close(archiv);
   end;
 
  procedure presenta;
  begin
     ClrScr; {Limpia la pantalla}
    CreaArchivo; {Llama al Procedimiento "CreaArchivo"}
    Assign(Archiv,'C:\prueba.txt');
    Reset(Archiv); {Abre el archivo. Vamos a escribir en el.}
    Readln(Archiv, Nombre);
    Writeln(Nombre); {Lee del archivo y mete lo }
    Readln(Archiv, Nombre);
    Writeln(Nombre); {leido a la variable Nombre}
    Readln(Archiv, Nombre);
    Writeln(Nombre); {Luego muestra en pantalla }
    Readln(Archiv, Nombre);
    Writeln(Nombre);
   Repeat Until KeyPressed; {Repita hasta que se presione una tecla}
    Close(Archiv); {Cierra el archivo. Esto es importante}
  end;
 
  PROCEDURE leer_archivo(nombre_fichero:String);
  VAR
   archivo:Text;
   contador_lineas:Integer;
   contador_caracteres:Integer;
   linea:String;
   BEGIN
     Assign(archivo, nombre_fichero);
     Reset(archivo);
     contador_lineas := 0;
     contador_caracteres := 0;
    WHILE NOT EOF(archivo) DO
    BEGIN
     READLN(archivo, linea);
     contador_lineas := contador_lineas + 1;
     contador_caracteres := contador_caracteres + ORD(linea[0]);
     WRITELN(linea);
     end;
     Close(archivo);
     WRITELN('Se leyo el archivo ' + nombre_fichero);
     WRITELN('Cantidad de lineas: ', contador_lineas);
     WRITELN('Cantidad de caracteres: ', contador_caracteres);
  end;
 
BEGIN
clrscr;
leer_archivo('C:\prueba.txt');
readln;
END.
Valora esta respuesta
Me gusta: Está respuesta es útil y esta claraNo me gusta: Está respuesta no esta clara o no es útil
0
Comentar