Fórum Criptografia de Senhas!#@amp;*$¨@ #174406

{ LISTAGEM DO PROGRAMA }


{$A+,B-,D+,E-,F-,G+,I+,L+,N-,O-,R-,S-,V+,X-}
{$M 10000,0,30000}
PROGRAM METODO_PES;
  { Este programa implementa a funcao PES (proposta por Lai & Massey
    em 1990), para criptografacao e decriptografacao de dados.  Esta
    funcao foi implementada em modo CBC (Chaining Block Cipher).
    Autor: Glauber Cintra - 19Out1993
    Disciplina: Introducao a Criptologia - IME-USP }

USES CRT,DOS,ROTTELA1;       { a unit ROTTELA1 contem rotinas para
                               manipulacao de janelas }
TYPE TIPO=1..2;
     VETOR=ARRAY [1..8] OF WORD;

     BLOCO=ARRAY [1..4] OF WORD;   { Tipo do bloco submetido ao PES }

     BLOCOAUX=RECORD CASE TIPO OF
                     1:(CODIGO:BLOCO);
                     2:(BYTE:ARRAY [1..8] OF BYTE);
              END;

     KEY=RECORD CASE TIPO OF                        { Tipo da CHAVE }
                1:(SENHA:STRING[16]);
                2:(SUBKEY:RECORD LIXO:CHAR;
                                 NUM:VETOR;
                          END);
         END;
     ARQ=FILE OF BLOCO; {Tipo do arquivo criptografado/decriptografado}

     VETOR_CHAVES=ARRAY [1..9,1..6] OF WORD;     { Matriz contendo as
                                        as subchaves usadas pelo PES }

VAR OPCAO,TECLA : CHAR;                       { Variaveis auxiliares }
    ARQENTRADA,                                 { Arquivo de entrada }
    ARQSAIDA : ARQ;                                { Arquivo de saida}
    CHAVE:KEY;                                    { Chave para o PES }
    TELA_INICIAL,TELA:PONT_TELA; {Variaveis p/ utilizacao de janelas }
    ARQAUXE,ARQAUXS : FILE OF BYTE;
    POSX,POSY : BYTE;


FUNCTION REPLICATE(LETRA:CHAR;VEZES:BYTE):STRING;
  { Devolve uma string contendo VEZES copias de LETRA }
  VAR CADEIA:STRING;  I:BYTE;
  BEGIN
  CADEIA:=´´;
  FOR I:=1 TO VEZES DO CADEIA:=CADEIA+LETRA;
  REPLICATE:=CADEIA
  END; { Replicate }


FUNCTION TEMPO:LONGINT;
  { Devolve o horario corrente convertido em centesimos }
  VAR HORA,MINUTO,SEGUNDO,CENTESIMO : WORD;
  BEGIN
  GETTIME(HORA,MINUTO,SEGUNDO,CENTESIMO);
  TEMPO:=CENTESIMO+SEGUNDO*100+LONGINT(MINUTO)*6000+LONGINT(HORA)*360000;
  END; { Tempo }


