[Back to ENCRYPT SWAG index] [Back to Main SWAG index] [Original]

    {
    Here you have an encriptation program based in Xor encription by
    bits manipulation

    XOR        1101  1001   the origin file
               0101  0011   Password      Encription
             _____________                ^^
               1000  1010

    XOR        1000  1010   the destination file
               0101  0011   Password       decryption
            --------------                 ^^
               1101  1001

    I recommend you to read the book "Advanced Turbo Pascal: Programming and
    Techniques"  of Herbert Schildt (1987)
    (The book i read)
    }

          PROGRAM Clave;
          {    Por: JAVIER PEREZ-VIGO FDEZ  6/01/1994          }
          {    Codifica y descodifica ficheros mediante un XOR }
          USES CRT;
          VAR
             Fuente,Destino:     FILE;
             Ma,Mo:              CHAR;
             Buffer:             ARRAY[1..2048] of byte;
             Leidos,f,a,b,c,d,Largo1,Largo2,Largo3:   INTEGER;
             ch:char;
             Par1,Par2,Par3:     STRING;

          FUNCTION EXISTE_ARCH(Nombre:STRING):BOOLEAN;
             VAR
               F:FILE;
               OK:BOOLEAN;
             BEGIN            { Existe_Arch }
               Assign (f,Nombre);
               {$I-}                              {Exists file?}
               Reset(f);
               {$I+}
               OK:=IOresult=0;
               If Not OK then
                  Existe_Arch:=False
                else
                  begin
                    close(f);
                    existe_Arch:=True;
                  end;        { else }
             END;             { Existe_Arch }

          PROCEDURE MENU;
            BEGIN             { Menu }
             Clrscr;
             TextColor(white);
             GotoXY( 1, 1);Write('ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»');
             GotoXY( 1, 2);Write('º       ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»    º');
             GotoXY( 1, 3);Write('º       º           UTILIDAD DE ENCRIPACION / DESENCRIPTACION             º    º');
             GotoXY( 1, 4);Write('º       º Por: Javier P�rez-Vigo 1993                                     º    º');
             GotoXY( 1, 5);Write('º       ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼    º');
             GotoXY( 1, 6);Write('º                                                                              º');
             GotoXY( 1, 7);Write('º       ÉÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ»    º');
             GotoXY( 1, 8);Write('º       º ùNombre del archivo a des/encriptar :                           º    º');
                                      {Name of the file to de/encript}

             GotoXY(60,8);TextColor(red);Write('? ');
             GotoXY(60,8);TextColor(red);Write(Paramstr(1));
             TextColor(white);
             GotoXY( 1, 9);Write('º       º                                                                 º    º');
             GotoXY( 1,10);Write('º       º ùNombre del archivo des/encriptado  :                           º    º');

                                      {Name of the to de/encripted file}

             GotoXY(60,10);TextColor(red);Write('? ');
             GotoXY(60,10);TextColor(red);Write(paramstr(2));
             TextColor(white);
             GotoXY( 1,11);Write('º       º                                                                 º    º');
             GotoXY( 1,12);Write('º       º ùClave de encriptaci¢n:                                         º    º');
                                        {Password}

             GotoXY(60,12);TextColor(red);Write('? ');
             GotoXY(60,12);TextColor(red);Write(paramstr(3));
             TextColor(white);
             GotoXY( 1,13);Write('º       º                                                                 º    º');
             GotoXY( 1,14);Write('º       ÌÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¹    º');
             GotoXY( 1,15);Write('º       º                                                                 º    º');
             GotoXY( 1,16);Write('º       ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼    º');
             GotoXY( 1,17);Write('º                                                                              º');
             GotoXY( 1,18);Write('º                                                                              º');
             GotoXY( 1,19);Write('º                                                                              º');
             GotoXY( 1,20);Write('º                                                                              º');
             GotoXY( 1,21);Write('º                                                                              º');
             GotoXY( 1,22);Write('ÈÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍÍ¼');
    END;
         PROCEDURE FIN;
           BEGIN
             MENU;
             TextColor(YELLOW);           {Clave [origin] [destination] [password number] }
             GotoXY( 6,17);
             WriteLn ('                    Clave  [origen]    [destino]   [n§ clave]');
             TextColor(RED);
             GotoXY( 6,18);
             WriteLn('=======================================');
             TextColor(YELLOW);
             GotoXY( 6,19);
             WriteLn ('     ENCRIPTAR:     Clave  texto.doc   secret.doc  12345');
             GotoXY( 6,20);
             WriteLn ('     DESENCRIPTAR:  Clave  secret.doc  texto.txt   12345');
           END;

        BEGIN  { Programa Principal }   {Main}
            Clrscr;
            Largo1:=LENGTH(Paramstr(1));
            Largo2:=LENGTH(Paramstr(2));
            Largo3:=LENGTH(Paramstr(3));
            If (Largo1 =0) OR (Largo2=0) OR (Largo3=0) then
               Begin
                 Clrscr;
                 FIN;
                 Par1:='';Par2:='';Par3:='';
                 if largo1=0 then Par1:=' ORIGEN,';
                 if largo2=0 then Par2:=' DESTINO,';
                 if largo3=0 then Par3:=' CLAVE';
                 GotoXY(10,15);
                 TextColor(red);
                 Write(' � Introduzca los par�metros � :   ',PAR1,PAR2,PAR3);

                                            {introduce the parameters}

                 TextColor(WHITE);
                 GotoXY(1,24);
                 Halt(0);
               End;
            If Paramstr(1)=Paramstr(2) Then
               begin;
                  Fin;
                  GotoXY(10,15);
                  TextColor(RED);
                  Write(' � Introduzca distintos ficheros ORIGEN y DESTINO ! ');
                  TextColor(WHITE);

                   {origin and destination are the same file}

                  GotoXY(1,24);
                  Halt(1);
               end;

           ASSIGN (FUENTE,PARAMSTR(1));
           if existe_arch (paramstr(1)) then
             RESET (FUENTE,1)
           else
             BEGIN
               Clrscr;
               FIN;
               GotoXY(10,15);
               TextColor(RED);
               Write(' � No existe el fichero ORIGEN ! ');

               {The origin file don't exist}

               TextColor(WHITE);
               GotoXY(1,24);
               Halt(2);
             END;
           ASSIGN (DESTINO,PARAMSTR(2));
           if existe_arch (paramstr(2)) then
               BEGIN
                 Clrscr;
                 MENU;
                 GotoXY(9,18);
                 TextColor(LightGreen);
                 Write('El archivo destino  < ');
                 TextColor(LightRed);

                 {if destination file exist}

                 Write(PARAMSTR(2));
                 TextColor(LightGreen);
                 Write(' > existe');
                 GotoXY(9,20);
                 Write('¨ Quiere SOBREESCRIBIRLO ? ');

                 {rewrite it?}

                 TextColor(LightRed);
                 write(' (S/N) ');
                 TextColor(White);
                 Ch := ReadKey;
                 TextColor(White);
                 if Upcase(Ch) <> 'S'  then
                   begin
                     Close(fuente);
                     Clrscr;
                     FIN;
                     GotoXY(10,15);
                     TextColor(Red);
                     Write(' � Escriba un nuevo nombre de fichero DESTINO !');
                     TextColor(White);

                     {write a new name for destination file}

                     GotoXY(1,24);
                     Halt(3);
                   end;
              END;

            ReWrite(DESTINO,1);
            VAL(Paramstr(3),RANDSEED,F);
            Clrscr;
            MENU;
            GotoXY(10,15);
            TextColor(Blue);
            Write('==>');
            a:=1;
            TextColor(Red);
            REPEAT
              BlockRead(FUENTE,BUFFER,SIZEOF(BUFFER),LEIDOS);
              FOR F:=1 TO LEIDOS DO
                 Buffer[F] := Buffer[F] XOR RANDOM(255);
                 TextColor((a div 60)+1);
                 Write('Þ');
                 a:=a+1;
                 if  (a mod 60 =0)  then GotoXY(13,15);
              BlockWrite(DESTINO,BUFFER,LEIDOS);
            UNTIL (LEIDOS=0);
            CLOSE (FUENTE);
            CLOSE (DESTINO);
            TextColor(White);
            WriteLn;
            WriteLn;
            WriteLn;
            GotoXY(1,24);
            Halt(4)
          END.

[Back to ENCRYPT SWAG index] [Back to Main SWAG index] [Original]