Program LICO;         {Sendet eine Datenfolge an den PIC}

Uses DOS, CRT;

const BA : Integer = $03F8;  { $03F8=COM1, $02F8=COM2}

procedure Init;
var  i, Dummy :Byte;
begin
  Port[BA+3]:=128;
  Port[BA+0]:=12; { 12: 9600 Baud, 6 :19200 Baud }
  Port[BA+1]:=0;
  Port[BA+3]:=7;  { 8-Bit, n-Parity, 2 Stopbits }
  Port[BA+1]:=0;  { keine Interrupts }
  Port[BA+4]:=0;  { DTR = 0, RTS = 0}
  for i:= 1 to 3 do
    Dummy:=Port[BA];   { UART leeren }
end;

procedure Sende (Zeichen :Byte);
begin
  while (Port[BA+5] AND 32) = 0 do;  { Sende-Halteregister leer? }
  Port[BA]:=Zeichen;
end;

var a: array[1..256] of byte;
    n,i,z,max: integer;

begin
     init;
     clrscr;
     writeln('');
     writeln('    Programm zum Senden von Daten an den PIC');
     writeln('    Einzugeben sind Dezimalzahlen 0 ..255; gesendet werden HEX-Zahlen');
     writeln('    Bitte die Gesamtzahl der Zahlen eingeben und mit Return best�tigen');
     readln(max);
        writeln('    Bitte jetzt die Zahlen eingeben und jede mit Return abschlie�en');
        writeln('    Zeilen vollst�ndig f�llen! Gesendet wird nur die Gesamtzahl');
        i:=1;
        z:=8;
        while (i <= max) do
        begin
          n:=1;
          repeat
            gotoxy(n,z);
            read(a[i]);
            n:=n+4;
            i:=i+1;
          until n>80;
          z:=z+1;
        end;
        delay(65500);
        writeln('    Nach Eingabe aller Zahlen PIC einschalten und Return!');
        readln;
        readln;
        writeln('    Es folgt das Sendeprotokoll');
        for i:=1 to max do
            begin
            write(a[i]:4);
            sende(ord(a[i]));
            delay(65500);
            end;
     writeln;
     writeln('Programm beenden mit Return');
     readln;
     readln;
end.