program enigma;
type
  rotornode=record
    num:byte;
    left:byte;
    right:byte;
  end;
  rotortype=array[32..256] of rotornode;

var
  rotor:array[1..255] of rotortype;
  mirror:array[32..255] of byte;
  key:array[1..255] of byte;
  document_path,command:string;
  n:byte;

procedure create_rotor;
var
  rotor_out:text;
  used:set of byte;
  i,j,x:byte;
begin
  write('The length of key:>');
  readln(n);
  assign(rotor_out,'rotor.rec');
  rewrite(rotor_out);
  writeln(rotor_out,n);
  for i:=1 to n do
  begin
    used:=[];
    for j:=32 to 255 do
    begin
      repeat
        x:=random(224)+32;
      until not (x in used);
      used:=used+[x];
      write(rotor_out,x,' ');
    end;
    writeln(rotor_out);
  end;
  close(rotor_out);
  writeln('Rotors have been created !');
  writeln('press any key...');
  readln;
end;

procedure read_rotor;
var
  rotor_in:text;
  i,j:byte;
  x:integer;
begin
  assign(rotor_in,'rotor.rec');
  reset(rotor_in);
  readln(rotor_in,n);
  for i:=1 to n do
  begin
    for j:=32 to 255 do
    begin
      read(rotor_in,rotor[i,j].left);
      rotor[i,rotor[i,j].left].right:=j;
      rotor[i,j].num:=j;
    end;
    readln(rotor_in);
  end;
  close(rotor_in);
  x:=32;
  repeat
    mirror[x]:=x+1;
    mirror[x+1]:=x;
    x:=x+2;
  until x>255;
end;

procedure input_key;
var
  tem_rotor:rotortype;
  i,j,top:byte;
  x:char;
begin
  writeln('Input key: (0<=key[i]<=223)');
  for i:=1 to n do
  begin
    write('key[',i,'] :>');
    readln(key[i]);
    key[i]:=key[i]+32;
  end;
  for i:=1 to n do
  begin
    while key[i]<>rotor[i,32].num do
    begin
      for j:=255 downto 32 do rotor[i,j+1]:=rotor[i,j];
      rotor[i,32]:=rotor[i,256];
    end;
  end;
  writeln('press any key...');
  readln;
end;

procedure revolve;
var
  x,i:byte;
begin
  x:=0;
  repeat
    x:=x+1;
    for i:=255 downto 32 do rotor[x,i+1]:=rotor[x,i];
    rotor[x,32]:=rotor[x,256];
  until (rotor[x,32].num<>ord(key[x])) or (x>=n);
end;

procedure save;
var
  tem_file,document:text;
  c:char;
begin
  assign(tem_file,'file.tem');
  assign(document,document_path);
  reset(tem_file);
  rewrite(document);
  repeat
    read(tem_file,c);
    write(document,c);
  until eof(tem_file);
  close(tem_file);
  close(document);
  erase(tem_file);
end;

procedure translate;
var
  document,tem_file,document_bak:text;
  c:char;
  path,i,j:byte;
begin
  write('Input document''s path:>');
  readln(document_path);
  assign(document,document_path);
  assign(document_bak,'document.bak');
  assign(tem_file,'file.tem');
  reset(document);
  rewrite(document_bak);
  rewrite(tem_file);
  repeat
    read(document,c);
    write(document_bak,c);
    if ord(c) in [32..255] then
    begin
      path:=ord(c);
      for i:=1 to n do
        for j:=32 to 255 do
          if rotor[i,path].left=rotor[i,j].num then
          begin
            path:=j;
            break;
          end;
      path:=mirror[path];
      for i:=n downto 1 do
        for j:=32 to 255 do
          if rotor[i,path].right=rotor[i,j].num then
          begin
            path:=j;
            break;
          end;
      write(tem_file,chr(path));
      revolve;
    end
    else write(tem_file,c);
  until eof(document);
  close(document);
  close(document_bak);
  close(tem_file);
  save;
  writeln('Document has been traslated !');
  writeln('press any key...');
  readln;
end;

{main}
begin
  writeln('Welcome to use ENIGMA !');
  writeln('             ----Karl von Donitz');
  write('Command:>');
  readln(command);
  if command='translate' then
  begin
    read_rotor;
    input_key;
    translate;
  end;
  if command='create' then create_rotor;
end.

本代码经过测试可由Free Pascal 1.06编译运行成功！

[url=http://blog.sina.com.cn/u/1077089055]我的BLOG[/url] 上面有这个加密程序的使用方法及下载地址。

ENIGMA的加密原理、研发历史及使用历史大家还可以去 [url=http://www.uboat.cn]德国潜艇战[/url] 上面查看。