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

    {
    I want to let you see a program I made to criptate binary and
    text files... it just traslate ALL THE FILE of a bit to right,
    then adds the old extension to the start of the file, followed by
    a (eof) #26... try it and tell me what do you think!

    I you have something to suggest... i'm here!... for example how
    to add a password to coded files, how to increase the speed of
    the program and so on...

    Sorry for my english :-) }

    program NCode;

    {FREEWARE! 1996, Emidio Spinogatti (2:335/622.18@fidonet)}

    uses dos;

    var
      f1, f2: file of byte;
      DirInfo: SearchRec;
      P: PathStr;
      D: DirStr;
      N: NameStr;
      E: ExtStr;

    procedure code;
    const eofile:byte=26;
    var
      b, LByte, SByte: byte;
      ctrl_bit: boolean;
    begin
      writeln('CODIFICA IN CORSO...');
      assign(f1, paramstr(1)); assign(f2, n+'.cod');
      reset(f1); rewrite(f2);
      b:=ord(e[2]); LByte:=ord(e[3]); SByte:=ord(e[4]);
      write(f2, b, LByte, SByte, eofile); {INTESTAZIONE DEL FILE}

      {LEGGE L'ULTIMO BIT E LO SALVA IN CTRL_BIT} seek(f1, filesize(f1)-1);
      read(f1, b); if ((b or 1) = b) then ctrl_bit:=true
                                     else ctrl_bit:=false;

      {TORNA ALL'INIZIO DEL FILE} seek(f1, 0);

      repeat
        write(#13, round((filepos(f1)+1)/filesize(f1)*100), '%');
        read(f1, LByte);

        if ctrl_bit then SByte:=128
                    else SByte:=0;
        if (LByte or 128)=LByte then SByte:=SByte+064;
        if (LByte or 064)=LByte then SByte:=SByte+032;
        if (LByte or 032)=LByte then SByte:=SByte+016;
        if (LByte or 016)=LByte then SByte:=SByte+008;
        if (LByte or 008)=LByte then SByte:=SByte+004;
        if (LByte or 004)=LByte then SByte:=SByte+002;
        if (LByte or 002)=LByte then SByte:=SByte+001;

        write(f2, SByte);

        if ((LByte or 1) = LByte) then ctrl_bit:=true
                                  else ctrl_bit:=false;

      until eof(f1);

      close(f2); close(f1);
    end;

    procedure decode;
    var
      Hold_Bit, Ctrl_Bit: boolean;
      LByte, b, SByte: byte;
    begin
    writeln('DECODIFICA IN CORSO...');

      assign(f1, paramstr(1)); reset(f1);

      read(f1, LByte, b, SByte); {LETTURA INTESTAZIONE DEL FILE}
      e:='.'+chr(LByte)+chr(b)+chr(SByte);
      assign(f2, n+e); rewrite(f2);

      read(f1, LByte); {LETTURA EOF 4ø CARATTERE}

      read(f1, LByte); {PRIMO BYTE "SIGNIFICATIVO"}

      if ((LByte or 128)=LByte) Then Hold_Bit:=true {"CONSERVA" IL PRIMO BIT}
                                else Hold_Bit:=false;
      SByte:=0;
      while not eof(f1) do
      begin
        write(#13, round((filepos(f1)+1)/filesize(f1)*100), '%');
        read(f1, b);
        if ((b or 128)=b) then Ctrl_Bit:=true   {CONSERVA IL PRIMO BIT DEL BYTE}
                          else Ctrl_Bit:=false; {SUCCESSIVO}

        if Ctrl_Bit             then SByte:=SByte+001;
        if (LByte or 001)=LByte then SByte:=SByte+002;
        if (LByte or 002)=LByte then SByte:=SByte+004;
        if (LByte or 004)=LByte then SByte:=SByte+008;
        if (LByte or 008)=LByte then SByte:=SByte+016;
        if (LByte or 016)=LByte then SByte:=SByte+032;
        if (LByte or 032)=LByte then SByte:=SByte+064;
        if (LByte or 064)=LByte then SByte:=SByte+128;

        write(f2, SByte);
        LByte:=b;
        SByte:=0;
      end;

        if Hold_Bit             then SByte:=001;
        if (LByte or 001)=LByte then SByte:=SByte+002;
        if (LByte or 002)=LByte then SByte:=SByte+004;
        if (LByte or 004)=LByte then SByte:=SByte+008;
        if (LByte or 008)=LByte then SByte:=SByte+016;
        if (LByte or 016)=LByte then SByte:=SByte+032;
        if (LByte or 032)=LByte then SByte:=SByte+064;
        if (LByte or 064)=LByte then SByte:=SByte+128;
        write(f2, SByte);

      close(f1); close(f2);
    end;

    procedure guida;
    begin
      writeln(#13#10,
              'Questo programma serve a codificare file binari e di testo.');
      writeln(#13#10,
              ' (Codifica)  NCODE <filename.estensione>');
      writeln('(Decodifica) NCODE <filename>.COD');
    end;

    function FileExists(FileName: String): Boolean;
    { Boolean function that returns True if the file exists;otherwise,
     it returns False. Closes the file if it exists. }
    var
     F: file;
    begin
     {$I-}
     Assign(F, FileName);
     FileMode := 0;  { Set file access to read only }
     Reset(F);
     Close(F);
     {$I+}
     FileExists := (IOResult = 0) and (FileName <> '');
    end;  { FileExists }

    begin
      writeln('NCode 1.0 - Nogat Software 1996');
      if paramcount<>1 then begin guida; exit end;
      {CONTROLLO} if not FileExists(paramstr(1)) then begin
                                                      writeln('File inesistente.');
                                                      exit
                                                      end;
        FindFirst(paramstr(1), Archive, DirInfo); { Same as DIR *.PAS }
        fsplit(dirinfo.name, d, n, e);
      {CONTROLLO} if ((e='.COD') or (e='.cod')) then decode
                                                else code;
    end.

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