Contributor: MIKE COPELAND { 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.