求：摩斯密碼算法(加密与解密) for delphi

Question

如题~~求：摩斯密碼算法(加密与解密) for delphi

Answer 1

找到了个JS的，谁帮译成Delphi的：<script LANGUAGE="JavaScript">var respecterCasse = true;
var ignorerCasse = false;
var motsEntiers = true;
var touteSousChaine = false;function rechercher(cible,terme,respecterCasse,motSeulement) {  var ind = 0;  var suivant = 0;  if (!respecterCasse) {    terme = terme.toLowerCase();    cible = cible.toLowerCase();  }  while ((ind = cible.indexOf(terme,suivant)) >= 0) {    if (motSeulement) {      var avant = ind - 1;      var apres = ind + terme.length;      if (!(espace(cible.charAt(avant)) && espace(cible.charAt(apres)))) {        suivant = ind + terme.length;        continue;      }    }    return true;  }  return false;}function remplacer(cible, ancienTerme,nouveauTerme,respecterCasse,motSeulement) {  var travail = cible;  var ind = 0;  var suivant = 0;  if (!respecterCasse) {    ancienTerme = ancienTerme.toLowerCase();    travail = cible.toLowerCase();  }  while ((ind = travail.indexOf(ancienTerme,suivant)) >= 0) {    if (motSeulement) {      var avant = ind - 1;      var apres = ind + ancienTerme.length;      if (!(espace(travail.charAt(avant)) && espace(travail.charAt(apres)))) {        suivant = ind + ancienTerme.length;        continue;      }    }    cible = cible.substring(0,ind) + nouveauTerme + 
cible.substring(ind+ancienTerme.length,cible.length);    travail = travail.substring(0,ind) + nouveauTerme + 
travail.substring(ind+ancienTerme.length,travail.length);    suivant = ind + nouveauTerme.length;    if (suivant >= travail.length) { break; }  }  return cible;}function espace(check) {
  var espace = " ,/<>?!`';:%^&()=|{}" + '"' + "\\\n\t";
  for (var i = 0; i < espace.length; i++)    if (check == espace.charAt(i)) { return true; }     if (check == "") { return true; }  if (check == null) { return true; }  return false;}// STOP HIDING -->function creerMatrice(num) {  for (var i=1; i <= num; i++)    this[i] = "";  this.length = num;}var MORSE = new creerMatrice(26+6);var AVIATION = new creerMatrice(26+6);MORSE[01] = ".-"MORSE[02] = "-..." MORSE[03] = "-.-."MORSE[04] = "-.."MORSE[05] = "."MORSE[06] = "..-."MORSE[07] = "--."MORSE[08] = "...."MORSE[09] = ".."MORSE[10] = ".---"MORSE[11] = "-.-"MORSE[12] = ".-.."MORSE[13] = "--"MORSE[14] = "-."MORSE[15] = "---"MORSE[16] = ".--."MORSE[17] = "--.-"MORSE[18] = ".-."MORSE[19] = "..."MORSE[20] = "-"MORSE[21] = "..-"MORSE[22] = "...-"MORSE[23] = ".--"MORSE[24] = "-..-"MORSE[25] = "-.--"MORSE[26] = "--.."MORSE[27] = "-.-.."
MORSE[28] = "--.-."
MORSE[29] = "----"
MORSE[30] = ".---."
MORSE[31] = "...-."
MORSE[32] = "..--"
CARACTERES = "ABCDEFGHIJKLMNOPQRSTUVWXYZ[@*]$#"function CODE(LETTRE){if(LETTRE == " "){return " " }for(tg=0; tg<=26+6; tg++) {var LT = CARACTERES.charAt(tg)if(LT == LETTRE){return MORSE[tg +1] }}return ""}function GO() {var text = document.forms[0].valeur.valuetext = text.toUpperCase()var MSG = ""var LTR = ""NUM = text.lengthfor(t = 0; t <= NUM-1; t++){if (text.charAt(t) == '^') {
LTR = text.charAt(++t)
switch (LTR) {
case 'C': case 'c': LTR = "["; break;
case 'G': case 'g': LTR = "@"; break;
case 'H': case 'h': LTR = "*"; break;
case 'J': case 'j': LTR = "]"; break;
case 'S': case 's': LTR = "$"; break;
case 'U': case 'u': LTR = "#"; break;
}
} else {
LTR = text.charAt(t)
}MSG = MSG + ( CODE(LTR) + " ") ;
}document.forms[0].OUTPUT.value = MSG}function UNGO(){var text = document.forms[0].OUTPUT.valuetext = text.toUpperCase()var MSG = text + " "for(th=0;th<=25+6;th++){AA = MORSE[th +1]BB = CARACTERES.charAt(th)MSG = remplacer(MSG,AA,BB,false, true)}MSG = remplacer(MSG,"  ","%")MSG = remplacer(MSG," ","")MSG = remplacer(MSG,"%"," ")document.forms[0].valeur.value = MSG}
   </script>

Answer 2

这个是有规律的，参考Huffman编码

Answer 3

翻译代码如下：（未经严格测试）unit MosiCode;interfaceuses
  SysUtils, StrUtils;  function espace(check: string): Boolean;
  procedure GO(txt: string; var msg: string);
  procedure UNGO(txt: string; var msg: string);implementationvar respecterCasse: Boolean = true;
