{$A+,B-,D+,E+,F-,G+,I-,L+,N-,O-,P-,Q-,R-,S+,T-,V+,X+,Y+}
{$M 16384,0,60000}
(*~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
 ██████▄ ▄█████▄ ██████▄   ██      ▐██▌ ▄█████▄ ███████ ▄██████ ██████▄
 ██▄▄▄██ ██      ██▄▄▄█▀   ██       ██  ██▄▄▄▄    ▐█▌   ██▄▄▄▄  ██   ██
 ██▀▀▀▀  ██      ██▀▀▀██   ██       ██   ▀▀▀▀██   ▐█▌   ██▀▀▀▀  ██████
 ██      ▀█████▀ ██████▀   ███████ ▐██▌ ▀█████▀   ▐█▌   ▀██████ ██  ▀██ v0.50

                                                  (C)Pálma / PC-i 1997.03.02

 H:A forrás szabadon felhasználható, de ha módosítod, akkor küld el nekem is.
 E:The source is free usable, bat if you change this, please send to me.

 H:Kapcsolat:
 E:Conntact:
 ~~~~~~~~~~~~
 E-Mail: Palma@ThePentagon.com

 BBS   : The Dolphin BBS
         (+361)189-7745 (23-6h)

 Mail  : Tibor Takács (Pálma)
         Hungary
         1041 Budapest
         Závodszky 15.
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~*)
Uses Crt;
Const cop1=' PCBLister v0.50 - Freeware';
      cop2='  (C)Pálma 1997.03.02.';
Type lt=record
           listf:array[1..30]of char;
           dirf:array[1..30]of char;
           dirna:array[1..35]of char;
           bonus:char;
        end;
var t,t2,t3:text;
    conf:array[0..32767] of boolean;  (* Konferenciák, amiket listázni kell *)
    confnum:word;                     (* Aktuális konferencia száma *)
    confname:string;                  (* Aktuális konferencia neve *)
    (* Paraméterek: *)
    Alahuzas:char;                    (* Aláhúzás *)

Function Upstr(s1:string):String;var s:string;i:byte;begin s:=s1;for i:=1 to length(s1) do s[i]:=upcase(s[i]);upstr:=s;end;
Procedure kapcski;
begin
  Writeln('  Usage: PCBLIST <cnames dir> <output file> [<switch>] [<switch>]');
  writeln;
  Writeln('  Cnames dir: CNAMES''s directory (example:C:\PCB\GEN)');
  Writeln('  Output file: output file''s name (example:DOLPHIN.LST)');
  writeln;
  Writeln('  Switches:');
  Writeln('  /Us        Other underlining character (default: /U≈)');
  Writeln('  /Ann;nn-nn Specify which areas to process (default: /A0-32768)');
  Writeln('             (example: /A0;3-5;11;25-90 , /A5-8;12)');
halt;
end;
Procedure init;
var w,j1,j2:word;i:integer;           (* ciklushoz, számoláshoz *)
    inp:string;                       (* cname elérési útvonala *)
    outp:string;                      (* output fájl neve *)
    s1,s2:string;                     (* átmeneti változó *)

begin
 for w:=0 to 32767 do conf[w]:=true;
 confnum:=0;
 TextColor(4);Writeln(cop1);TextColor(7);Writeln(cop2);writeln;
 if paramcount<2 then kapcski;
 inp:=upstr(paramstr(1));if inp[length(inp)]<>'\' then inp:=inp+'\';
 outp:=upstr(paramstr(2));
 (* Alapbeallitasok *)
 Alahuzas:='≈';
 (* Paraméterek feldolgozása *)
 if paramcount>2 then
 For w:=3 to paramcount do begin
  s1:=upstr(Paramstr(w));
  if (s1[1]='/')and (length(s1)=2) then begin
   case s1[2] of
    '?':kapcski;
    'H':kapcski;
    else kapcski;end;
   end else begin if (s1[1]='/')and(s1[2]='U') then Alahuzas:=s1[3] else
                  if (s1[1]='/')and(s1[2]='A') then begin delete(s1,1,2);
                   for i:=0 to 32767 do conf[i]:=false;
                   while length(s1)>0 do begin
                    s2:='';
                    while (s1[1]<>';')and (length(s1)<>0) do begin s2:=s2+s1[1];delete(s1,1,1);end;
                    if s1[1]=';' then delete(s1,1,1);
                    if pos('-',s2)=0 then begin val(s2,j1,i);if i<>0 then kapcski;conf[j1]:=true;end else begin
                    val(copy(s2,1,pos('-',s2)-1),j1,i);if i<>0 then kapcski;
                    val(copy(s2,pos('-',s2)+1,10),j2,i);if i<>0 then kapcski;
                    if j2<j1 then kapcski;
                    for i:=j1 to j2 do conf[i]:=true;end;
                   end;end;
End;End;
assign(t,inp+'CNAMES.');
 assign(t2,outp);
 reset(t);
 if ioresult<>0 then begin writeln('  Conferences'' names file not found (01:',inp,'CNAMES)!');halt;end;
 rewrite(t2);
 if ioresult<>0 then begin writeln('  Output file error (02: ',outp,')!');close(t);halt;end;
end;

Procedure olvconf;
var l:lt;
    s1:string;
    aktn:word;
    i:integer;
    f:file of lt;
begin
  for i:=1 to 30 do readln(t,s1);
  aktn:=1;
  assign(f,s1);reset(f);
  if ioresult<>0 then begin writeln('  File not found (03: ',s1,')!');(*dir.lst not found*)end else begin
  while not eof(f) do
   begin
    writeln(t2);
    read(f,l);
    str(aktn,s1);s1:=confname+': '+s1+') '+l.dirna;while s1[length(s1)]=' ' do delete(s1,length(s1),1);
    writeln(t2,s1);
    for i:=1 to length(s1) do write(t2,Alahuzas);writeln(t2);writeln(t2);
    assign(t3,l.listf);reset(t3);
    if ioresult<>0 then begin
    s1:=l.listf;while pos(' ',s1)>0 do delete(s1,pos(' ',s1),1);
    writeln('  File not found (04: ',s1,')!');(*akt filelist not found*)end else begin
     gotoxy(1,wherey);clreol;write('  Current: ',s1);
     while not eof(t3) do
      begin
        readln(t3,s1);
        if s1[32]='|' then s1[32]:=' ';
        writeln(t2,s1);
      end;close(t3);end;

    inc(aktn);
   end;
  close(f);end;
  for i:=1 to 2 do readln(t,s1);
end;
Procedure olvas;
var w:word;                           (* ciklushoz *)
begin
 while not eof(t) do
 begin
  readln(t,confname);
  if conf[confnum] then olvconf else for w:=1 to 32 do readln(t);
  inc(confnum);
 end;
end;
begin
Init;
Olvas;
close(t);close(t2);writeln;
end.