64 Bit File Crypter

Unit Base64Unit.pas

unit Base64Unit;

interface  

{/}

Const
base64ABC='ABCDEFGHIJKLMNOPQRSTUVWXYZabcdefghijklmnopqrstuvwxyz0123456789+⁄';

Type
  TBase64 = Record
  ByteArr  : Array [0..2] Of Byte;
  ByteCount:Byte;
End;

Function CodeBase64(Base64:TBase64):String;
Function DecodeBase64(StringValue:String):TBase64;

implementation

Function CodeBase64(Base64:TBase64):String;
Var
  N,M:Byte;
  Dest,
  Sour:Byte;
  NextNum:Byte;
  Temp:Byte;
Begin 
  Result := '';
  NextNum := 1;
  Dest := 0;
    For N := 0 To 2 Do
      Begin 
      Sour := Base64.ByteArr[N];
        For M := 0 To 7 Do
        Begin 
        Temp := Sour;
        Temp := Temp SHL M;
        Dest := Dest SHL 1;

        If (Temp And 128) = 128 Then
        Dest := Dest Or 1;
        Inc(NextNum);
          If NextNum > 6 Then
          Begin 
          Result := Result+base64ABC[Dest+1];
          NextNum := 1;
          Dest := 0;
          End; 
        End; 
      End;

      If Base64.ByteCount < 3 Then
        For N := 0 To (2 - Base64.ByteCount) Do
        Result[4-N] := '=';
End;  

Function DecodeBase64(StringValue:String):TBase64;
Var
  M,N:Integer;
  Dest,
  Sour:Byte;
  NextNum:Byte;
  CurPos:Byte;
Begin 
  CurPos:=0;
  Dest:=0;
  NextNum:=1;
  FillChar(Result,SizeOf(Result),#0);

    For N:=1 To 4 Do
    Begin {For N}
      For M:=0 To 5 Do
      Begin {For M}

      If StringValue[N] = '=' Then
      Sour:=0
      Else
      Sour := Pos(StringValue[N],base64ABC)-1;
      Sour := Sour SHL M;
      Dest := Dest SHL 1;

      If (Sour And 32)=32 Then
      Dest:=Dest Or 1;
      Inc(NextNum);

      If NextNum > 8 Then
      Begin {If NextNum}
      NextNum:=1;
      Result.ByteArr[CurPos]:=Dest;

      If StringValue[N]='=' Then
      Result.ByteArr[CurPos]:=0
      Else
      Result.ByteCount:=CurPos+1;
      Inc(CurPos);
      Dest:=0;
      End;   
    End;  
  End;  
End;  

end.

Unit1 :

uses Base64Unit

//

// Encode
procedure TForm1.Button1Click(Sender: TObject);
const
 Base64MaxLength=72;
var
 hFile: integer;
 base64String: string;
 base64File: textfile;
 Base64: TBase64;
 Buf: array[0..2] of Byte;
begin
 if not OpenDialog1.Execute then Exit;
 Application.ProcessMessages;
 base64String:='';
 hFile:=FileOpen(OpenDialog1.FileName,fmOpenReadWrite);
 AssignFile(base64File,OpenDialog1.FileName+'.b64');
 Rewrite(base64File);
 FillChar(Buf,SizeOf(Buf),#0);
 repeat
  Base64.ByteCount:=FileRead(hFile,Buf,SizeOf(Buf));
  Move(Buf,Base64.ByteArr,SizeOf(Buf));
  base64String:=base64String+CodeBase64(Base64);
  if Length(base64String)=Base64MaxLength
  then
   begin
    Writeln(base64File,base64String);
    base64String:='';
   end;
 until Base64.ByteCount<3;
 Writeln(base64File,base64String);
 CloseFile(base64File);
 FileClose(hFile);
 ShowMessage('File '+ExtractFileName(OpenDialog1.FileName)+
              ' is Coded base64!'+#13#10+
              'New File Name '+
              ExtractFileName(OpenDialog1.FileName)+'.b64');
end;

// Decode
procedure TForm1.Button2Click(Sender: TObject);
var
 base64File: textfile;
 BufStr: string;
 base64String: string;
 Base64: TBase64;
 hFile: integer;
begin
 if not OpenDialog1.Execute then Exit;
 if not SaveDialog1.Execute then Exit;
 Application.ProcessMessages;
 AssignFile(base64File,OpenDialog1.FileName);
 Reset(base64File);
 hFile:=FileCreate(SaveDialog1.FileName);
 while not EOF(base64File) do
  begin
   Readln(base64File,BufStr);
   while Length(BufStr)>0 do
    begin
     base64String:=Copy(BufStr,1,4);
     Delete(BufStr,1,4);
     Base64:=DecodeBase64(base64String);
     FileWrite(hFile,Base64.ByteArr,Base64.ByteCount);
    end;
  end;
 FileClose(hFile);
 CloseFile(base64File);
 ShowMessage('Crypt done.');
end;