Pascal/Turbo Pascal - fichero binario

   
Vista:

fichero binario

Publicado por Sara (6 intervenciones) el 11/03/2015 22:52:00
En un programa que tengo hecho (lo adjunto al final) tengo que hacer lo siguiente:

1) Definir un fichero binario en el que cada elemento del fichero sea de tipo Producto.

2) Codificar un procedimiento (guarda_cesta) que guarde todos los productos de una cesta de la compra, que se pasa como parámetro, en un fichero cuyo nombre también se pasa por parámetro. Los productos están en la cesta sólo si el campo en_cesta=true.

3) Codificar un procedimiento (recupera_cesta) que lea de un fichero de elementos de tipo producto, todos los productos que tenga almacenados y los guarde en una variable de tipo cesta..

Program EJERCICIO29;

Const
Tammaxcesta=3;

Type
Tproducto=record
nombre:string;
num_unidades:integer;
precio_unidad:real;
en_cesta:boolean;
end;

Tcesta = array [0..Tammaxcesta] of Tproducto;
Tfichero = file of Tcesta;

Var
unacesta:Tcesta; (* variable del tipo cesta*)
opcion:integer;
pos:integer;
fichero:Tfichero;

Procedure lee_producto (VAR producto:Tproducto);
Begin
producto.en_cesta:=true;
writeln('Escriba los datos del producto: ');
write('Nombre: ');
readln(producto.nombre);
write('Numero de unidades: ');
readln(producto.num_unidades);
write('Precio: ');
readln(producto.precio_unidad);
End;

Procedure inicializa_cesta;
var
i:integer;
Begin
for i:= 1 to TAMMAXCESTA do
begin
unacesta [i]. nombre := '';
unacesta [i]. num_unidades:= 0;
unacesta [i]. precio_unidad:= 0.0;
unacesta [i]. en_cesta := false;
end;
end;

Procedure mostrar_producto (var productocesta:Tproducto);
Begin
writeln;
writeln('El producto de la cesta es: ');
writeln;
writeln('Nombre: ',productocesta.nombre);
writeln('Unidades: ',productocesta.num_unidades);
writeln('Precio por unidad: ',productocesta.precio_unidad:0:2);
writeln('Precio total: ',(productocesta.num_unidades*productocesta.precio_unidad):0:2);
writeln;
End;

Procedure llenar_cesta (VAR unacesta:Tcesta);
Var
i:integer;
Begin
For i:= 1 to Tammaxcesta do
begin
lee_producto(unacesta[i]);
end;
End;

Procedure Mostrar_cesta (unacesta:Tcesta);
var
i:integer;
begin
For i:= 1 to Tammaxcesta do
mostrar_producto(unacesta[i]);
end;

Function busca_libre (unacesta:Tcesta):integer;
Var
i:integer;
Begin
for i:= 1 to Tammaxcesta do
if (unacesta[i].en_cesta = false) then
begin
busca_libre:=i;
writeln('La primera posicion libre de la cesta es la: ',i);
end
else
begin
busca_libre:= 0;
writeln('No hay ninguna posición libre en la cesta');
end;
end;

Procedure incluir_producto_en_cesta (Var unacesta:Tcesta);
Var
i:integer;
begin
i:=busca_libre(unacesta);
if (i <>0) then
lee_producto(unacesta[i])
else
begin
writeln;
writeln('La cesta esta llena');
end;
end;

Function buscar_producto (UnaCesta:Tcesta; nombre:string): integer;
Var
i:integer;

begin
for i:= 1 to tammaxcesta do
begin
if (unacesta[i].nombre = nombre) then
buscar_producto:=i
else
buscar_producto:=0;
end;
end;

Procedure Eliminar_producto (var UnaCesta:TCesta);
var
unproduc : string;
numaux: integer;
begin
Writeln;
Write ('Escriba el nombre del producto a eliminar: ');
Readln(unproduc);
numaux:= Buscar_producto (UnaCesta,unproduc);
If (numaux = 0) then
writeln ('Producto no encontrado')
else
begin
UnaCesta[numaux].en_cesta := false;
Writeln ('Producto numero: ',numaux,'encontrado y eliminado');
end;
End;