PROCEDURE GERA_CHAVES(CHAVE:KEY;VAR CHAVES_GERADAS:VETOR_CHAVES);
  { Devolve as subchaves usadas no PES ou na INVERSA dos PES }
  VAR I,J,K:BYTE;
      CHAVES_AUX:VETOR_CHAVES;


  PROCEDURE ROTACIONA_CHAVE_ESQ(VAR CHAVE:KEY);
    { Faz um shift-left-circular de 25 posicoes na CHAVE }
    VAR I,AUX1,AUX2:WORD;
    BEGIN
    AUX1:=(CHAVE.SUBKEY.NUM[8] SHL 9)+(CHAVE.SUBKEY.NUM[1] SHR 7);
    AUX2:=(CHAVE.SUBKEY.NUM[1] SHL 9)+(CHAVE.SUBKEY.NUM[2] SHR 7);
    FOR I:=1 TO 8 DO
      IF I<7 THEN
        CHAVE.SUBKEY.NUM[I]:=(CHAVE.SUBKEY.NUM[I+1] SHL 9)
                            +(CHAVE.SUBKEY.NUM[I+2] SHR 7)
      ELSE
        IF I=7 THEN
          CHAVE.SUBKEY.NUM[I]:=AUX1
        ELSE
          CHAVE.SUBKEY.NUM[I]:=AUX2;
    END; { Rotaciona_Chave_Esq }

  FUNCTION INV_MULT(CHAVE:WORD):WORD;
    { Calcula a inversa multiplicativa modulo 65537 de CHAVE
      usando o Algoritmo de Euclides }
    VAR G1,G2,G3,V1,V2,V3,X,Y:LONGINT;
    BEGIN
    G1:=65537;G2:=CHAVE;
    V1:=0;V2:=1;
    WHILE G2<>0 DO
      BEGIN
      Y:=G1 DIV G2;
      G3:=G1-(Y*G2);
      V3:=V1-(Y*V2);
      G1:=G2;G2:=G3;
      V1:=V2;V2:=V3
      END;
    X:=V1;
    IF X<0 THEN
      X:=X+65537;
    INV_MULT:=X
    END; { Inv_Mult }

  BEGIN
  K:=1;
  FOR I:=1 TO 7 DO
    BEGIN
    FOR J:=1 TO 8 DO
      BEGIN
      IF K<=52 THEN
        CHAVES_GERADAS[((K-1) DIV 6)+1][((K-1) MOD 6)+1]:=
                                       CHAVE.SUBKEY.NUM[J];
      INC(K)
      END;
    ROTACIONA_CHAVE_ESQ(CHAVE);
    END;

  { Calculando as subchaves para a Inversa do PES }

  IF OPCAO=´D´ THEN
    BEGIN
    CHAVES_AUX:=CHAVES_GERADAS;
    FOR I:=1 TO 9 DO
      BEGIN
      CHAVES_GERADAS[I][1]:=INV_MULT(CHAVES_AUX[10-I][1]);
      CHAVES_GERADAS[I][2]:=INV_MULT(CHAVES_AUX[10-I][2]);
      CHAVES_GERADAS[I][3]:=(NOT CHAVES_AUX[10-I][3])+1;   { Calcula a
                                         Inversa Aditiva modulo 65536 }
      CHAVES_GERADAS[I][4]:=(NOT CHAVES_AUX[10-I][4])+1;   { Calcula a
                                         Inversa Aditiva modulo 65536 }
      CHAVES_GERADAS[I][5]:=CHAVES_AUX[9-I][5];
      CHAVES_GERADAS[I][6]:=CHAVES_AUX[9-I][6]
      END;
    END;
  END; { Gera_Chaves }


PROCEDURE PES(MENSAGEM:BLOCO;VAR CODIGO:BLOCO;CHAVES:VETOR_CHAVES);
  { Devolve CODIGO que e´ a MENSAGEM depois de passar pela funcao PES }
  VAR I:BYTE;
      AUX:BLOCO;
      AUX1,AUX2:WORD;

  FUNCTION MULT_MODULO_65537(A,B:WORD):WORD;
    { Executa a multiplicacao modulo 65537 de A e B }
    VAR C,D:WORD;
    BEGIN
    C:=A*B;                                { C recebe A*B mod 65536 }
    D:=(LONGINT(A)*B SHR 16);              { D recebe A*B div 65536 }
    IF (A=0) AND (B=0) THEN
      MULT_MODULO_65537:=0
    ELSE
      IF A=0 THEN
        MULT_MODULO_65537:=65537-B
      ELSE
        IF B=0 THEN
          MULT_MODULO_65537:=65537-A
        ELSE
          IF C>=D THEN
            MULT_MODULO_65537:=C-D
          ELSE
            MULT_MODULO_65537:=C-D+65537
    END; { Mult_modulo_65537 }

  BEGIN
  FOR I:=1 TO 8 DO        { Rounds }
    BEGIN
    AUX[1]:=MULT_MODULO_65537(MENSAGEM[1],CHAVES[I][1]);
    AUX[2]:=MULT_MODULO_65537(MENSAGEM[2],CHAVES[I][2]);
    AUX[3]:=MENSAGEM[3]+CHAVES[I][3];
    AUX[4]:=MENSAGEM[4]+CHAVES[I][4];
    AUX1:=MULT_MODULO_65537(AUX[1] XOR AUX[3],CHAVES[I][5]);
    AUX2:=MULT_MODULO_65537((AUX[2] XOR AUX[4])+AUX1,CHAVES[I][6]);
    AUX1:=AUX1+AUX2;
    MENSAGEM[1]:=AUX2 XOR AUX[3];
    MENSAGEM[2]:=AUX1 XOR AUX[4];
    MENSAGEM[3]:=AUX2 XOR AUX[1];
    MENSAGEM[4]:=AUX1 XOR AUX[2]
    END;

  { Permutacao Final }

  CODIGO[1]:=MULT_MODULO_65537(MENSAGEM[1],CHAVES[9][1]);
  CODIGO[2]:=MULT_MODULO_65537(MENSAGEM[2],CHAVES[9][2]);
  CODIGO[3]:=MENSAGEM[3]+CHAVES[9][3];
  CODIGO[4]:=MENSAGEM[4]+CHAVES[9][4];
  END; { Pes }


