CryptyCS : Module de chiffrement à la volée pour Medycs

program CryptyCS;

uses
  clipbrd,
  dialogs,

  sysutils,

  cryptage,

  jc32_INI,
  jc32_str

    ;

{$R *.res}

var
  s, k, r: string;
  P1, P2:  integer;

const
  B1   = '#[ ';
  B2   = ' ]#';
  cr   = ^m + ^j;
  mrOk = 1;

begin

  s := Clipboard.AsText;
  if s = '' then
    begin
      ShowMessage('Rien dans le presse papier');
      exit;
    end;

  // La clef de chiffrement en paramètre
  k := paramstr(1);

  if k = '' then
    k := copy(Get_ComputerName, 1, 6);

  P1 := pos(B1, s);
  P2 := pos(B2, s);

  // DECRYPTE
  if (P1 > 0) and (P2 > (P1 + 2)) then // Si 2 balises => c'est un message crypté
    begin                              // Enlève les balises
      s := GetStrBalised(s, B1, B2, false);
      r := CRYPT_Str_XOR(s, k);
      if messagedlg('CRYPTYCS DECHIFFREMENT' + cr + cr + 'DEBUT------>' + cr + cr + r + cr + cr + '<------FIN' + cr + cr
          + 'Voulez-vous copier ce message dans le presse-papier?' + cr + cr + '1- [OK = ENTREE]' + cr +
          'pour le copier et le récupérer en clair avec CTRL+V' + cr + '2- [ANNULER = ECHAPPE]' + cr +
          'Pour l''effacer de la mémoire et garder le message secret', mtConfirmation, mbOKCancel, 0) = mrOk then
        begin
          Clipboard.AsText := r;
          ShowMessage('Dans le document: Tapez CTRL+V' + cr + cr + 'Pour récuperer le contenu du presse papier')
        end;
    end
    // CRYPTE
  else
    begin
      r                := CRYPT_Str_XOR(s, k);
      Clipboard.AsText := B1 + r + B2;
    end;

end.

http://codes-sources.commentcamarche.net/source/25304-unite-de-cryptage-decryptage-par-xor

function AnsiCrypt(entree: AnsiString; cle: AnsiString): AnsiString;
    var
      I, J, LongEntree, LongCle, VResult: integer;
      VEntree, VCle:                      ^byte;
      VBuffer:                            ^AnsiChar;
      buffer:                             AnsiString;
    begin
      LongEntree := length(entree);
      LongCle    := length(cle);

      If (LongEntree > 0) and (LongCle > 0) then
        begin

          setlength(buffer, LongEntree);

          for I := 1 to LongEntree do
            begin
              for J := 1 to LongCle do
                begin
                  VEntree   := @entree[I];
                  VCle      := @cle[J];
                  VResult   := VEntree^ xor VCle^;
                  VBuffer   := @VResult;
                  buffer[I] := VBuffer^;
                end;
            end;
        end;
      if buffer <> '' then
        result := buffer
      else
        result := '';
    end;