[ Foro de Pascal ]

TRUNCATE

24-Nov-2020 19:16
Invitado (LUCAS)
0 Respuestas

Buenas, tal vez alguien pueda ayudarme, tengo que agregar a mi programa un procedimiento que elimine un registro del archivo, el profesor dijo que utilice TRUNCATE, y que vaya moviendo el puntero para realizarlo, realmente no se como hacerlo, alguien tiene idea?

// Crear un registro, que guarde, numero de producto, nombre del producto y costo.
// Crear menu que permita buscar el nombre del producto y muestre el numero, el stock actual y el costo.
// Que el menu permita iniciar una transaccion en la cual se modifique el stock. (Agregar o quitar).
// Es necesario hacer una carga inicial de los productos para poder iniciar.

{Programa Final.
1-Menu que contenga las opciones de: 1- Carga de Stock.
                                     2- Modificar Stock.
                                     3- Consultar stock.
                                     4- Consultar costos.
                                     5- Iniciar venta.
                                     6- Simular venta y compra.
2- Los datos a guardar en el registro son: Nombre del producto / Codigo del producto / Cantidad / Costo.   }

Program FinalProg;
Uses
   Crt;
Type
  Str5 = String[5];
  Str30 = String[15];
  Reg_Stock = Record          //CREACION DE REGISTRO.
               Codigo : Str5;
               Producto : Str30;
               Cantidad  : Integer;
               Precio  : Real;
               end;
  Archivo = file of Reg_Stock;
             
Var
 Stock_Re:Reg_Stock;
 ArchStock:Archivo;
 Opc:Integer;

Function CheckArc(var Arch:Archivo):Boolean;    // Funcion para comprobar si el archivo existe
begin
    {$I-}
    Reset(Arch);
    {$I+}
    if IOResult<>0 then
    CheckArc := false
    else CheckArc := true;
    close(Arch);
end;

Procedure Carga_Sto; //Carga stock.
 Begin
   if CheckArc(ArchStock)
      Then reset(ArchStock)
      Else rewrite(ArchStock);
   Seek(ArchStock, filesize(ArchStock));
   //Carga producto
   write('Nombre del producto a cargar: ');
   readln(Stock_Re.Producto);
   write('Codigo: ');
   readln(Stock_Re.Codigo);
   Write ('Cantidad: ');
   Readln (Stock_Re.Cantidad);
   Write ('Costo: ');
   Readln (Stock_Re.Precio);

   Write(ArchStock, Stock_Re);
   Close(ArchStock);

 End;

Procedure Consul_Stock;  //Consulta Stock.
Var
  Contador : integer;
 Begin
   Contador := 0;
   Reset(ArchStock);   //Abro Archivo.
   While not EOF(ArchStock) Do
    Begin
       Read(ArchStock , Stock_Re);
       Writeln('Numero de registro', Filepos(ArchStock)-1, ' - ', Stock_Re.Codigo , ' - ', Stock_Re.Producto , ' - ', Stock_Re.Cantidad , ' - ', Stock_Re.Precio:0:2 );
       inc(Contador);
       If Contador mod 20 = 0
          Then Readkey;
    End;
   Close(ArchStock);  //Cierrro archivo
   Readkey;
 End;

{Procedure Modif_Stock; //Modificar Stock
 Var
  Produ:integer;
  opc:integer;
  Begin
   Reset(ArchStock); //Abro Archivo.
   Writeln ('Ingrese numero de producto');
    Read (Produ);
   If filesize(ArchStock < Produ);
     then writeln('No se encuentran coincidencias')
   else
   BEGIN
   Seek(ArchStock, Produ);
   Read (Archstock, Stock_Re);
   Writeln('numero de registro', Filepos(ArchStock)-1, ' - ', Stock_Re.Codigo , ' - ', Stock_Re.Producto , ' - ', Stock_Re.Cantidad , ' - ', Stock_Re.Precio:0:2 );
   Writeln('Ingrese numero de registro');
   read (opc);
   While opc > 0 and opc < 4 do
   If opc = 1 then
   Begin
    writeln ('ingrese nuevo codigo');
    Readln (Stock_Re.Codigo);


    Seek(ArchStock, Filepos(ArchStock)-1);

   END;
end;}


