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

[jackie168]

如题~~

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

[jackie168]

找到了个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.value

text = text.toUpperCase()

var MSG = ""

var LTR = ""

NUM = text.length





for(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.value

text = 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>

[postren]

关注先

[postren]

翻译代码如下：（未经严格测试）

unit MosiCode;

interface

uses
SysUtils, StrUtils;

function espace(check: string): Boolean;
procedure GO(txt: string; var msg: string);
procedure UNGO(txt: string; var msg: string);

implementation

var 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;

interface

uses
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.

[jackie168]

感谢小虫老大~~~

[yyjzsl]

好长哦

翻译麻烦...

[lexchou]

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

[wudi_1982]

明天起来看。