[Resolvido] Programa para armazenar texto criptografado

[marcio.theis 3]

Pequeno programa para guardar o que desejar, não precisa ser necessariamente senhas, pode ser qualquer tipo de informação, basta inicialmente colocar a senha e o cód. segurança para poder abrir o arquivo selecionado..., sendo que somente informando a correta irá conseguir abrir o arquivo, onde que para criptografar e descriptografar é feito via uma função.

Podendo depois salvar onde desejar o arquivo.

 

 

Arquivo .dfm

object frmPrincipal: TfrmPrincipal  Left = 222  Top = 114  BorderIcons = [biSystemMenu]  BorderStyle = bsSingle  Caption = 'Controle de Senhas'  ClientHeight = 398  ClientWidth = 466  Color = clBtnFace  Font.Charset = DEFAULT_CHARSET  Font.Color = clWindowText  Font.Height = -11  Font.Name = 'MS Sans Serif'  Font.Style = []  OldCreateOrder = False  Position = poOwnerFormCenter  PixelsPerInch = 96  TextHeight = 13  object Label1: TLabel	Left = 8	Top = 39	Width = 34	Height = 13	Caption = 'Senha:'  end  object Label2: TLabel	Left = 8	Top = 13	Width = 39	Height = 13	Caption = 'Arquivo:'  end  object Label3: TLabel	Left = 142	Top = 39	Width = 50	Height = 13	Caption = 'Cód. Seg.:'  end  object edtContraSenha: TEdit	Left = 51	Top = 35	Width = 87	Height = 24	Font.Charset = SYMBOL_CHARSET	Font.Color = clWindowText	Font.Height = -13	Font.Name = 'Symbol'	Font.Style = [fsBold, fsItalic]	MaxLength = 20	ParentFont = False	PasswordChar = '*'	TabOrder = 2  end  object btnLiberar: TBitBtn	Left = 249	Top = 33	Width = 70	Height = 25	Caption = 'Carregar'	TabOrder = 4	OnClick = btnLiberarClick	Glyph.Data = {	  EE000000424DEE000000000000007600000028000000100000000F0000000100	  04000000000078000000130B0000130B00001000000000000000000000000000	  8000008000000080800080000000800080008080000080808000C0C0C0000000	  FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00888888800000	  088888888880FFFF088888888880F88F088888800000FFFF08888880FFF4C4C4	  C8888880F88C4C4C48888880FFFF088888888884C4C4C8888888888C4C4C4888	  8888888888888888888888877777777788888888000000088888888880000088	  888888888800088888888888888088888888}  end  object btnSalvar: TBitBtn	Left = 319	Top = 33	Width = 70	Height = 25	Caption = 'Salvar'	TabOrder = 5	OnClick = btnSalvarClick	Glyph.Data = {	  42010000424D4201000000000000760000002800000011000000110000000100	  040000000000CC00000000000000000000001000000010000000000000000000	  BF0000BF000000BFBF00BF000000BF00BF00BFBF0000C0C0C000808080000000	  FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00777777777777	  7777700000007777777777777777700000000007777777777000700000000004	  4444444440007000000000077777777770007000000074777777777747777000	  0000747777777774777770000000747777770007777770000000000777770007	  7777700000000007777700077777700000000007777777747777700000007774	  7777777747777000000077770007777770007000000077770004444440007000	  0000777700077777700070000000777777777777777770000000777777777777	  777770000000}  end  object Memo: TMemo	Left = 0	Top = 72	Width = 466	Height = 326	Align = alBottom	ScrollBars = ssBoth	TabOrder = 7  end  object btnFechar: TBitBtn	Left = 389	Top = 33	Width = 70	Height = 25	Caption = 'Fechar'	TabOrder = 6	OnClick = btnFecharClick	Glyph.Data = {	  EE000000424DEE000000000000007600000028000000100000000F0000000100	  0400000000007800000000000000000000001000000000000000000000000000	  8000008000000080800080000000800080008080000080808000C0C0C0000000	  FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00FFFFF0FFFFFF	  FFFFFFFF00FFFFFFFFFFFFF030FFFFFFFFFFFF0330FFFFFFFFFF003330000000	  0FFFF03330FF0FFFFFFFF03300FF0FFFF4FFF03330FF0FFF44FFF03330FF0FF4	  4444F03330FF0F444444F03330FF0FF44444F0330FFF0FFF44FFF030FFFF0FFF	  F4FFF00FFFFF0FFFFFFFF00000000FFFFFFF}  end  object edtArquivo: TEdit	Left = 51	Top = 9	Width = 336	Height = 21	TabStop = False	Font.Charset = ANSI_CHARSET	Font.Color = clWindowText	Font.Height = -11	Font.Name = 'MS Sans Serif'	Font.Style = [fsBold, fsItalic]	ParentFont = False	ReadOnly = True	TabOrder = 0  end  object btnProcurar: TBitBtn	Left = 389	Top = 7	Width = 70	Height = 25	Caption = 'Procurar'	TabOrder = 1	OnClick = btnProcurarClick	Glyph.Data = {	  EE000000424DEE000000000000007600000028000000100000000F0000000100	  04000000000078000000130B0000130B00001000000000000000000000000000	  8000008000000080800080000000800080008080000080808000C0C0C0000000	  FF0000FF000000FFFF00FF000000FF00FF00FFFF0000FFFFFF00F00700700700	  00000880FF0880FFFFF00EF0F70EF07F77F00EE0000EE0FFFFF00000F7F000F7	  7FF0F080FFFFFF0FF0F0FF00F0F77F7070F0FFF0F0FFFFFF00F0FFF000F7777F	  77F0FFF0FFFFFFFFFFF0FFF4444444444444FFF4444444444444FFFFFFFFFFFF	  FFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFFF}  end  object edtCodSeg: TEdit	Left = 195	Top = 35	Width = 50	Height = 21	Font.Charset = ANSI_CHARSET	Font.Color = clWindowText	Font.Height = -11	Font.Name = 'MS Sans Serif'	Font.Style = [fsBold]	MaxLength = 5	ParentFont = False	TabOrder = 3	Text = '11'	OnExit = edtCodSegExit  end  object MemoAux: TMemo	Left = 16	Top = 136	Width = 185	Height = 89	ScrollBars = ssBoth	TabOrder = 8	Visible = False  end  object OpenDialog: TOpenDialog	DefaultExt = '*.txt'	Filter = 'Arquivos Texto|*.txt'	Left = 279	Top = 5  end  object SaveDialog: TSaveDialog	DefaultExt = '*.txt'	Filter = 'Arquivos Texto|*.txt'	Left = 328	Top = 72  endend

