#

Listato 2

Utility per il convertitore Turbo Pascal da Wordstar a Ventura
 
unit convutil;

interface

uses dos,timestat;

const cr=13;   (* Carriage return *)
      pa=60;   (* < symbol        *)
      pc=62;   (* > symbol        *)
      dot=46;  (* . symbol        *)

type line = string[80];
     pr = procedure;

var infile,outfile : file of byte;

procedure intestazione(n : line);
procedure rd(var x:byte);
procedure out(x:byte);
procedure license(name: namestr; inext,outext : extstr);
procedure loop(help,make_conversion : pr; inext,outext : extstr);

implementation

var calltime,endtime : system_time;
    chread,chwritten,star : word;
    starsize : longint;
    quiet : boolean;

procedure intestazione(n : line);
begin
writeln;
writeln(n);
writeln('Copyright 26/7/1989 by Roberto Ceccarelli - CASASOFT');
end;

procedure license(name: namestr; inext,outext : extstr);
begin
writeln;
writeln('use:   ',name,' [/q] filename[.ext] [destination]');
writeln;
writeln('Default input files extension is ',inext,'; output files have extension ',outext);
writeln('/q option suppress statistics');
writeln;
writeln('This program is released for pubblic domain: it can be freely duplicated,');
writeln('but it cannot be sold or modified in any part.');
writeln('Please report anything which can help us to improve this program.');
writeln;
writeln('If you find this program full of use, we''ll appreciate a contribution');
writeln('at following address:');
writeln('Roberto Ceccarelli - via Covignano 3 - 47037 Rimini - Italy');
end;

procedure out(x:byte);
begin
write(outfile,x);
inc(chwritten);
end;

procedure rd(var x:byte);
begin
read(infile,x);
inc(chread);
if not quiet then
  if chread > (star * starsize) then begin
    inc(star);  write('*');
    end;
end;

procedure loop(help,make_conversion : pr; inext,outext : extstr);
var filefound : boolean;
    dirinfo : searchrec;
    filename : pathstr;
    dir : dirstr;
    name : namestr;
    ext : extstr;
    p : array[1..3] of pathstr;

  procedure getparam;
  var j : byte;

    function slash : boolean;
    begin
    slash := copy(paramstr(1),1,1) = '/';
    end;

    procedure addbslash;
    begin
    if p[2] <> '' then p[2] := p[2] + '\';
    end;

    procedure evalopt;
    begin
    if (p[1] = '/q') or (p[1] = '/Q') then quiet := true
    else writeln(p[1],' option unknown: ignored.');
    end;

  begin
  quiet := false;
  for j := 1 to 3 do p[j] := paramstr(j);
  if slash then
    if paramcount > 1 then begin
      evalopt;
      p[1] := p[2];
      p[2] := p[3];
      addbslash;
      end
    else begin
      help; halt(1);
      end
  else addbslash;
  end;

  procedure openfiles(fin : pathstr; outext : extstr);
  var indir : dirstr;
      inname : namestr;
      inext : extstr;
      outname : pathstr;
  begin
  assign(infile,fin);
  fsplit(fin,indir,inname,inext);
  outname := p[2] + inname + outext;
  assign(outfile,outname);
  reset(infile);  rewrite(outfile);
  if not quiet then begin
    chread := 0;  chwritten := 0;   (* azzera i contatori per le statistiche *)
    starsize := (filesize(infile) div 79) + 1;  star := 0;
    get_system_time(calltime);
    end;
  writeln('Converting ',fin,' in ',outname);
  end;

  procedure closefiles;
  begin
  close(infile); close(outfile);
  if not quiet then begin
    writeln;
    writeln(chread,' bytes read, ',chwritten,' bytes written.');
    write('File successfully converted in ');
    get_system_time(endtime); elapsed_time(calltime,endtime);
    writeln; writeln;
    end;
  end;

begin
if paramcount = 0 then help else begin
getparam;
if not quiet then begin start_job_time; writeln; end;
filefound := false;
fsplit(p[1],dir,name,ext);
filename := p[1]; if ext='' then filename := filename + inext;
findfirst(filename,archive,dirinfo);
while doserror = 0 do begin
  filefound := true;
  openfiles(dir + dirinfo.name,outext);
  make_conversion;
  closefiles;
  findnext(dirinfo);
  end;
if not filefound then writeln(filename,' file not found');
if not quiet then end_job_time;
end; end;

end.
Inizio pagina
Home page
 
Creative Commons  License BY-NC-SA
Ove non diversamente specificato i contenuti del sito sono rilasciati con licenza Creative Commons BY-NC-SA 4.0 

Copyright © 2007-2020 The Strawberry Field - Roberto Ceccarelli