CODE DE HAMMING (4,8) : TRANSMISSION DE DONNÉES SANS ERREUR [CONSOLE]

program Hamming;
uses SysUtils;

(*  =========================================================  *)
(*                                                             *)
(*    Méthode de Hamming: transmission de données sans erreur  *)
(*    © Tanguy Altert, http://altert.family.free.fr/           *)
(*                                                             *)
(*  Août 2005                                                  *)
(*                                                             *)
(*  =========================================================  *)

  {$APPTYPE Console}

const BPower    : array[0..7] of byte            = (1, 2, 4, 8, 16, 32, 64, 128);
      BinChar   : packed array[boolean] of char  = '01';
      Separator                                  = '=============================================';

type  THData    = string[8];

var Texte       : string;

    Orn         : byte;
    BinMem      : string;
    BinBuff     : string;
    BinDump     : string;
    BinHamg     : string;

    ModifCount  : integer;

    HammingIn   : array[1..4] of boolean;
    HammingOut  : array[1..8] of boolean;

    idx, pw     : integer;
    bool        : boolean;
    s           : string;
    WillRepair  : boolean;

(***************************************************************************)
(*  Cette partie simule un correspondant distant recevant les données.     *)
(*  Le corps principal du programme n'est pas censé pouvoir modifier       *)
(*  directement les variables suivantes (d'où l'utilisation de procédures  *)
(*  telles que SetRepair. Cela simule des conversations sur un réseau.     *)

var PackCount, ErrorCount : integer;
    HMsg                  : string;
    DoRepair              : boolean;

  procedure RevTransf;
  begin
    HammingIn[1]:=HammingOut[1] xor HammingOut[2] xor HammingOut[5];
    HammingIn[2]:=HammingOut[3] xor HammingOut[4] xor HammingOut[6];
    HammingIn[3]:=HammingOut[1] xor HammingOut[3] xor HammingOut[7];
    HammingIn[4]:=HammingOut[2] xor HammingOut[4] xor HammingOut[8];
  end;

  procedure SetRepair(State:boolean);
  begin
    DoRepair:=State;
  end;

  procedure Init;
  begin
    PackCount:=0;
    ErrorCount:=0;
    DoRepair:=false;
    HMsg:='';
  end;

  procedure Send(Data:THData);
  var Sgn  : byte;
      EBit : byte;
      i    : integer; //la variable de boucle doit être locale
  label ReCheck;
  begin
    inc(PackCount);

  //CONVERTISSONS LE SIGNAL REÇU EN TABLEAU DE BOOLÉENS
    for i:=1 to 8 do
      HammingOut[i]:= Data[i]='1';

  ReCheck:
    RevTransf;

  //REPÉRONS LA SIGNATURE (EN BINAIRE INVERSÉ)
    Sgn:=0;
    for i:=1 to 4 do
      Sgn:=Sgn+ Ord(HammingIn[i]) * BPower[i-1];

  //CORRECTION DU SIGNAL   [1, 2, 4, 8, 16, 32, 64, 128]
    case Sgn of
       0 {0000}: EBit:=0;   //le signal est OK !
       1 {1000}: EBit:=5;
       2 {0100}: EBit:=6;
       4 {0010}: EBit:=7;
       5 {1010}: EBit:=1;
       6 {0110}: EBit:=3;
       8 {0001}: EBit:=8;
       9 {1001}: EBit:=2;
      10 {0101}: EBit:=4;
      else EBit:=0;         //pas de correction possible
    end;

    if EBit>0 then
      begin
        inc(ErrorCount);
        WriteLn('   Erreur sur le bit N°',EBit,' du paquet N°',PackCount,' envoyé');
        if DoRepair then
          begin
            HammingOut[EBit]:=not HammingOut[EBit];  //le HammingIn a juste servi comme détecteur d'erreur et pas comme le décompilé du HammingOut
            goto ReCheck;
          end;
      end;

  //MÉMORISATION DU PAQUET
    for i:=1 to 4 do
      HMsg:=HMsg+ BinChar[HammingOut[i]];
  end;

  procedure Final;
  var i : integer;
  begin
    WriteLn('Le correspondant a reçu ',PackCount,' paquets, soit ',8*PackCount,' bits.');
    case ErrorCount of
      0:   WriteLn('Aucune erreur n''a été détectée.');
      1:   WriteLn(ErrorCount,' erreur a été détectée.');
      else WriteLn(ErrorCount,' erreurs ont été détectées.');
    end;
    WriteLn;
    WriteLn('Le message binaire reçu est :');
    WriteLn(HMsg);
    WriteLn;
    WriteLn('Il correspond au message original suivant :');

  //ON DECODE LE DUMP BINAIRE
    BinBuff:=HMsg;
    Texte:='';
    repeat
      BinMem:=Copy(BinBuff,1,8);
      Orn:=0;
      for i:=1 to 8 do
        Orn:=Orn + BPower[i-1]*StrToInt(BinMem[i]);
      Texte:=Texte + Chr(Orn);
      Delete(BinBuff,1,8);
    until BinBuff='';
    WriteLn(Texte);
  end;

(*                                                                        *)
(*                                                                        *)
(*                                                                        *)
(**************************************************************************)

label ReDo;
begin
//TITRE
  WriteLn('Méthode de Hamming : transmission de données sans erreur');
  WriteLn(Separator);
  WriteLn;

//SAISIE DU TEXTE
ReDo:
  SetRepair(false);
  WriteLn('Saisissez le texte à transmettre virtuellement :');
  ReadLn(Texte);

//DUMP BINAIRE
  BinDump:='';
  for idx:=1 to Length(Texte) do
    begin
      Orn:=Ord(Texte[idx]);
      for pw:=0 to 7 do
        BinDump:=BinDump + BinChar[Orn and BPower[pw]>0];
      //ATTENTION: c'est un dump binaire inversé, c'est à dire que 2^0 se trouve à gauche et 2^7 à droite
    end;
  WriteLn;
  WriteLn(Separator);
  WriteLn('L''anti-dump binaire associé est :');
  WriteLn(BinDump);

//TRAITEMENT DU SIGNAL
  BinHamg:='';
  BinBuff:=BinDump;
  repeat
    //on traite les données par 4 bits (c'est pourquoi on a dumpé en binaire)
      BinMem:=Copy(BinBuff,1,4);
      for idx:=1 to 4 do
        HammingIn[idx]:= BinMem[idx]='1';

    //transformation mathématique
      HammingOut[1]:=HammingIn[1];
      HammingOut[2]:=HammingIn[2];
      HammingOut[3]:=HammingIn[3];
      HammingOut[4]:=HammingIn[4];
      HammingOut[5]:=HammingIn[1] xor HammingIn[2];
      HammingOut[6]:=HammingIn[3] xor HammingIn[4];
      HammingOut[7]:=HammingIn[1] xor HammingIn[3];
      HammingOut[8]:=HammingIn[2] xor HammingIn[4];

    //constitution du signal de sortie et effacement du premier paquet de 4 bits situé au début
      for idx:=1 to 8 do
        BinHamg:=BinHamg + BinChar[HammingOut[idx]];
      Delete(BinBuff,1,4);
  until BinBuff='';

  WriteLn;
  WriteLn('Le signal de Hamming associé est :');
  WriteLn(BinHamg);

//Naturellement, le dump de Hamming est deux fois plus lourd que le dump binaire.
//Il reste quand même un avantage: il est possible de réparer le signal s'il y a
//des erreurs, ce que ne permet pas un simple dump binaire.

//POSSIBILITE DE MODIFIER LE DUMP
  WillRepair:=false;
  WriteLn;
  WriteLn('Le but de ce code est de détecter les erreurs de transmission.');
  WriteLn('Vous pouvez modifier quelques bits de Hamming, mais vous allez');
  WriteLn('vous faire griller lors de la réception (sauf s''il y a');
  WriteLn('compensation des erreurs)...');
  WriteLn;
  Write  ('Voulez-vous modifier des bits ? (oui/non)  ');
  ReadLn(s);
  if LowerCase(s)='oui' then
    begin
      WriteLn;
      WriteLn('Tapez "-1" pour arrêter. Sachez qu''il y a ',Length(BinHamg),' bits dans le message...');
      ModifCount:=0;
      bool:=false;
      repeat
        Write(' Bit N°');
        ReadLn(idx);
        if (idx=-1) or (idx>Length(BinHamg)) then
          bool:=true
        else
          begin
            BinHamg[idx]:=BinChar[not boolean(StrToInt(BinHamg[idx]))];
            inc(ModifCount);
          end;
      until bool;
      WriteLn;
      WriteLn(ModifCount,' bits du signal ont été modifiés...');
      WriteLn;
      WriteLn(Separator);
      WriteLn('Le signal de Hamming est maintenant celui-ci :');
      WriteLn(BinHamg);

      if ModifCount>0 then
        begin
          WriteLn;
          WriteLn('Vous avez la possibilité d''activer le correcteur d''erreur.');
          Write  ('Souhaitez-vous le faire ? (oui/non)  ');
          ReadLn(s);
          WillRepair:= LowerCase(s)='oui';
        end;
    end;

//ENVOI DU MESSAGE
  WriteLn;
  WriteLn(Separator);
  Init;
  SetRepair(WillRepair);
  BinBuff:=BinHamg;
  repeat
    Send(Copy(BinBuff,1,8));
    Delete(BinBuff,1,8);
  until BinBuff='';

//FINALISATION DU TRAITEMENT ET PURGE DE LA MEMOIRE
  WriteLn;
  WriteLn(Separator);
  Final;
  BinMem:='';
  BinBuff:='';
  BinDump:='';
  BinHamg:='';

//POSSIBILITE DE RECOMMENCER
  WriteLn;
  WriteLn(Separator);
  Write('Souhaitez-vous recommencer ce test très convaincant ? (oui/non)  ');
  ReadLn(s);
  if LowerCase(s)='oui' then
    begin
      for idx:=1 to 5 do
        WriteLn;
      goto ReDo;
    end;
end.