DataMuseum.dk

top - download

    Length: 2688 (0xa80)
    Types: TextFile
    Names: »TRAP1.PAS«

└─⟦692ac107c⟧ Bits:30005923 PolyPascal-80 V3.10 arbejdsdiskette 1
    └─ ⟦this⟧ »TRAP1.PAS« 

TextFile

type

str4 = string(.4.);
buffer = array(.0..127.) of byte;
frec=array(.0..63.) of byte;
trec = record
  c : byte;
  fbuf : array(.0..1.) of frec;
  end;
  
var
  a : char;
  slut : boolean;
  fil : file;
  buf : array(.0..127.) of byte;
  hbuf : array(.0..1.) of frec at buf;
  gad,nad,ad,i,j,k : integer;
  itrap,strap : string(.30.);
  navn : string(.20.);
  cbuf,sbuf : string(.128.);
  f : trec at sbuf;

FUNCTION HEX(NUMBER,DIGITS: INTEGER): STR4;
CONST
  HEXDIGITS: ARRAYÆ0..15Å OF CHAR = '0123456789ABCDEF';
VAR
  D: INTEGER;
  H: STR4;
BEGIN
  HÆ0Å:=CHR(DIGITS);
  FOR D:=DIGITS DOWNTO 1 DO
  BEGIN
    HÆDÅ:=HEXDIGITSÆNUMBER AND 15Å;
    NUMBER:=NUMBER SHR 4;
  END;
  HEX:=H;
END;

procedure getbuf;
begin
  begin
    if i = 0 then
    begin
      blockread(fil,buf,1);
      f.fbuf(.0.) := hbuf(.0.);
      f.c := 64;
      i := 1;
    end else
    begin
      if eof(fil) then slut := true;
      f.fbuf(.0.) := hbuf(.1.);
      i := 0;
    end;
    cbuf := cbuf + sbuf;
  end;
end;

begin
  writeln(clrhom,'         -  Program til at finde match-string i en fil. -');
  writeln       ('                    ( (C) 1985 Erik Palsbo )');
  writeln       ('                  (må copieres til privat brug)');
  writeln;
  write('Indtast filnavn:');
  readln(navn);
  assign(fil,navn);
  reset(fil);
  strap := '';
  repeat
  write('Søges der på tekststreng(T) eller hex-streng(H) ?: ');
  read(trm,a);
  writeln;
  case a of
    't','T' : begin
                write('Søgekriterie: ');
                readln(strap);
              end;
    'h','H' : begin
                writeln('Afslut med <RETURN>');
                repeat
                  j := $ffff;
                  write('søgekarakter (eks.$41):');
                  readln(j);
                  if j<>$ffff then strap := strap+chr(j);
                  write('Søgestring:<');
                  for i := 1 to len(strap) do write('$',hex(ord(strap(.i.)),2),',');
                  writeln('>');
                until j=$ffff;
              end;
     otherwise writeln('Skal være T eller H;');
     end;
 until a in (.'t','T','h','H'.);
  i := 0;
  ad := $FF;
  cbuf := '';
  slut := false;
  while not slut do
  begin
    while len(cbuf) <= 64 do getbuf;
    while pos(strap,cbuf) > 0 do
    begin
      k := pos(strap,cbuf);
      delete(cbuf,1,k);
      ad := ad+k;
      writeln('Fundet på addr: $',hex(ad,4));
    end;
    if len(cbuf) >= 64 then
    begin
      delete(cbuf,1,32);
      ad := ad+32;
    end;
  end;
  close(fil);
end.
«eof»