PROCEDURE TRANSFORMA(VAR ARQENTRADA,ARQSAIDA:ARQ;CHAVE:KEY;OPCAO:CHAR;
                     TAMANHO:LONGINT);
  { Este procedimento le o ARQENTRADA em blocos de 64 bits, e submete
    estes bloco para o PES/Inversa do PES, guardando o resultado em
    ARQSAIDA }
  VAR MENSAGEM,CODIGO,MENSANTERIOR: BLOCO;
      CHAVES_GERADAS:VETOR_CHAVES;
      MENSAUX:BLOCOAUX;
      POSICAO:LONGINT;
      REG:BLOCO;
      I:BYTE;
  BEGIN
  IF OPCAO=´C´ THEN { Guarda o tamanho de ARQENTRADA na criptografacao }
    BEGIN
    REG[1]:=TAMANHO SHR 16;
    REG[2]:=TAMANHO;
    WRITE(ARQSAIDA,REG)
    END
  ELSE                { Le o tamanho de ARQENTRADA na decriptografacao }
    BEGIN
    READ(ARQENTRADA,REG);
    TAMANHO:=LONGINT(REG[1])*65536+REG[2];
    END;
  FOR I:=1 TO 4 DO            { Inicializa o primeiro bloco para o CBC }
    MENSANTERIOR[I]:=0;
  GERA_CHAVES(CHAVE,CHAVES_GERADAS);       { Gera as chaves para o PES }

  { Laco que para ler todo o ARQENTRADA }

  WHILE TAMANHO>0 DO
    BEGIN

    { Le um bloco de 64 bits }

    IF (TAMANHO<8) AND (OPCAO=´C´) THEN
      BEGIN
      POSICAO:=FILEPOS(ARQENTRADA)*8;
      CLOSE(ARQENTRADA);
      RESET(ARQAUXE);
      SEEK(ARQAUXE,POSICAO);
      FOR I:=1 TO TAMANHO DO
        READ(ARQAUXE,MENSAUX.BYTE[I]);
      MENSAGEM:=MENSAUX.CODIGO;
      CLOSE(ARQAUXE);
      RESET(ARQENTRADA)
      END
    ELSE
      READ(ARQENTRADA,MENSAGEM);

    { Na criptografacao faz um XOR da mensagem com o codigo anterior }

    IF OPCAO=´C´ THEN
      FOR I:=1 TO 4 DO
        MENSAGEM[I]:=MENSAGEM[I] XOR MENSANTERIOR[I];

    PES(MENSAGEM,CODIGO,CHAVES_GERADAS);   { Submete MENSAGEM ao PES }


    IF OPCAO=´C´ THEN                  { Atualiza o bloco para o CBC }
      MENSANTERIOR:=CODIGO
    ELSE    { Na decriptografacao faz um XOR do CODIGO com a mensagem
              da iteracao anterior, e atualiza o bloco para o CBC    }
      BEGIN
      FOR I:=1 TO 4 DO
        CODIGO[I]:=CODIGO[I] XOR MENSANTERIOR[I];
      MENSANTERIOR:=MENSAGEM
      END;

    { Grava o resultado do PES em ARQSAIDA }

    IF (TAMANHO<8) AND (OPCAO=´D´) THEN
      BEGIN
      CLOSE(ARQSAIDA);
      RESET(ARQAUXS);
      SEEK(ARQAUXS,FILESIZE(ARQAUXS));
      MENSAUX.CODIGO:=CODIGO;
      FOR I:=1 TO TAMANHO DO
        WRITE(ARQAUXS,MENSAUX.BYTE[I]);
      CLOSE(ARQAUXS);
      RESET(ARQSAIDA)
      END
    ELSE
      WRITE(ARQSAIDA,CODIGO);
    DEC(TAMANHO,8)
    END
  END; { Transforma }


