Fórum Criptografar String e Arquivos Compactados #461835

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls, strutils, XPMan, ZLib, IniFiles;

function Crypt(Texto, senha: string): string;
var
  x, y: Integer;
  Novo: String;
begin
  for x := 1 to Length(senha) do begin
    Novo := '';
    for y := 1 to Length(Texto) do
      Novo := Novo + chr((Ord(Senha[x]) xor Ord(Texto[y])));
    Texto := Novo;
  end;
  Result := Texto;
end;

function MStrmToStr(M: TMemoryStream):string;
begin
  SetString(Result, PChar(M.Memory), M.size);
end;

procedure EnDecryptStream(FileIn, FileOut: TMemoryStream; Key: String);
var
  Arquivo: TMemoryStream;
  ArquivoString: string;
begin
  Arquivo := TMemoryStream.Create;
  Arquivo.LoadFromStream(FileIn);
  ArquivoString := MStrmToStr(Arquivo);
  ArquivoString := Crypt(ArquivoString, Key);
  Arquivo.Free;
  Arquivo := TMemoryStream.Create;
  Arquivo.WriteBuffer(Pointer(ArquivoString)^, Length(ArquivoString));
  Arquivo.SaveToStream(FileOut);
  Arquivo.Free;
  ArquivoString := '';
end;

function ExtractDiskSerial(Drive: String): String;
Var
  Serial:DWord;
  DirLen,Flags: DWord;
  DLabel: Array[0..11] of Char;
begin
  GetVolumeInformation(PChar (Drive+':\'), dLabel, 12, @Serial, DirLen, Flags, nil, 0);
  Result:= IntToHex(Serial, 8);
end;

function EnDecryptText(Action, Src, Key : String) : String;
var
   KeyLen: Integer;
   KeyPos: Integer;
   offset: Integer;
   dest: string;
   SrcPos: Integer;
   SrcAsc: Integer;
   TmpSrcAsc: Integer;
   Range: Integer;
begin
  Key:= Key + ExtractDiskSerial('C');
  dest:='';
  KeyLen:=Length(Key);
  KeyPos:=0;
  SrcPos:=0;
  SrcAsc:=0;
  Range:=256;
  if Action = UpperCase('E') then begin
    Randomize;
    offset:=Random(Range);
    dest:=format('%1.2x',[offset]);
    for SrcPos := 1 to Length(Src) do begin
      SrcAsc:=(Ord(Src[SrcPos]) + offset) MOD 255;
      if KeyPos < KeyLen then KeyPos:= KeyPos + 1 else KeyPos:=1;
      SrcAsc:= SrcAsc xor Ord(Key[KeyPos]);
      dest:=dest + format('%1.2x',[SrcAsc]);
      offset:=SrcAsc;
    end;
  end;
  if Action = UpperCase('D') then begin
    offset:=StrToInt('$'+ copy(src,1,2));
    SrcPos:=3;
    repeat
      SrcAsc:=StrToInt('$'+ copy(src,SrcPos,2));
      if KeyPos < KeyLen Then KeyPos := KeyPos + 1 else KeyPos := 1;
      TmpSrcAsc := SrcAsc xor Ord(Key[KeyPos]);
      if TmpSrcAsc <= offset then TmpSrcAsc := 255 + TmpSrcAsc - offset else TmpSrcAsc := TmpSrcAsc - offset;
      dest := dest + chr(TmpSrcAsc);
      offset:=srcAsc;
      SrcPos:=SrcPos + 2;
    until SrcPos >= Length(Src);
  end;
  result:= dest;
end;

procedure TMain.Btn_openClick(Sender: TObject);
var
  Temp1, Temp2: TMemoryStream;
  LineX: TStringList;
  I: Integer;
begin
  Try
  if Open = True then if MessageDlg('Save this KDB ?', mtConfirmation, mbOkCancel, 0) = idOk then Btn_saveClick(Sender);
  if OpenDialog1.Execute then begin
    I:= 0;
    LineX:= TStringList.Create;
    Temp1:= TMemoryStream.Create;
    Temp2:= TMemoryStream.Create;
    Temp1.LoadFromFile(OpenDialog1.FileName);
    EnDecryptStream(Temp1, Temp2, ExtractDiskSerial('C'));
//    Decompress(OpenDialog1.FileName, GetCurrentDir + '\temp.kdb');
    Temp2.Position:= 0;
    LineX.LoadFromStream(Temp2);
//    DeleteFile(GetCurrentDir + '\temp.kdb');
    Temp1.Free;
    Temp2.Free;
    Rhe_code.Lines.Clear;
    Repeat
      Rhe_code.Lines.Add(EnDecryptText('D', LineX[I], ExtractDiskSerial('C')));
      I:= I + 1;
    Until I = LineX.Count;
  end;
  Finally
    ShowMessage(TIniFile(LineX).ReadString('Mane', 'Money', 'ERR'));
    OpenDialog1.FileName:= '';
    LineX.Free;
  end;
end;

procedure TMain.Btn_saveClick(Sender: TObject);
var
  Temp1, Temp2: TMemoryStream;
  LineX: TStringList;
  I: Integer;
begin
  if SaveDialog1.Execute then begin
    I:= 0;
    LineX:= TStringList.Create;
    Repeat
      LineX.Add(EnDecryptText('E', Rhe_code.Lines[I], ExtractDiskSerial('C')));
      I:= I + 1;
    Until I = Rhe_code.Lines.Count;
    Temp1:= TMemoryStream.Create;
    Temp2:= TMemoryStream.Create;
    LineX.SaveToStream(Temp1);
//    Compress(SaveDialog1.FileName, SaveDialog1.FileName + '.kdb');
//    DeleteFile(SaveDialog1.FileName);
    EnDecryptStream(Temp1, Temp2, ExtractDiskSerial('C'));
    Temp2.SaveToFile(SaveDialog1.FileName + '.kdb');
    Btn_save.Enabled:= False;
    SaveDialog1.FileName:= '';
    Temp1.Free;
    Temp2.Free;
    LineX.Free;
  end;
end;