jiami.pas

算法为原创哦！ 加密程序 速度较慢 无法破解

program key;
uses sysutils;
type point=^node;
     node = record
        next:point;
        date:char;
     end;
var  path,swap,pass:string;c:integer;
procedure newpink(var head:point;t:string);
var p,q:point;yt:file of char;
begin
assign(yt,t);
reset(yt);
new(head);
head^.next:=nil;
q:=head;
while not eof(yt) do
  begin
    read(yt,q^.date);
    new(p);
    q^.next:=p;
    q:=p;
  end;
  close(yt);
  q^.next:=nil;
end;
procedure print(head:point;t:string);
var p,q:point;yt:text;
begin
assign(yt,t);
rewrite(yt);
q:=head;
while q^.next<>NIl do
  begin
    write(yt,q^.date);
    q:=q^.next;
  end;
close(yt);
end;
procedure sw(head:point;v:string);
var p,q,e:point;l,n,a,n1:integer;s:char;
begin
   q:=head;
   n:=0;
   a:=0;
   while q^.next<>nil do
     begin
       a:=a mod length(v) +1;
       n1:=0;
       p:=q;
       while n1<ord(v[a mod length(v)+1]) do
         begin
           n1:=n1+1;
           if p^.next=nil then p:=head else p:=p^.next;
         end;
       s:=p^.date;
       p^.date:=q^.date;
       q^.date:=s;
       q:=q^.next;
      end;
end;
procedure plus;
var head,q:point;time:tdatetime;mt:text;k,yt:file of char;mm,k1,key1:string;cof,v:char;excel:array[chr(0)..chr(255),1..255] of char;key:array[0..256] of char;len,i,j,j1,x,n,f1:integer;f:array[0..256] of byte;c:byte;
begin
write('原文地址:');
readln(swap);
write('密码:');
readln(pass);
if swap[1]='"' then
begin
  len:=length(swap)-1;
  for i:=2 to len do
     path:=path+swap[i];
end
else path:=swap;
randomize;
for i:=0 to 255 do
  f[i]:=0;
writeln('1.导入密钥');
writeln('2.创建密钥');
write('选择:');
readln(c);
if c=2 then begin
for i:=0 to 255 do
  begin
    x:=random(255-i+1)+1;
    j:=0;
    j1:=-1;
    while j<x do
      begin
      j1:=j1+1;
       while (f[j1]=1)  do
         begin
           j1:=j1+1;
           if j1=256 then j1:=0;
         end;
       j:=j+1;
      end;
    f[j1]:=1;
    key[i]:=chr(j1);
  end;
end
else
  begin
  write('密钥文件:');
  readln(k1);
  key1:='';
  if k1[1]='"' then
    begin
      len:=length(k1)-1;
      for i:=2 to len do
      key1:=key1+k1[i];
    end  else key1:=k1;
  assign(k,key1);
  reset(k);
  for i:=0 to 255 do
    begin
      read(k,key[i]);
    end;
  close(k);
  end;
time:=now;
newpink(head,path);
n:=0;
len:=length(pass);
for v:=chr(0) to chr(255) do
  for j:=1 to len do
    excel[v,j]:=key[(ord(v)+ord(pass[j])) mod 256];
q:=head;
while q^.next<>nil do
  begin
    n:=n mod len + 1;
    q^.date:=excel[q^.date,n];
    q:=q^.next;
  end;
sw(head,pass);
print(head,path+'加密文件.pw');
if c=2 then
  begin
    assign(mt,'c:\密钥.pp');
    rewrite(mt);
    for i:=0 to 255 do
      write(mt,key[i]);
    close(mt);
    writeln('密钥文件已经创建在c盘');
  end;
writeln('总计时间:',(now-time)*86400:3:3,'秒');
end;
procedure minus;
var yt:text;mt,k:file of char;cof:char;key:array[0..256] of char;len,i,j,x,n:integer;key1,k1:string;
begin
randomize;
write('密文地址:');
readln(swap);
write('密钥文件:');
readln(k1);
write('密码:');
readln(pass);
key1:='';
if k1[1]='"' then
begin
  len:=length(k1)-1;
  for i:=2 to len do
    key1:=key1+k1[i];
end
  else key1:=k1;
path:='';
if swap[1]='"' then
begin
  len:=length(swap)-1;
  for i:=2 to len do
    path:=path+swap[i];
end
else path:=swap;
swap:=path;
assign(k,key1);
reset(k);
for i:=0 to 255 do
  begin
  read(k,key[i]);
  end;
close(k);
assign(mt,path);
reset(mt);
j:=0;
swap:=path;
path:='';
len:=length(swap)-11;
for i:=1 to len do
  path:=path+swap[i];
assign(yt,path);
rewrite(yt);
len:=length(pass);
while not eof(mt) do
  begin
    i:=0;
    read(mt,cof);
    while (key[i]<>cof) and (i<255) do
       i:=i+1;
    cof:=chr(i);
    j:=j mod len +1;
  cof:=chr((ord(cof)-ord(pass[j])+256) mod 256);
    write(yt,cof);
  end;
close(yt);
close(mt);
end;

begin
repeat
writeln('0.退出');
writeln('1.加密文件');
writeln('2.解密文件');
write('选择:');
readln(c);
if c=1 then begin;
  plus; writeln('加密文件完成!'); end else if c=2 then begin minus; writeln('解密文件完成!'); end else if c=0 then exit;
path:='';
swap:='';
path:='';
until FALSE;
end.