home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 9 / CDACTUAL9.iso / share / Dos / VARIOS / pascal / SWAG9605.DDD / 0070_Criptation code.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-05-31  |  4.8 KB  |  159 lines
  1. {
  2. I want to let you see a program I made to criptate binary and
  3. text files... it just traslate ALL THE FILE of a bit to right,
  4. then adds the old extension to the start of the file, followed by
  5. a (eof) #26... try it and tell me what do you think!
  6.  
  7. I you have something to suggest... i'm here!... for example how
  8. to add a password to coded files, how to increase the speed of
  9. the program and so on...
  10.  
  11. Sorry for my english :-) }
  12.  
  13. program NCode;
  14.  
  15. {FREEWARE! 1996, Emidio Spinogatti (2:335/622.18@fidonet)}
  16.  
  17. uses dos;
  18.  
  19. var
  20.   f1, f2: file of byte;
  21.   DirInfo: SearchRec;
  22.   P: PathStr;
  23.   D: DirStr;
  24.   N: NameStr;
  25.   E: ExtStr;
  26.  
  27. procedure code;
  28. const eofile:byte=26;
  29. var
  30.   b, LByte, SByte: byte;
  31.   ctrl_bit: boolean;
  32. begin
  33.   writeln('CODIFICA IN CORSO...');
  34.   assign(f1, paramstr(1)); assign(f2, n+'.cod');
  35.   reset(f1); rewrite(f2);
  36.   b:=ord(e[2]); LByte:=ord(e[3]); SByte:=ord(e[4]);
  37.   write(f2, b, LByte, SByte, eofile); {INTESTAZIONE DEL FILE}
  38.  
  39.   {LEGGE L'ULTIMO BIT E LO SALVA IN CTRL_BIT} seek(f1, filesize(f1)-1);
  40.   read(f1, b); if ((b or 1) = b) then ctrl_bit:=true
  41.                                  else ctrl_bit:=false;
  42.  
  43.   {TORNA ALL'INIZIO DEL FILE} seek(f1, 0);
  44.  
  45.   repeat
  46.     write(#13, round((filepos(f1)+1)/filesize(f1)*100), '%');
  47.     read(f1, LByte);
  48.  
  49.     if ctrl_bit then SByte:=128
  50.                 else SByte:=0;
  51.     if (LByte or 128)=LByte then SByte:=SByte+064;
  52.     if (LByte or 064)=LByte then SByte:=SByte+032;
  53.     if (LByte or 032)=LByte then SByte:=SByte+016;
  54.     if (LByte or 016)=LByte then SByte:=SByte+008;
  55.     if (LByte or 008)=LByte then SByte:=SByte+004;
  56.     if (LByte or 004)=LByte then SByte:=SByte+002;
  57.     if (LByte or 002)=LByte then SByte:=SByte+001;
  58.  
  59.     write(f2, SByte);
  60.  
  61.     if ((LByte or 1) = LByte) then ctrl_bit:=true
  62.                               else ctrl_bit:=false;
  63.  
  64.   until eof(f1);
  65.  
  66.   close(f2); close(f1);
  67. end;
  68.  
  69. procedure decode;
  70. var
  71.   Hold_Bit, Ctrl_Bit: boolean;
  72.   LByte, b, SByte: byte;
  73. begin
  74. writeln('DECODIFICA IN CORSO...');
  75.  
  76.   assign(f1, paramstr(1)); reset(f1);
  77.  
  78.   read(f1, LByte, b, SByte); {LETTURA INTESTAZIONE DEL FILE}
  79.   e:='.'+chr(LByte)+chr(b)+chr(SByte);
  80.   assign(f2, n+e); rewrite(f2);
  81.  
  82.   read(f1, LByte); {LETTURA EOF 4° CARATTERE}
  83.  
  84.   read(f1, LByte); {PRIMO BYTE "SIGNIFICATIVO"}
  85.  
  86.   if ((LByte or 128)=LByte) Then Hold_Bit:=true {"CONSERVA" IL PRIMO BIT}
  87.                             else Hold_Bit:=false;
  88.   SByte:=0;
  89.   while not eof(f1) do
  90.   begin
  91.     write(#13, round((filepos(f1)+1)/filesize(f1)*100), '%');
  92.     read(f1, b);
  93.     if ((b or 128)=b) then Ctrl_Bit:=true   {CONSERVA IL PRIMO BIT DEL BYTE}
  94.                       else Ctrl_Bit:=false; {SUCCESSIVO}
  95.  
  96.     if Ctrl_Bit             then SByte:=SByte+001;
  97.     if (LByte or 001)=LByte then SByte:=SByte+002;
  98.     if (LByte or 002)=LByte then SByte:=SByte+004;
  99.     if (LByte or 004)=LByte then SByte:=SByte+008;
  100.     if (LByte or 008)=LByte then SByte:=SByte+016;
  101.     if (LByte or 016)=LByte then SByte:=SByte+032;
  102.     if (LByte or 032)=LByte then SByte:=SByte+064;
  103.     if (LByte or 064)=LByte then SByte:=SByte+128;
  104.  
  105.     write(f2, SByte);
  106.     LByte:=b;
  107.     SByte:=0;
  108.   end;
  109.  
  110.     if Hold_Bit             then SByte:=001;
  111.     if (LByte or 001)=LByte then SByte:=SByte+002;
  112.     if (LByte or 002)=LByte then SByte:=SByte+004;
  113.     if (LByte or 004)=LByte then SByte:=SByte+008;
  114.     if (LByte or 008)=LByte then SByte:=SByte+016;
  115.     if (LByte or 016)=LByte then SByte:=SByte+032;
  116.     if (LByte or 032)=LByte then SByte:=SByte+064;
  117.     if (LByte or 064)=LByte then SByte:=SByte+128;
  118.     write(f2, SByte);
  119.  
  120.   close(f1); close(f2);
  121. end;
  122.  
  123. procedure guida;
  124. begin
  125.   writeln(#13#10,
  126.           'Questo programma serve a codificare file binari e di testo.');
  127.   writeln(#13#10,
  128.           ' (Codifica)  NCODE <filename.estensione>');
  129.   writeln('(Decodifica) NCODE <filename>.COD');
  130. end;
  131.  
  132. function FileExists(FileName: String): Boolean;
  133. { Boolean function that returns True if the file exists;otherwise,
  134.  it returns False. Closes the file if it exists. }
  135. var
  136.  F: file;
  137. begin
  138.  {$I-}
  139.  Assign(F, FileName);
  140.  FileMode := 0;  { Set file access to read only }
  141.  Reset(F);
  142.  Close(F);
  143.  {$I+}
  144.  FileExists := (IOResult = 0) and (FileName <> '');
  145. end;  { FileExists }
  146.  
  147. begin
  148.   writeln('NCode 1.0 - Nogat Software 1996');
  149.   if paramcount<>1 then begin guida; exit end;
  150.   {CONTROLLO} if not FileExists(paramstr(1)) then begin
  151.                                                   writeln('File inesistente.');
  152.                                                   exit
  153.                                                   end;
  154.     FindFirst(paramstr(1), Archive, DirInfo); { Same as DIR *.PAS }
  155.     fsplit(dirinfo.name, d, n, e);
  156.   {CONTROLLO} if ((e='.COD') or (e='.cod')) then decode
  157.                                             else code;
  158. end.
  159.