DataMuseum.dk

top - metrics - download

    Length: 5632 (0x1600)
    Types: TextFile
    Names: »TST0102.PAS«

└─⟦d814f614c⟧ Bits:30008872 EDB Trænings- og Erhvervs Center / Almen Nyttig Data Service
    └─⟦this⟧ »TST0102.PAS« 

TextFile

program test;
const
  lf		= @10;
  maxline	= 132;
  loc_att	= @28;
  bell          = @7;
  delscr        = 12;
  cr 		= @13;
  nul           = @0;
  cmd           = 'term';

var
  i, q, valg    : integer;
  c		: char;
  tekst		: string(.maxline.);
  readtimeout   : boolean;
  maxtry        : boolean;
  f             : file;
  res           : integer;
  buf           : string(.127.);

    
type
  strform	= string(.maxline.);
  pchar         = ^char;
  
procedure name(p:pchar; s:strform);
var i : integer;
begin
   p := ptr(ord(p)+13);    (* nb! ikke flytbart *)
   for i := 1 to ord(s(.0.))  do
   begin
      p^ := s(.i.);  p := ptr(ord(p) +1);
   end;
end;

function rdrstatus : boolean;
var res : byte;
begin
 code
  $2A,$01,$00,                 (*       LD   HL,(1)  *)
  $01,$4A,$00,                 (*       LD   BC,04AH *)
  $09,                         (*       ADD  HL,BC   *)
  $CD,*+7,                     (*       CALL L1      *)
  $32,RES,                     (*       LD   (RES),A *)
  $18,1,                       (*       JR   L2      *)
  $E9;                         (*  L1:  JP   (HL)    *)
                               (*  L2:               *)
  rdrstatus := (res = 255);
end;

function readchraux: char;
var c : char;
    i : integer;
begin
  i:=1; 
  repeat i:=i+1 until rdrstatus or (i=1000);
  if i = 1000 then
  begin
    readtimeout:=true;
    readchraux := (chr(255));
  end else
  begin
    read(aux,c);
    readchraux:=chr(ord(c) and 127);
  end;
end;
  
function readstraux: strform;
var
  c	: char;
  s	: string(.maxline.);
begin
  s:='';
  repeat
    read(aux,c); c:=chr(ord(c) and 127); s:=s+c;
  until (c = lf) or (len(s) = maxline);
  readstraux:=s;
end;

procedure write_str_aux( s : strform );
var i : integer;
begin
   s := s + cr + lf;
   for i := 1 to len(s) do
   begin
      write(aux,s(.i.));
      c:= readchraux;
   end;
end;

procedure tryk_loc_att;
var
  c	: char;
  p	: integer;
begin
   readtimeout:=false;  maxtry := false; p:=1;

   repeat
      if readtimeout then p := p + 1;
      write(aux,loc_att);
      readtimeout := false;
      repeat
        c:=readchraux;
      until readtimeout or (c=bell);
   until (c = bell) or (p = 5);
   if p= 5 then maxtry := true;
end;

procedure fejl( art : integer);
begin
   gotoxy(0,0); write(chr(delscr)); 
   gotoxy(10,10); 
 writeln('DET ER IKKE MULIGT AT ETABLERE FORBINDELSE TIL DEN VALGTE MASKINE.');
   gotoxy(10,11);
   writeln('KONTAKT VENLIGST BRUGERSERVICE FOR YDERLIGERE INFORMATION. ');
   gotoxy(10,12);
   write('FEJLEN KAN SPORES TIL : ');
   case art of   
       1 : writeln('FRONT-END. ');
       2 : writeln('HOST UNKNOWN. ');
       3 : writeln('RC8000. ');
   end; (* case *)
end;

BEGIN

   
   assign(f,'A:$$$.SUB');
   name(ptr(ord(addr(f))),'$$$     SUB');
   rewrite(f);
   if iores <> 0 then
      write('bad makefile')
   else begin
   gotoxy(0,0); write(chr(delscr));

   
   writeln; writeln;
   writeln('          ** RC855 - RCNETMENU ** ');
   writeln;
   writeln('    1:   RCADM     ');
   writeln;
   writeln('    2:   RCPA      ');
   writeln;
   writeln('    3:   TELE-KUW1 ');
   writeln;
   writeln('    4:   TELE-KUW2 ');
   writeln;
   writeln('    5:   TELE-DEMO ');
   writeln;
   writeln('    6:   UDSALG    ');
   writeln;
   writeln('    7:   BALMU1    ');
   writeln;
   writeln('    8:   BALMU2    ');
   writeln; writeln;
   write  ('    INDTAST NUMMER FOR VALG AF VÆRTSDATAMAT : ');
   read(valg);
   tryk_loc_att;
   if not maxtry then 
   begin
      write_str_aux('re');
      if false then begin tekst := readstraux;
      writeln(tekst); end;
      tryk_loc_att;
      if not maxtry then
      begin
         case valg of
            1 : write_str_aux('se rcadm');
            2 : write_str_aux('se rcpa');
            3 : write_str_aux('se tele-kuw1');
            4 : write_str_aux('se tele-kuw2');
            5 : write_str_aux('se tele-demo');
            6 : write_str_aux('se udsalg');
            7 : write_str_aux('se balmu1');
            8 : write_str_aux('se balmu2');
         end;  (* case *)
         
         if rdrstatus then 
         begin
            tekst := readstraux;
            if pos('ok',tekst) <> 0 then
            begin
               if rdrstatus then
                  tekst := readstraux
               else
               begin
                  write(aux,loc_att,'se');
                  if rdrstatus then
                     tekst := readstraux
                  else fejl(1);
               end;
	       if pos('busy',tekst) <> 0 
                  then fejl(3)
               else
               begin
                  if pos('connected',tekst) = 0 
                     then fejl(1)
                  else
                  begin
 		     q:=1;
                     readtimeout := false;
                     repeat 
                        while (readchraux <> bell) or readtimeout do;
                     until (not readtimeout) or (q=5);
                     if q=5 then fejl(3)
                     else
		     begin
                        buf := cmd;
			buf(.ord(buf(.0.)) + 1 .) := chr(0);
			blockwrite(f,buf,1);
                     end;
		  end;
	       end;
	    end
	    else fejl(2);
	 end
	 else fejl(1);
      end
      else fejl(1);
   end
   else fejl(1);
close(f);
end;
END.
«eof»