Arquivo .pas

unit fPrincipal;interfaceuses  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,  Dialogs, StdCtrls, Buttons, Grids;type  TfrmPrincipal = class(TForm)	edtContraSenha: TEdit;	Label1: TLabel;	btnLiberar: TBitBtn;	btnSalvar: TBitBtn;	Memo: TMemo;	btnFechar: TBitBtn;	Label2: TLabel;	edtArquivo: TEdit;	btnProcurar: TBitBtn;	OpenDialog: TOpenDialog;	Label3: TLabel;	edtCodSeg: TEdit;	SaveDialog: TSaveDialog;	MemoAux: TMemo;	procedure btnLiberarClick(Sender: TObject);	procedure btnSalvarClick(Sender: TObject);	procedure btnFecharClick(Sender: TObject);	procedure edtCodSegExit(Sender: TObject);	procedure btnProcurarClick(Sender: TObject);  private	{ Private declarations }	function EncriptaDecripta(const str: string): string;  public	{ Public declarations }  end;var  frmPrincipal: TfrmPrincipal;implementation{$R *.dfm}procedure TfrmPrincipal.btnLiberarClick(Sender: TObject);var	x: integer;	senha, cs: string;beginif edtArquivo.Text = '' then	begin	Application.MessageBox('Arquivo não selecionado !','Controle de Senhas',MB_OK or MB_APPLMODAL or MB_ICONINFORMATION);	btnProcurar.SetFocus;	Exit;	end;senha:='';cs:='';MemoAux.Clear;MemoAux.Lines.LoadFromFile(edtArquivo.Text);for x:=0 to MemoAux.Lines.Count - 1 do	MemoAux.Lines.Strings[x]:=EncriptaDecripta(MemoAux.Lines.Strings[x]);if MemoAux.Text <> '' then	begin	if (MemoAux.Lines.Count - 1) >= 1 then		begin		senha:=MemoAux.Lines.Strings[MemoAux.Lines.Count - 2];		cs:=MemoAux.Lines.Strings[MemoAux.Lines.Count - 1];		end;	if ((edtContraSenha.Text = senha) and (edtCodSeg.Text = cs)) then		begin		MemoAux.Lines.Delete(MemoAux.Lines.Count - 1);		MemoAux.Lines.Delete(MemoAux.Lines.Count - 1);		Memo.Text:=MemoAux.Text;		end	else		Application.MessageBox('Senha ou Código de Segurança inválido !','Controle de Senhas',MB_OK or MB_APPLMODAL or MB_ICONERROR);	end;end;procedure TfrmPrincipal.btnSalvarClick(Sender: TObject);var	x: integer;	arquivo: string;beginarquivo:='';if edtArquivo.Text <> '' then	arquivo:=edtArquivo.Text;if arquivo <> '' then	if Application.MessageBox(PChar('Deseja salvar o arquivo como:' + #13#13 + arquivo),'Controle de Senhas',MB_YESNO or MB_APPLMODAL or MB_ICONQUESTION) = mrNo then		arquivo:='';if arquivo = '' then	if SaveDialog.Execute then		arquivo:=SaveDialog.FileName;if arquivo <> '' then	begin	MemoAux.Clear;	MemoAux.Text:=Memo.Text;	MemoAux.Lines.Add(edtContraSenha.Text);	MemoAux.Lines.Add(edtCodSeg.Text);	for x:=0 to MemoAux.Lines.Count - 1 do		MemoAux.Lines.Strings[x]:=EncriptaDecripta(MemoAux.Lines.Strings[x]);	MemoAux.Lines.SaveToFile(Application.GetNamePath + ExtractFilePath(Application.ExeName) + 'senhas.txt');	for x:=0 to MemoAux.Lines.Count - 1 do		MemoAux.Lines.Strings[x]:=EncriptaDecripta(MemoAux.Lines.Strings[x]);	Application.MessageBox('OK, salvo !','Controle de Senhas',MB_OK or MB_APPLMODAL or MB_ICONINFORMATION);	end;end;function TfrmPrincipal.EncriptaDecripta(const str: string): string;var	I: Integer;	OutValue: String;beginOutValue:='';for I:=1 to Length(str) do	OutValue:=OutValue + char(not(ord(str[I]) - StrToInt(edtCodSeg.Text)));Result:=OutValue;end;procedure TfrmPrincipal.btnFecharClick(Sender: TObject);beginclose;end;procedure TfrmPrincipal.edtCodSegExit(Sender: TObject);var	aux: integer;beginif Trim(edtCodSeg.Text) = '' then	edtCodSeg.Text:='11'else	begin	try		aux:=StrToInt(edtCodSeg.Text);		if ((aux < 1) or (aux > 30)) then			begin			Application.MessageBox('Escolha um número entre 1 e 30 !','Controle de Senhas',MB_OK or MB_APPLMODAL or MB_ICONERROR);			edtCodSeg.SetFocus;			end; 	except		Application.MessageBox('Código de Segurança deve de conter somente números !','Controle de Senhas',MB_OK or MB_APPLMODAL or MB_ICONERROR);		edtCodSeg.SetFocus;		end;	end;end;procedure TfrmPrincipal.btnProcurarClick(Sender: TObject);beginif OpenDialog.Execute then	edtArquivo.Text:=OpenDialog.FileName;end;end.

Cada arquivo pode ser gerado com uma senha e código de segurança diferente, conforme for colocar para salvar...

 

Se quiser pode baixar os fontes prontos aqui.

No exemplo que acompanha os fontes, a Senha é "teste" e Cód. Segurança é "11".