Ir para conteúdo

POWERED BY:

Arquivado

Este tópico foi arquivado e está fechado para novas respostas.

NöU@

Acessar o Registro do Windows

Recommended Posts

Aí Pessoal... beleza?

 

Tô com um problema aki..

 

Quero gravar algumas informações no Registro do Windows, mas tá dando um erro.

 

Quando abre o Form dá um erro de Access Violation e quando salva, também dá o mesmo erro.

 

Segue abaixo os códigos:

 

unit UConfProg;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, ExtCtrls, Mask, Registry, ExtDlgs, ComCtrls;

type
  TFConf = class(TForm)
	GroupBox1: TGroupBox;
	Label1: TLabel;
	Label2: TLabel;
	Label3: TLabel;
	Label4: TLabel;
	edtNomeEmp: TEdit;
	edtEndereco: TEdit;
	MaskEdit1: TMaskEdit;
	MaskEdit2: TMaskEdit;
	Label5: TLabel;
	ComboBox1: TComboBox;
	GrpBxFoto: TGroupBox;
	Image1: TImage;
	GroupBox2: TGroupBox;
	Label6: TLabel;
	GroupBox3: TGroupBox;
	Label7: TLabel;
	Label8: TLabel;
	edtUsuario: TEdit;
	edtSenha: TEdit;
	RGNivel: TRadioGroup;
	btnSalvar: TBitBtn;
	btnCancelar: TBitBtn;
	edtCaminho: TEdit;
	SpeedButton1: TSpeedButton;
	OpenDialog1: TOpenDialog;
	OpenPictureDialog1: TOpenPictureDialog;
	GrpBxConfAdicionais: TGroupBox;
	chkTransp: TCheckBox;
	edtTransp: TEdit;
	UDTransp: TUpDown;
	procedure btnSalvarClick(Sender: TObject);
	procedure SpeedButton1Click(Sender: TObject);
	procedure btnCancelarClick(Sender: TObject);
	procedure Image1DblClick(Sender: TObject);
	procedure FormShow(Sender: TObject);
	procedure chkTranspClick(Sender: TObject);
	procedure edtTranspChange(Sender: TObject);
	procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
	{ Private declarations }
  public
	{ Public declarations }
  end;

  const raiz = 'HKEY_CURRENT_USER\Software\SystemDeveloper';

var
  FConf: TFConf;
  Chk: Boolean;
  Reg: TRegistry;

implementation

uses UMain, UCadClientes, UCadFun, UCadQuartos, UDevQuartos, UCapturaImagem, ULocQuartos, UFunFoto ;

{$R *.dfm}

procedure TFConf.btnSalvarClick(Sender: TObject);
begin
try
  Reg:= TRegistry.Create;
  If chkTransp.Checked then
	chk:= True
  else
	chk:= False;
  { seta a chave raiz; ex. hkey_local_machine }
  with Reg do
  begin
	If KeyExists('SystemDeveloper') then
	OpenKey(Raiz, true);
	{ Escreve o valor }
	WriteString('NomeEmpresa', edtNomeEmp.Text);
	WriteString('Endereco', edtEndereco.Text);
	WriteString('CNPJ', MaskEdit1.Text);
	WriteString('IE', MaskEdit2.Text);
	WriteString('Caminho', EdtCaminho.Text);
	WriteString('Usuario', EdtUsuario.Text);
	WriteString('Senha', EdtSenha.Text);
	WriteInteger('Nivel', RGNivel.ItemIndex);
	WriteBool('Tranparencia', chk);
	WriteInteger('ValorTransp',StrToInt(edtTransp.Text));
	CloseKey;
  end;
  Image1.Picture.SaveToFile(ExtractFilePath(ParamStr(0)) + '\ConfEmp\logo.bmp');
finally
  Reg.Free;
  FConf.Close;
end;

end;

procedure TFConf.SpeedButton1Click(Sender: TObject);
begin
If OpenDialog1.Execute then
  edtCaminho.Text:= OpenDialog1.FileName;
end;

procedure TFConf.btnCancelarClick(Sender: TObject);
begin
Close;
end;

procedure TFConf.Image1DblClick(Sender: TObject);
begin
If OpenPictureDialog1.Execute then
  Image1.Picture.LoadFromFile(OpenPicTureDialog1.FileName);

end;

