Kirjautuminen

Haku

Tehtävät

Keskustelu: Koodit: Pascal: Tiedostosalaus

Ice [01.04.2003 10:29:10]

#

Yksinkertainen tiedoston salaus/salauksen purku.
Kommentteja en ole juurikaan lisännyt koodiin, mutta eiköhän tuon pitäisi aika selvä olla. :)

{
 File crypting/decrypting... (Just a small demonstration)

 Compiled with FreePascal (Compiler version 1.0.6)
 Tp6/7 compliant with minor changes. (Changes listed in code.)

 Contact me @ Ice@Iname.Com

 --> Use only at your own risk <--
}
Program Crypt;
Uses Dos,Crt,SysUtils; {Use SysUtils only in Fpc}

Const TemporaryFile       = 'TFile.Tmp';
Var Dire                  : Boolean;
    FileName              : String;
    Pass1,Pass2           : ShortString;{Use string at Tp}
    CFile,TFile           : File;
    Buf                   : array[1..16384] of Char;
    NumRead,NumWritten    : word;
    T,Tt,Tt2,TimesReaded  : LongInt;

Function FileExists(Name:String):Boolean;
{Not necessary needed in Fp, cause function also in SysUtils-Unit}
Var F : File;
Begin
  {$i-}
   Assign (F,Name);
   Reset (F);
  {$I+}
  FileExists:=(IoResult=0) and (Name<>'');
  Close (f);
End;

Procedure CheckParameters;
{Tarkistetaan parametrit}
Begin
  If ParamStr(1)='?' Then Begin
   WriteLn('Using Crypt:');
   WriteLn('Crypt FileName PassWord1 PassWord2 Direction');
   WriteLn('Direction switches: ');
   WriteLn('+ : Crypt');
   WriteLn('- : DeCrypt');
   Halt;
  End;
  If ParamCount<>4 then Begin
   WriteLn('Wrong amount of parametres!!!');
   WriteLn('Check help (Crypt ?)');
   Halt;
  End;
  FileName:=ParamStr(1);
  Pass1:=ParamStr(2);
  Pass2:=ParamStr(3);
End;

Procedure CheckFileAndPass;
{Tarkistetaan tiedoston olemassaolo ja salasanojen pituus}
Begin
  If Not FileExists(FileName) Then Begin
   WriteLn('File not found!!! Check the filename and path');
   Halt;
  End;
  If (Length(Pass1)<4)or(Length(Pass2)<4) Then Begin
   WriteLn('Both passwords must be atleast 4 characters or longer');
   Halt;
  End;
  If ParamStr(4)='+' Then Dire:=True
  Else If ParamStr(4)='-' Then Dire:=False
  Else Begin
   WriteLn('Use + or - as direction switch');
   Halt;
  End;
End;

Procedure Crypt;
{
Pistetään faili sekaisin
Luku tempistä ja kirjoitus alkuperäiseen
}
Begin
  Tt:=1;
  Tt2:=1;
  TimesReaded:=0;
  Repeat
   TimesReaded:=TimesReaded+1;
   BlockRead(TFile, Buf, SizeOf(Buf), NumRead);
   For T:=1 to NumRead do Begin
    If Dire Then
     Buf[T]:=Chr(Ord(Buf[T])+
                 Ord(Pass1[Tt])-
                 Ord(Pass2[Tt2])+
                 Ord('F')+Ord('i')-Ord('L')+Ord('e')-
                 Ord('h')+Ord('E')-Ord('d')+Ord('E'))
    Else If not Dire Then
     Buf[T]:=Chr(Ord(Buf[T])-
                 Ord(Pass1[Tt])+
                 Ord(Pass2[Tt2])-
                 Ord('F')-Ord('i')+Ord('L')-Ord('e')+
                 Ord('h')-Ord('E')+Ord('d')-Ord('E'));

    Inc(Tt,1);If Tt>Length(Pass1) Then Tt:=1;
    Inc(Tt2,1);If Tt2>Length(Pass2) Then Tt2:=1;
   End;
   BlockWrite(CFile, Buf, NumRead, NumWritten);
   Write(' RT: ',TimesReaded,' NR: ',NumRead,' NW ',NumWritten);
   WriteLn(' : OK');
  Until (NumRead = 0) or (NumWritten <> NumRead);
End;

Procedure OpenFiles;
{Avataan kohde ja temppi tiedostot}
Begin
  Assign(CFile,FileName);
  Assign(TFile,TemporaryFile);
  Reset(CFile,1);
  ReWrite(TFile,1);
End;

Procedure CopyToTemp;
{Kopioidaan kohteesta temppiin}
Begin
  Repeat
   BlockRead(CFile, Buf, SizeOf(Buf), NumRead);
   BlockWrite(TFile, Buf, NumRead, NumWritten);
  Until (NumRead = 0) or (NumWritten <> NumRead);
  Close(TFile);
  Close(CFile);
  Reset(CFile,1);
  Reset(TFile,1);
End;

Procedure CloseFiles;
{suljetaan tiedostot ja poistetaan temppi tiedosto}
Begin
  Close(CFile);
  Close(TFile);
  DeleteFile(Temporaryfile); { <-- Use with Fp}
  {Erase(TemporaryFile);}    { <-- Use with Tp}
End;

BEGIN
  CheckParameters;
  CheckFileAndPass;
  OpenFiles;
  CopyToTemp;
  Crypt;
  CloseFiles;
  WriteLn('Its done!!!!');
END.
{
 Haven't got time to test it properly.
 I tested with couple of files, and it seemed to work ok.
 Hopefully you get something out of this.

 Using in commandprompt
 Crypting: Crypt Filename PassWord1 PassWord2 +
 DeCrypting : Crypt FileName PassWord1 PassWord2 -
}

arcatan [03.04.2003 14:25:28]

#

Aika epäselvää koodia. Voisi olla rivinvaihtoja enemmän...

Vastaus

Aihe on jo aika vanha, joten et voi enää vastata siihen.

Tietoa sivustosta