[Back to MISC SWAG index] [Back to Main SWAG index] [Original]

    {
     GC> Does anyone know how to make a Pascal program to sort a file and
     GC> then remove the duplicates and choose a random line ??  I need this for
     GC> my tagline file and need some type of program to do this.  Thanks!

       Here's a start for you:
    }
    program TagLines_Manager;               { TagLines Manager  MRCopeland 950906}
    {$M 32768,0,655000}
    Uses CRT,DOS,FastTTT5,WinTTT5,RPU1;
    const
         VERSION = '1.2.4';
         TLIM    = 10000;                                        { TagLines Limit
    }     CLIM    = 100;                                   { Comment records Limit
    }type
         S80     = string[80];
         LLPTR   = ^S80;
    var
        I, J, K  : integer;
        TX,CT,XT : integer;                            { Areas, i/p record counts
    }    PAX,CRX  : integer;                                 { Pointer Array indeX
    }    STATUS   : integer;
        HRF      : boolean;                                  { Header Record Flag
    }    DTIME    : LongInt;                             { Original File Date/Time
    }    DT       : DateTime;
        DS       : DirStr;
        NS       : NameStr;
        ES       : ExtStr;
        PRIOR,T  : S80;
        PA       : array[1..TLIM] of LLPTR;   { Pointer Array for stored TagLines
    }    CRECS    : array[1..CLIM] of LLPTR;                     { Comment Records
    }
    procedure HEADER;
    begin
      ClrScr;
      WriteCenter (2,LightGray,Black,'**** TagLines Manager - Ver '+VERSION+'
    ****')end;  { HEADER }

    procedure INITIALIZE;                         { initialize system & variables
    }begin
      HEADER;
      if ParamCount > 0 then F3 := ParamStr(1)
      else
        begin
          WPROM (LONORM,'Enter TagLines filename: '); readln (F3);
        end;
      if not EXISTS (F3) then FATAL ('Cannot Open '+F3+' as input file');
      FastWrite (1,25,LONORM,FSI(MemAvail,1)+' Bytes @ start ');
      for I := 1 to TLIM do PA[I] := Nil;
      for I := 1 to CLIM do CRECS[I] := Nil;
      BBOPEN (FV3,F3,'r',BUFFIN);
      GetFTime (FV3,DTIME); UnPackTime (DTIME,DT)
    end;  { INITIALIZE }

    procedure SORT_TAGS (LEFT,RIGHT : word);                   { Lo-Hi QuickSort }
    var LOWER,UPPER,MIDDLE : word;
        PIVOT              : S80;
    begin
      LOWER := LEFT; UPPER := RIGHT; MIDDLE := (LEFT+RIGHT) Shr 1;
      PIVOT := PA[MIDDLE]^;
      repeat
        while PA[LOWER]^ < PIVOT do Inc(LOWER);
        while PIVOT < PA[UPPER]^ do Dec(UPPER);
        if LOWER <= UPPER then
          begin
            T := PA[LOWER]^; PA[LOWER]^ := PA[UPPER]^;
            PA[UPPER]^ := T; Inc (LOWER); Dec (UPPER)
          end;
      until LOWER > UPPER;
      if LEFT < UPPER then SORT_TAGS (LEFT, UPPER);
      if LOWER < RIGHT then SORT_TAGS (LOWER, RIGHT)
    end;                                                              { SORT_TAGS
    }
    procedure READ_TAGS;
    var P : Word;
    begin
      CT := 0; TX := 0; XT := 0; PAX := 0; CRX := 0;
      while not EOF (FV3) do
        begin
          readln (FV3,S1); Inc (CT); FastWrite (1,DSLINE,LONORM,FSI(CT,5));
          CH := S1[1]; S2 := TTB(S1);
          if CH in [';','%','@'] then                           { Comment Records }
            begin
              Inc (CRX);
              if CRX <= CLIM then
                begin
                  New (CRECS[CRX]); CRECS[CRX]^ := S2; Inc (XT);
                  FastWrite (13,DSLINE,HINORM,FSI(CRX,4))
                end
            end
          else
            begin                                                      { TagLines }
              if Copy(S2,1,4) = '... ' then Delete (S2,1,4);       { flush header}
              while (Pos(' -- ',S2) > 0) do              { change " -- ' to " - " }
                begin
                  P := Pos(' -- ',S2); Delete (S2,P+1,1)
                end;
              while (Length(S2) > 0) and (S2[1] = ' ') do Delete (S2,1,1);
              if Length(S2) > 0 then
                begin
                  Inc (PAX);
                  if PAX <= TLIM then
                    begin
                      New (PA[PAX]); PA[PAX]^ := S2; Inc (TX);
                      FastWrite (7,DSLINE,LONORM,FSI(PAX,4))
                    end
                end  { if }
            end;
        end;
      FastWrite (50,25,LONORM,FSI(MemAvail,1)+' Bytes with data loaded');
      Close (FV3); Dispose (BUFFIN);
      SORT_TAGS (1,PAX);
      FSplit(F3,DS,NS,ES); F1 := DS+NS+'.BAK';
      if EXISTS (F1) then
        begin
          Assign (FV1,F1); Erase(FV1)
        end;
      ReName (FV3,F1); BBOPEN (FV3,F3,'w',BUFFOUT); PRIOR := '';
      CT := 0;
      for I := 1 to CRX do                              { write out comment lines
    }    writeln (FV3,CRECS[I]^);
      XT := 0;
      for I := 1 to PAX do                            { write out sorted TagLines
    }    begin
          Inc (CT);
          if PA[I]^ <> PRIOR then
            begin
              PRIOR := PA[I]^; writeln (FV3,PRIOR); Inc (XT)
            end;
          FastWrite (20,DSLINE,LONORM,FSI(CT,5)+FSI(XT,5))
        end;
      Close (FV3); Dispose (BUFFOUT)
    end;  { READ_TAGS }

    begin  { MAIN LINE }
      STATUS := 0;
      INITIALIZE;                                 { initialize system & variables}
      READ_TAGS;                        { read & store selected records, reformat}
      WriteCenter (ERLINE,LightGray,Black,'Finis...'); PAUSE
    end.

[Back to MISC SWAG index] [Back to Main SWAG index] [Original]