[ Foro de Pascal ]

TRUNCATE

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