{Procedure Venta;
Var
   Op:char;
   Cod:Integer;
   Vent:Integer;
     Begin
      if CheckArc(ArchStock)
      Then reset(ArchStock)
      Else rewrite(ArchStock);
      Seek(ArchStock, filesize(ArchStock));
      Writeln(filepos(ArchStock)-1, Stock_Re.Codigo , ' - ', Stock_Re.Producto , ' - ', Stock_Re.Cantidad , ' - ' , Stock_Re.Precio);
      //Writeln('Los Datos Son:''Codigo:'Stock_Re.Codigo,'Producto:'Stock_Re.Producto,
      //'Stock:'Stock_Re.Cantidad,' Precio:'Stock_Re.Precio,);
      Writeln ('Ingrese producto a vender');
      Repeat
      Op:=Readkey;
      Until Op in['1','2'];
      Case Op Of
      '1': Begin
           Write ('Ingrese codigo de producto a vender');
           Read (Cod);
           If Cod = Stock_Re.Codigo
           Then
              Begin
               Write('Ingrese cantidad a vender');
               Readln (Vent);
               Stock_Re.Cantidad:=(Stock_Re.Cantidad - Vent);
               Writeln(filepos(ArchStock)-1);
               write(ArchStock,Stock_Re);
               close(ArchStock);
              End;
            Else
             Begin
             Write('Codigo no encontrado');
             Readkey;
             End;
          End;

        '2':Begin
            Write ('Salida del sistema');
            readkey;
            End;

        Until Op = '2';
        End; }

Procedure Venta;
VAR
 Cod:str5;
 Vent:Integer;
   Begin
       Reset(ArchStock);
       While not EOF (ArchStock) Do
       Begin
       Read(ArchStock, Stock_Re);
       Writeln(filepos(ArchStock)-1, Stock_Re.Codigo , ' - ', Stock_Re.Producto , ' - ', Stock_Re.Cantidad , ' - ' , Stock_Re.Precio);
       Writeln ('Ingrese codigo del producto');
       Read (Cod);
       If Stock_Re.Codigo = Cod Then
       Begin
       Writeln ('Ingrese cantidad a vender');
       Readln(Vent);
       Stock_Re.Cantidad:=(Stock_Re.Cantidad - Vent);
       Seek(ArchStock, filepos(ArchStock)-1);
       Write(ArchStock, Stock_Re);
       End;
       End;
       Close(ArchStock);
       Readkey;
   End;


 Begin
  Assign(ArchStock, 'Stock.dat');
  ClrScr;
  Repeat
  ClrScr;
  Writeln;
  Writeln('---------Stock---------');
  Writeln('1.Dar de alta stock.');
  Writeln('2.Venta');
  Writeln('3.Buscar Registro de stock');
  Writeln('4.Mostrar stock');
  Writeln('5.Salir');
  Writeln('Teclea la opcion deseada');
  Readln(Opc);

Case Opc of

1: Begin
   Carga_Sto;
   Readkey;
  End;

2: Begin
   Venta;
   Readkey;
  End;

3: Begin

   Readkey;
  End;

4: Begin
   Consul_Stock;
   Readkey;
  End;
  Else
   Begin
    Writeln('Error, opcion no disponible ');
    Readkey;
   End;
  End;

Until (Opc=5);
Readkey;
End.

Hasta el momento esto es lo que tengo, si alguien puede ayudarme se lo agradecería mucho.

Saludos




(No se puede continuar esta discusión porque tiene más de dos meses de antigüedad. Si tienes dudas parecidas, abre un nuevo hilo.)