procedure TFConf.FormShow(Sender: TObject);
begin
Try
  Try
	Reg:= TRegistry.Create;
	If Reg.KeyExists('SystemDeveloper') then
	begin
	  Reg.OpenKey(Raiz, False);
	  // Escreve o valor
	  edtNomeEmp.Text:= Reg.ReadString('NomeEmpresa');
	  edtEndereco.Text:= ('Endereco');
	  MaskEdit1.Text:= Reg.ReadString('CNPJ');
	  MaskEdit2.Text:= Reg.ReadString('IE');
	  edtcaminho.Text:= Reg.ReadString('Caminho');
	  edtusuario.Text:= Reg.ReadString('Usuario');
	  edtSenha.Text:= Reg.ReadString('Senha');
	  RGNivel.ItemIndex:= Reg.ReadInteger('Nivel');
	  chk:= Reg.ReadBool('Transparencia');
	  edtTransp.Text:= IntToStr(Reg.ReadInteger('ValorTransp'));
	  Image1.Picture.LoadFromFile(ExtractFilePath(ParamStr(0)) + '\ConfEmp\logo.bmp');
	end;
	Reg.CloseKey;
	If chk then
	  chkTransp.Checked:= True
	else
	  chkTransp.Checked:= False;
  Finally
	Reg.Free;
  end;
Except
	On E: ERegistryException do
	begin
	  If MessageDlg('Houve um erro na leitura de dados!' + #13 +
					'Contate o Administrador do Sistema.' + #13 +
					'Erro: ' + E.Message, mtError,[mbOk], 0) = mrOk then
		FConf.Close;
	end;
end;

end;

procedure TFConf.chkTranspClick(Sender: TObject);
begin
  If chkTransp.Checked then
  begin
	Fmain.AlphaBlend:= True;
	FcadClientes.AlphaBlend:= True;
	FcadFun.AlphaBlend:= True;
	FCadQuartos.AlphaBlend:= True;
	FFunFoto.AlphaBlend:= True;
	FLocQuartos.AlphaBlend:= True;
	FDevQuartos.AlphaBlend:= True;
	FCapImagem.AlphaBlend:= True;
  end
  else
  begin
	Fmain.AlphaBlend:= False;
	FcadClientes.AlphaBlend:= false;
	FcadFun.AlphaBlend:= False;
	FCadQuartos.AlphaBlend:= False;
	FFunFoto.AlphaBlend:= False;
	FLocQuartos.AlphaBlend:= false;
	FDevQuartos.AlphaBlend:= False;
	FCapImagem.AlphaBlend:= False;
  end;
  end;

procedure TFConf.edtTranspChange(Sender: TObject);
begin
FMain.AlphaBlendValue:= StrToInt(EdtTransp.Text);
FCadClientes.AlphaBlendValue:= StrToInt(EdtTransp.Text);
FCadFun.AlphaBlendValue:= StrToInt(EdtTransp.Text);
FFunFoto.AlphaBlendValue:= StrToInt(EdtTransp.Text);
FCadQuartos.AlphaBlendValue:= StrToInt(EdtTransp.Text);
FCapImagem.AlphaBlendValue:= StrToInt(EdtTransp.Text);
FLocQuartos.AlphaBlendValue:= StrToInt(EdtTransp.Text);
FDevQuartos.AlphaBlendValue:= StrToInt(EdtTransp.Text);

end;

procedure TFConf.FormClose(Sender: TObject; var Action: TCloseAction);
begin
If Reg <> nil then
Reg:= nil;
end;

end.

Qualquer ajuda é bem-vinda...

 

vlw desde já

Compartilhar este post


Link para o post
Compartilhar em outros sites

Marcio.theis...

 

não me ajudou muito...

 

fiz dakele jeito, depois voltei pro jeito que eu fiz e dá o mesmo erro de Access Violation... http://forum.imasters.com.br/public/style_emoticons/default/cry.gif http://forum.imasters.com.br/public/style_emoticons/default/cry.gif http://forum.imasters.com.br/public/style_emoticons/default/cry.gif

 

Eu usei uns breakpoint e ele dá erro quando cria o registro. Lá quando eu colokei assim: Reg:= TRegistry.Create;, dava erro....

 

será que tem que especificar só o root do registro ou toda a chave?..

 

 

vlw pela ajuda e tmbm por se disponibilizar a resolver esse pepino!! http://forum.imasters.com.br/public/style_emoticons/default/joia.gif http://forum.imasters.com.br/public/style_emoticons/default/joia.gif http://forum.imasters.com.br/public/style_emoticons/default/joia.gif http://forum.imasters.com.br/public/style_emoticons/default/joia.gif

Compartilhar este post


Link para o post
Compartilhar em outros sites

Experimente fazer desta forma

 

Reg := TRegistry.Create;

try

Reg.RootKey := HKEY_LOCAL_MACHINE;

if Reg.OpenKey('\Software\SystemDeveloper'',False) then begin

Compartilhar este post


Link para o post
Compartilhar em outros sites

×

Informação importante

Ao usar o fórum, você concorda com nossos Termos e condições.