Procedure menu;
begin
repeat
writeln(' *** M E N U *** ');
writeln();
writeln('1. Abrir la cesta de la compra exixtente.');
writeln('2. Comenzar cesta de compra nueva.');
writeln('3. Anadir producto a la cesta.');
writeln('4. Eliminar producto de la cesta.');
writeln('5. Guardar cesta.');
writeln('6. Pedir cesta.');
writeln('7. Salir del programa.');
writeln();
write('Introduzca una opcion: ');
readln(opcion);
writeln();
if (opcion=1) then
begin
writeln('Abrir cesta de la compra');
readln;
end
else
if (opcion=2) then
llenar_cesta(unacesta)
else
if (opcion=3) then
begin
pos:=busca_libre(unacesta);
incluir_producto_en_cesta(unacesta);
end
else
if (opcion=4) then
eliminar_producto(unacesta)
else
if (opcion=5) then
begin
writeln('Guardar cesta');
readln;
end
else
if (opcion=6) then

else
if (opcion=7) then
write('Salir');


until (opcion < 1) or (opcion >=7);
end;

Begin
inicializa_cesta;
opcion:=0;
menu;
readln;
End.

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

fichero binario

Publicado por ramon (2072 intervenciones) el 12/03/2015 12:36:25
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
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
{Mira tienes implementados los procedimientos de guardar y cargar la cesta pero fíjate que se guarda una sola cesta
cada vez no el array de cestas tendrás que indicar cual guardas del 1 al  Tammaxcesta o si quieres todos tengras que
ejecutar un for.
cuando cargues una cesta se cargara en el array 1 si lo quieres en otro cámbialo a tu gusto   }
 
 
Program EJERCICIO29;
uses
    crt;
Const
Tammaxcesta=3;
 
Type
Tproducto=record
nombre:string;
num_unidades:integer;
precio_unidad:real;
en_cesta:boolean;
end;
 
Tcesta = array [0..Tammaxcesta] of Tproducto;
Tfichero = file of Tcesta;
 
Var
unacesta:Tcesta; (* variable del tipo cesta*)
opcion:integer;
pos:integer;
fichero:Tfichero;
f : file of tproducto;
 
procedure guarda_producto(g : Tproducto);
begin
   assign(f,'Producto.dat');
 {$I-} reset(f); {$I+}
  if ioresult <> 0 then
  begin
     rewrite(f);
     seek(f,0);
     write(f,g);
     close(f);
  end
else
    begin
      seek(f,filesize(f));
      write(f,g);
      close(f);
    end;
end;
 
procedure toma_producto(var una : tproducto);
var
   nom : string;
   i : integer;
   h : longint;
   encont : boolean;
   co : tproducto;
begin
   clrscr;
   encont := false;
   write('   Entre Naombre : ');
   readln(nom);
   for i := 1 to length(nom) do
   nom[i] := upcase(nom[i]);
   assign(f,'Producto.dat');
 {$I-} reset(f); {$I+}
  if ioresult <> 0 then
  begin
     writeln('  Error Archivo No Presente Pulse Una Tecla');
     readkey;
  end
else
    begin
   for h := 0 to filesize(f) - 1 do
   begin
      seek(f,h);
      read(f,co);
      for i := 1 to length(co.nombre) do
      co.nombre[i] := upcase(co.nombre[i]);
      if co.nombre = nom then
      begin
         close(f);
         encont := true;
         break;
      end;
   end;
      if encont = true then
      begin
         una := co;
      end
   else
      begin
         close(f);
         writeln('   Cesta No Encontrada Pulse Una Tecla');
         readkey;
         fillchar(una,sizeof(una),0);
      end;
  end;
end;
 
Procedure lee_producto (VAR producto:Tproducto);
Begin
producto.en_cesta:=true;
writeln('Escriba los datos del producto: ');
write('Nombre: ');
readln(producto.nombre);
write('Numero de unidades: ');
readln(producto.num_unidades);
write('Precio: ');
readln(producto.precio_unidad);
End;
 