PROCEDURE PROCESSA(OPCAO:CHAR);
  { Le o nome do arquivo de entrada e do arquivo de saida e a chave,
    e os submete ao procedimento TRANSFORMA. Depois, se solicitado,
    apaga o arquivo de entrada }
  VAR ARQE,ARQS,ESPACO,SENHA:STRING;
      INICIO,FIM,TAMANHO:LONGINT;
      APAGA:CHAR;
      I,X:BYTE;
      ZERO:BLOCO;

 BEGIN

  { Criacao da Tela }

  JANELA(14,19,17,1,24,80,3,60,15,7);
  IF OPCAO=´C´ THEN
    BEGIN
    GOTOXY(33,18);
    WRITELN(´CRIPTOGRAFACAO´)
    END
  ELSE
    BEGIN
    GOTOXY(32,18);
    WRITELN(´DECRIPTOGRAFACAO´)
    END;
  GOTOXY(3,19);
  WRITE(´Arquivo Origem :´);
  GOTOXY(3,20);
  WRITE(´Arquivo Destino:´);
  GOTOXY(3,21);
  WRITE(´Deseja deletar o Arquivo Origem (S/N): ´);
  GOTOXY(20,19);
  READLN(ARQE);                         { Lendo o arquivo de entrada }
  IF ARQE<>´´ THEN
    BEGIN
    {$I-}
    ASSIGN(ARQENTRADA,ARQE);          
    ASSIGN(ARQAUXE,ARQE);
    RESET(ARQAUXE);                   { Abertura do arquivo de entrada }

    IF IORESULT=0 THEN { Verifica se abertura de ARQE foi bem sucedida }
      BEGIN
      GOTOXY(20,20);
      READLN(ARQS);                         { Lendo o arquivo de saida }

      IF (FSEARCH(ARQS,´´)<>´´) THEN     { Verifica se ARQS ja´ existe }
        BEGIN
        GOTOXY(3,22);
        WRITE(7´O arquivo ´,arqs,´ ja existe. Deseja escrever ´,
               ´por cima (S/N):´);
        X:=WHEREX;
        REPEAT
          GOTOXY(X,22);
          TECLA:=UPCASE(READKEY);
          WRITE(TECLA)
        UNTIL (TECLA=´S´) OR (TECLA=´N´);
        GOTOXY(3,22);
        WRITE(REPLICATE(´ ´,76))
        END
      ELSE
        TECLA:=´S´;
      TAMANHO:=FILESIZE(ARQAUXE);
      CLOSE(ARQAUXE);
      RESET(ARQENTRADA);
      IF TECLA=´S´ THEN
        BEGIN
        ASSIGN(ARQSAIDA,ARQS);
        ASSIGN(ARQAUXS,ARQS);
        REWRITE(ARQSAIDA)                { Abertura do arquivo de saida }
        END;

      { Verifica se abertura de ARQS foi bem sucedida }

      IF (IORESULT=0) AND (ARQS<>´´) AND (TECLA=´S´) THEN
      
        BEGIN

        REPEAT { Pergunta se o usuario deseja apagar o arquivo de entrada }
          GOTOXY(42,21);
          APAGA:=UPCASE(READKEY);
          WRITE(APAGA)
        UNTIL (APAGA=´S´) OR (APAGA=´N´);

        GOTOXY(3,22);
        WRITE(´Digite a Chave (16 posicoes): ´);

        REPEAT                                            { Le a CHAVE }
          GOTOXY(33,22);
          WRITE(REPLICATE(´ ´,45));
          GOTOXY(33,22);
          READLN(SENHA);
        UNTIL LENGTH(SENHA)=16;
        CHAVE.SENHA:=SENHA;

        GOTOXY(3,23);
        WRITE(´Aguarde...´);
        INICIO:=TEMPO;

        TRANSFORMA(ARQENTRADA,ARQSAIDA,CHAVE,OPCAO,TAMANHO);

        FIM:=TEMPO;

        { Calcula o tempo gasto }

        WRITE(´    Tempo gasto: ´,(FIM-INICIO) DIV 100,
              ´ Segundos. Aperte qualquer tecla...´);

        { Apaga o arquivo de entrada, se solicitado }

        IF APAGA=´S´ THEN
          BEGIN
          TAMANHO:=FILESIZE(ARQENTRADA);
          CLOSE(ARQENTRADA);
          REWRITE(ARQENTRADA);
          FOR I:=1 TO TAMANHO DO
            WRITE(ARQENTRADA,ZERO);
          CLOSE(ARQENTRADA);
          CLOSE(ARQSAIDA);
          SWAPVECTORS;
          EXEC(GETENV(´COMSPEC´),´/C DEL ´+ARQE);
          SWAPVECTORS
          END
        ELSE
          BEGIN
          CLOSE(ARQENTRADA);
          CLOSE(ARQSAIDA);
          END;
        TECLA:=READKEY
        END
      ELSE
        BEGIN
        IF IORESULT<>0 THEN
          BEGIN
          GOTOXY(3,23);
          WRITE(7´Nao foi possivel abrir o arquivo ´,arqs,
                ´. Aperte qualquer tecla...´);
          TECLA:=READKEY
          END;
        CLOSE(ARQENTRADA);
        END;
      END
    ELSE
      BEGIN
      GOTOXY(3,23);
      WRITE(7´Nao foi possivel abrir o arquivo ´,arqe,
            ´. Aperte qualquer tecla...´);
      TECLA:=READKEY
      END;
    {$I+};
    END;
  FJANELA(14,19,17,1,24,80,3,60,14,1)
  END; { Processa }


