Fehlererkennung mit Paritätsbit, Quittungsbetrieb

SendWait1.zip

Quelltextauszüge

Sender

procedure TSender.sende_Byte(b : byte);
var
  paritaet : boolean;
  j        : integer;
begin
  paritaet := false;
  // StartBit
  HW.SetAus(true);
  sleep(bitZeit);
  // DatenBits
  for j := 0 to 7 do
  begin
    if b and 1 = 1
    then
    begin
      HW.SetAus(true); paritaet := not paritaet;
    end
    else
    begin
      HW.SetAus(false);
    end;
    b := b shr 1;
    sleep(bitZeit);
  end;
  // ParitätsBit
  if paritaet then HW.SetAus(true) else HW.SetAus(false);
  sleep(bitZeit);
  // StoppBit
  HW.SetAus(false);
  sleep(bitZeit);
end;

procedure TSender.empfange_Rueckmeldung;
var
  paritaet : boolean;
  i        : integer;
  n,n1,n2  : TLargeInteger;
begin
  rueckmeldung := 0;
  QueryPerformanceCounter(n);
  n1 := n;
  n2 := n1 + round((20*BitZeit)/1000*c);
  // auf StartBit warten
  while (HW.GetEin  true) do
  begin
    QueryPerformanceCounter(n);
    if n > n2 then exit;
    sleep(0);
  end;
  // Mitte Bit0 erreicht
  sleep(bitZeit + bitZeit div 2);
  // Bits abtasten
  for i := 0 to 7 do
  begin
    if HW.GetEin then Inc(rueckmeldung);
    sleep(bitZeit);
  end;
  // Paritätsbit
  sleep(bitZeit);
  // Mitte StoppBit erreicht
  sleep(bitZeit div 2);
end;


//-------- execute (public) --------------------------------------------
procedure TSender.execute;
var
  n,i,j    : integer;
  b        : byte;
begin
  bitZeit := round(1000/baud);
  n := Length(SendeStr);
  i := 1;
  while i <= n do
  begin
    b := ord(sendeStr[i]);
    sende_Byte(b);
    empfange_Rueckmeldung;
    Form1.mSend.text := Form1.mSend.text+IntToStr(rueckmeldung); // DEBUG
    if rueckmeldung > 4 then inc(i); // mindestens 5 Bits gesetzt
  end;
end;

Empfänger

procedure TEmpfaenger.empfange_Byte(var b: byte; var fehler : boolean);
var
  paritaet : boolean;
  i        : integer;
begin
  b := 0; paritaet := false;
  // auf StartBit warten
  while HW.GetEin  true do sleep(0);
  // Mitte Bit0 erreicht
  sleep(bitZeit+ bitZeit div 2);
  // Bits abtasten
  for i := 0 to 7 do
  begin
    b := b shr 1;
    if HW.GetEin
    then
    begin
      b := b+128;
      paritaet := not paritaet;
    end;
    sleep(bitZeit);
  end;
  // Paritätsbit
  fehler :=  HW.GetEin  paritaet;
  sleep(bitZeit);
  // Mitte StoppBit erreicht
  sleep(bitZeit div 2);
end;

....

//-------- execute (public) --------------------------------------------
procedure TEmpfaenger.execute;
var
  n,i,j     : integer;
  b         : byte;
  fehler    : boolean;
  c,nt      : TLargeInteger;
  t,tout    : real;
begin
  bitZeit := round(1000/baud);
  while not Terminated do
  begin
    empfange_Byte(b,fehler);
    if not fehler
    then
    begin
      puffer := puffer+chr(b);
      rueckmeldung := 255; // OK
    end
    else
    begin
      // puffer := puffer+chr(b)+'~';
      rueckmeldung := 0;   // Fehler
    end;
    sende_Byte(rueckmeldung);
    if Assigned(OnChange) then OnChange;
  end;
end;