Procedure inicializa_cesta;
var
i:integer;
Begin
for i:= 1 to TAMMAXCESTA do
begin
unacesta [i]. nombre := '';
unacesta [i]. num_unidades:= 0;
unacesta [i]. precio_unidad:= 0.0;
unacesta [i]. en_cesta := false;
end;
end;
 
Procedure mostrar_producto (var productocesta:Tproducto);
Begin
writeln;
writeln('El producto de la cesta es: ');
writeln;
writeln('Nombre: ',productocesta.nombre);
writeln('Unidades: ',productocesta.num_unidades);
writeln('Precio por unidad: ',productocesta.precio_unidad:0:2);
writeln('Precio total: ',(productocesta.num_unidades*productocesta.precio_unidad):0:2);
writeln;
End;
 
Procedure llenar_cesta (VAR unacesta:Tcesta);
Var
i:integer;
Begin
For i:= 1 to Tammaxcesta do
begin
lee_producto(unacesta[i]);
end;
End;
 
Procedure Mostrar_cesta (unacesta:Tcesta);
var
i:integer;
begin
For i:= 1 to Tammaxcesta do
mostrar_producto(unacesta[i]);
end;
 
Function busca_libre (unacesta:Tcesta):integer;
Var
i:integer;
Begin
for i:= 1 to Tammaxcesta do
if (unacesta[i].en_cesta = false) then
begin
busca_libre:=i;
writeln('La primera posicion libre de la cesta es la: ',i);
end
else
begin
busca_libre:= 0;
writeln('No hay ninguna posición libre en la cesta');
end;
end;
 
Procedure incluir_producto_en_cesta (Var unacesta:Tcesta);
Var
i:integer;
begin
i:=busca_libre(unacesta);
if (i <>0) then
lee_producto(unacesta[i])
else
begin
writeln;
writeln('La cesta esta llena');
end;
end;
 
Function buscar_producto (UnaCesta:Tcesta; nombre:string): integer;
Var
i:integer;
 
begin
for i:= 1 to tammaxcesta do
begin
if (unacesta[i].nombre = nombre) then
buscar_producto:=i
else
buscar_producto:=0;
end;
end;
 
Procedure Eliminar_producto (var UnaCesta:TCesta);
var
unproduc : string;
numaux: integer;
begin
Writeln;
Write ('Escriba el nombre del producto a eliminar: ');
Readln(unproduc);
numaux:= Buscar_producto (UnaCesta,unproduc);
If (numaux = 0) then
writeln ('Producto no encontrado')
else
begin
UnaCesta[numaux].en_cesta := false;
Writeln ('Producto numero: ',numaux,'encontrado y eliminado');
end;
End;
 
Procedure menu;
begin
   pos := 1;
   clrscr;
repeat
writeln(' *** M E N U *** ');
writeln;
writeln('1. Abrir la cesta de la compra exixtente.');
writeln('2. Comenzar cesta de compra nueva.');
writeln('3. Anadir producto a la cesta.');
writeln('4. Eliminar producto de la cesta.');
writeln('5. Guardar cesta.');
writeln('6. Pedir cesta.');
writeln('7. Salir del programa.');
writeln;
write('Introduzca una opcion: ');
readln(opcion);
writeln;
if (opcion=1) then
begin
writeln('Abrir cesta de la compra');
readln;
end
else
if (opcion=2) then
llenar_cesta(unacesta)
else
if (opcion=3) then
begin
pos:=busca_libre(unacesta);
incluir_producto_en_cesta(unacesta);
end
else
if (opcion=4) then
eliminar_producto(unacesta)
else
if (opcion=5) then
begin
writeln('Guardar cesta');
readln;
guarda_producto(unacesta[pos]);
end
else
if (opcion=6) then
begin
   toma_producto(unacesta[1]);
end
else
if (opcion=7) then
write('Salir');
 
 
until (opcion < 1) or (opcion >=7);
end;
 
Begin
inicializa_cesta;
opcion:=0;
menu;
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