PROCEDURE IMPRIMA;
  { Imprime ou mostra na tela um arquivo, em modo ASCII ou HEXADECIMAL }
  VAR COLUNA : BYTE;
      DIGITOS:STRING;
      ARQE,ARQS:STRING;
      I,TAMANHO:LONGINT;
      LETRA,DISP,MODO:CHAR;
      ARQENTRADA,ARQSAIDA:TEXT;

  FUNCTION HEXA(LETRA:CHAR):STRING;
    { Retorna o valor de LETRA em HEXADECIMAL }
    VAR VALOR:BYTE;
    BEGIN
    VALOR:=ORD(LETRA);
    HEXA:=DIGITOS[(VALOR SHR 4)+1]+DIGITOS[(VALOR MOD 16)+1]
    END; { Hexa }

  BEGIN

  { Criacao da Tela }

  JANELA(14,19,17,1,24,80,3,60,15,7);
  GOTOXY(3,19);
  WRITE(´Arquivo a ser Impresso:´);
  GOTOXY(27,19);
  READLN(ARQE);                         { Le o arquivo a ser impresso }
  {$I-}
  ASSIGN(ARQENTRADA,ARQE);
  RESET(ARQENTRADA);                  { Abertura do arquivo de entrada }
  DIGITOS:=´0123456789ABCDEF´;

  IF IORESULT<>0 THEN  { Verifica se abertura de ARQE foi bem sucedida }
    BEGIN
    GOTOXY(3,21);
    WRITE(7´O arquivo ´,arqe,´ nao pode ser aberto. ´);
    WRITE(´Tecle algo para continuar...´);
    TECLA:=READKEY
    END
  ELSE
    BEGIN
    GOTOXY(3,20);
    WRITE(´Tela ou Impressora (T/I):´);
    GOTOXY(3,21);
    WRITE(´ASCII ou HEXADECIMAL (A/H):´);

    REPEAT                  { Determina se arquivo vai ser impresso ou
                                                      mostrado na tela }
      GOTOXY(29,20);
      DISP:=UPCASE(READKEY);
      WRITE(DISP)
    UNTIL (DISP=´T´) OR (DISP=´I´);

    REPEAT                 { Determina o tipo da Saida (ASCII ou HEXA) }
      GOTOXY(31,21);
      MODO:=UPCASE(READKEY);
      WRITE(MODO)
    UNTIL (MODO=´A´) OR (MODO=´H´);

    IF DISP=´T´ THEN
      ARQS:=´CON´
    ELSE
      ARQS:=´PRN´;
    ASSIGN(ARQSAIDA,ARQS);
    REWRITE(ARQSAIDA);                 { Abertura do arquivo de saida }
    {$I+}
    IF IORESULT<>0 THEN { Verifica se abertura de ARQS foi bem sucedida }
      BEGIN
      GOTOXY(3,21);
      WRITE(7´O arquivo ´,arqs,´ nao pode ser aberto. ´);
      WRITE(´Tecle algo para continuar...´);
      TECLA:=READKEY
      END
    ELSE
      BEGIN
      IF DISP=´T´ THEN
        BEGIN
        SALVA_TELA(TELA);
        TEXTCOLOR(7);TEXTBACKGROUND(0);
        CLRSCR
        END
      ELSE
        BEGIN
        GOTOXY(3,22);
        WRITE(´Aguarde impressao...´)
        END;
      CLOSE(ARQENTRADA);
      ASSIGN(ARQAUXE,ARQE);
      RESET(ARQAUXE);
      TAMANHO:=FILESIZE(ARQAUXE);
      CLOSE(ARQAUXE);
      RESET(ARQENTRADA);
      COLUNA:=1;

      FOR I:=1 TO TAMANHO DO        { Laco para impressao do arquivo }
        BEGIN
        READ(ARQENTRADA,LETRA);
        IF MODO=´A´ THEN
          WRITE(ARQSAIDA,LETRA)
        ELSE
          BEGIN
          WRITE(ARQSAIDA,HEXA(LETRA),32);
          IF COLUNA>72 THEN
            BEGIN
            COLUNA:=1;
            WRITE(ARQSAIDA,1310)
            END
          ELSE
            INC(COLUNA,3);
          END;
        IF (DISP=´T´) AND (WHEREY=24) THEN
          BEGIN
          GOTOXY(1,25);
          WRITE(´Aperte qualquer tecla para continuar...´);
          TECLA:=READKEY;
          CLRSCR
          END;
        END;
      CLOSE(ARQSAIDA)
      END;
    IF DISP=´T´ THEN
      BEGIN
      GOTOXY(1,25);
      WRITE(´Final da impressao. Aperte qualquer tecla para continuar...´);
      TECLA:=READKEY;
      RESTAURA_TELA(TELA);
      DISPOSE(TELA)
      END;
    CLOSE(ARQENTRADA)
    END;
  {$I+}
  FJANELA(14,19,17,1,24,80,3,60,14,1)
  END; { Imprima }