var ignorerCasse: Boolean = false;
var motsEntiers: Boolean = true;
var touteSousChaine: Boolean = false;function rechercher(cible,terme: string; respecterCasse,motSeulement: Boolean): Boolean;
var
  ind: Integer;
  suivant: Integer;
  avant: Integer;
  apres: Integer;
begin
  suivant := 0;
  if (not respecterCasse) then
  begin
    terme := LowerCase(terme);
    cible := LowerCase(cible);
  end;
  ind := PosEx(terme, cible, suivant);
  while (ind >= 1) do
  begin
    if (motSeulement) then
    begin
      avant := ind - 1;
      apres := ind + Length(terme);
      if (avant > 0) and (apres > 0)then
      begin
        if (not (espace(cible[avant]) and espace(cible[apres]))) then
        begin
          suivant := ind + Length(terme);
          ind := PosEx(terme, cible, suivant);
          continue;
        end;
      end;
    end;
    Result := true;
    Exit;
  end;
  Result := False;
end;function remplacer(cible, ancienTerme,nouveauTerme: string;
  respecterCasse: Boolean = False; motSeulement: Boolean = False): string;
var
  travail: string;
  ind: Integer;
  suivant: Integer;
  avant: Integer;
  apres: Integer;
begin
  travail := cible;
  suivant := 1;
  if (not respecterCasse) then
  begin
    ancienTerme := LowerCase(ancienTerme);
    travail := LowerCase(cible);
  end;
  ind := PosEx(ancienTerme, travail, suivant);
  while (ind >= 1) do
  begin    if (motSeulement) then
    begin
      avant := ind - 1;
      apres := ind + Length(ancienTerme);
      if (avant > 0) and (apres > 0)then
      begin
        if (not ((espace(travail[avant])) and espace(travail[apres]))) then
        begin
          suivant := ind + Length(ancienTerme);
          ind := PosEx(ancienTerme, travail, suivant);
          continue;
        end;
      end;
    end;
    cible := Copy(cible, 1, ind -1) + nouveauTerme +
Copy(cible, ind + Length(ancienTerme), Length(cible));
    travail := Copy(travail, 1, ind -1) + nouveauTerme +
Copy(travail, ind+Length(ancienTerme),Length(travail));
    suivant := ind + Length(nouveauTerme);
    if (suivant >= Length(travail)) then break;
    ind := PosEx(ancienTerme, travail, suivant);
  end;
  Result := cible;
end;function espace(check: string): Boolean;
var
  esp: string;
  i: Integer;
begin
  Result := True;
//  esp = ' ,/<>?!`'';:%^&()=|beginend;' + '''' + '\\\n\t';
  esp := ' ,/<>?!`'';:%^&()=|beginend;' + '"' + '\'#13#10#9;
  if check = '' then Exit;
  for i := 1 to Length(esp) do
    if check = esp[i] then Exit;
  Result := False;
end;
// STOP HIDING -->var MORSE: array [1..32] of string =
(
  '.-', '-...', '-.-.', '-..', '.', '..-.',
  '--.', '....', '..', '.---', '-.-', '.-..',
  '--', '-.', '---', '.--.', '--.-', '.-.',
  '...', '-', '..-', '...-', '.--', '-..-',
  '-.--', '--..', '-.-..', '--.-.', '----', '.---.', '...-.', '..--'
);var CARACTERES: string = 'ABCDEFGHIJKLMNOPQRSTUVWXYZ[@*]$#';function CODE(LETTRE: string): string;
var
  tg: Integer;
  LT: string;
begin
if(LETTRE = ' ') then
begin
Result := ' ';
    Exit;
end;
for tg := 1 to 32 do
begin
LT := CARACTERES[tg];
if(LT = LETTRE) then
begin
Result := MORSE[tg];
      Exit;
end;
end;
  Result := '';
end;procedure GO(txt: string; var msg: string);
var
  t, num: Integer;
  ltr: Char;
begin
txt := UpperCase(txt);
  msg := '';
NUM := Length(txt);
  t := 1;
while (t <= NUM) do
begin
if (txt[t]= '^') then
begin
      Inc(t);
LTR := txt[t];
case (LTR) of
'C', 'c': LTR := '[';
'G', 'g': LTR := '@'; 
'H', 'h': LTR := '*'; 
'J', 'j': LTR := ']'; 
'S', 's': LTR := '$'; 
'U', 'u': LTR := '#';
end;
end else
begin
LTR := txt[t];
end;
MSG := MSG + ( CODE(LTR) + ' ') ;
    Inc(t);
end;
end;procedure UNGO(txt: string; var msg: string);
var
  th: Integer;
  AA: string;
  BB: string;
begin
txt := UpperCase(txt);
MSG := txt + ' ';
for th := 1 to 32 do
begin
AA := MORSE[th];
BB := CARACTERES[th];
    Msg := remplacer(Msg, AA, BB, False, True);
end;
  Msg := remplacer(Msg, '  ','%');
  Msg := remplacer(Msg, ' ','');
  Msg := remplacer(Msg, '%',' ');
end;end.测试代码如下：
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MosiCode;type
  TForm1 = class(TForm)
    Button1: TButton;
    Edit1: TEdit;
    Memo1: TMemo;
    Memo2: TMemo;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var
 str: string;
begin
  GO(Edit1.text, str);
  Memo1.Text := str;
  UNGO(Memo1.Text, str);
  Memo2.Text := str;
end;end.