{ Programa Principal }

BEGIN

{ Tela de Abertura }

POSX:=WHEREX;
POSY:=WHEREY;
SALVA_TELA(TELA_INICIAL);
CLRSCR;
JANELA(1,1,1,10,7,71,1,60,15,3);
GOTOXY(25,2);
WRITE(´CRIPTOGRAFADOR-DECRIPTOGRAFADOR´);
GOTOXY(12,3);
WRITE(´Utilizando a funcao PES [proposta por Lai & Massey - 1990]´);
GOTOXY(23,4);
WRITE(´(Em modo CBC - Chaining Block Cipher)´);
GOTOXY(19,5);
WRITE(´Implementado por: Glauber Cintra - 19Out1993´);
GOTOXY(18,6);
WRITE(´Disciplina: Introducao a Criptologia - IME-USP´);
JANELA(1,80,9,29,15,50,2,60,14,1);
GOTOXY(31,10);
WRITE(´C - Criptografar´);
GOTOXY(31,11);
WRITE(´D - Decriptografar´);
GOTOXY(31,12);
WRITE(´I - Imprimir ´);
GOTOXY(31,13);
WRITE(´S - Saida´);
GOTOXY(36,14);
WRITELN(´Opcao: ´);

{ Laco do menu principal }

REPEAT
  GOTOXY(43,14);
  OPCAO:=UPCASE(READKEY);
  WRITE(OPCAO);
  IF (OPCAO=´C´) OR (OPCAO=´D´) THEN
    PROCESSA(OPCAO)
    ELSE
    IF OPCAO=´I´ THEN
      IMPRIMA;
UNTIL (OPCAO=´S´) OR (OPCAO=27);

FJANELA(1,80,9,29,15,50,2,60,15,3);
FJANELA(1,1,1,10,7,71,1,60,7,0);
RESTAURA_TELA(TELA_INICIAL);
GOTOXY(POSX,POSY)
END. { Pes }