Mega Code Archive
Regedit[component]
<![CDATA[
//www.dronymc.cjb.net
//drony@mynet.com
// icq:266148308
//Delphi 7 ile sorunsuz çalışmaktadır.
vaktinde bu componentin yaptığı işi yapabilmesi için uzun uzun ve complex kodlar yazıp kafayı yemiştim.
ama sizi artık bu dertten kurtarıyorum (bu arada componentin programcısı el ispanyo, ispanyolca(portekiz ispanyolcası) yapmış manyak
walla gözüm karardı telif hakkı falan demeden ingilizceye çevirdim.(isteyen portekizcede kullanabilir)
unit RegCheckBox;
interface
uses
Windows, Messages, SysUtils, Classes, Controls, StdCtrls,
Dialogs,
Variants,
Registry;
const
MAX_BUFFER = 20;
CompCaption = 'RegCheck';
var
Quantidade : LongInt=0;
Buffer : Array[0..MAX_BUFFER-1] of Byte;
Tamanho : Integer;
ArqConf : String;
DebugarErros : Boolean=True;
type
TLanguage = (PORT,ENG);
TRootKeys = (HKCU,HKLM,HKCR);
TKeyType = (BOOL,INT,STR,BIN);
TString1 = String[1];
// Define witch language will be used. Default : Portuguese. To use english,
// delete or put a comment to this definitition
{$DEFINE INCLUDEMESSAGES} // Define se deseja compilar as mensagens de aviso ou erros. Exclua essa linha se deseja
// um arquivo executável menor.
// Define if the erros messages will be compiled. Exclude this line or definition
// if a small code is necessary.
TRegCheckBox = class(TCheckBox)
private
{ Private declarations }
pID : String;
pSempreCriaChave : Boolean;
pRootKey : HKEY;
pRootKeyTemp : TRootKeys;
pCaminhoDaChave : String;
pNomeChave : String;
pValor : Variant;
pTipoDado : TKeyType;
pCondicao : String;
procedure SetRootKey(lRootKey : TRootKeys);
procedure SetTipoDado(Valor : TKeyType);
procedure AlteraChave;
protected
{ Protected declarations }
procedure Click; override;
public
{ Public declarations }
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function LerConteudoDaChave : Variant;
published
{ Published declarations }
property a_RootKey : TRootKeys read pRootKeyTemp write SetRootKey stored True default HKCU;
property a_ID : String read pID write pID;
{$IFDEF USEPORTUGUESE}
property a_SempreCriaChave : Boolean read pSempreCriaChave write pSempreCriaChave stored True default False;
property a_CaminhoDaChave : String read pCaminhoDaChave write pCaminhoDaChave;
property a_NomeChave : String read pNomeChave write pNomeChave;
property a_Valor : Variant read pValor write pValor;
property a_TipoDeDado : TKeyType read pTipoDado write SetTipoDado;
property a_Condicao : String read pCondicao write pCondicao;
{$ELSE}
property a_AllwaysCreateKey : Boolean read pSempreCriaChave write pSempreCriaChave stored True default False;
property a_KeyPath : String read pCaminhoDaChave write pCaminhoDaChave;
property a_KeyName : String read pNomeChave write pNomeChave;
property a_Value : Variant read pValor write pValor;
property a_DataType : TKeyType read pTipoDado write SetTipoDado;
property a_Condition : String read pCondicao write pCondicao;
{$ENDIF}
end;
procedure Register;
implementation
uses
Forms;
var
Proprietario : TForm;
Reg : TRegistry;
constructor TRegCheckBox.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
Proprietario := TForm(AOwner);
Inc(Quantidade);
pID := IntToStr(Quantidade);
Caption := CompCaption + pID;
SetRootKey(pRootKeyTemp);
end;
destructor TRegCheckBox.Destroy;
begin
inherited Destroy;
Dec(Quantidade);
pID := IntToStr(Quantidade);
end;
procedure TRegCheckBox.Click;
begin
inherited Click;
if (pRootKey <> 0) and (pCaminhoDaChave <> '') and (pNomeChave <> '') then
if (Proprietario.Active) then
AlteraChave
else
else
{$IFDEF INCLUDEMESSAGES}
if (Proprietario.Active) and (DebugarErros) then
{$IFDEF USEPORTUGUESE}
ShowMessage('Não é possível tentar fazer alguma alteração se não for especificado uma chave!' + #13#10 +
'Componente: ' + Name);
{$ELSE}
ShowMessage('Its not possible to alter a key if no key value was especified!' + #13#10 +
'Component: ' + Name);
{$ENDIF}
{$ENDIF}
end;
procedure TRegCheckBox.AlteraChave;
begin
if pValor <> NULL then
try
Reg.RootKey := pRootKey;
Reg.CloseKey;
if Reg.OpenKey(pCaminhoDaChave,True) then
begin
case pTipoDado of
BOOL : Reg.WriteBool(pNomeChave,Boolean(pValor));
INT : Reg.WriteInteger(pNomeChave,pValor);
STR : Reg.WriteString(pNomeChave,pValor);
BIN : Reg.WriteBinaryData(pNomeChave,Buffer,Tamanho);
end;
Reg.CloseKey; // Finalmente, fecha a chave.
end;
except
{$IFDEF INCLUDEMESSAGES}
if (Proprietario.Active) and (DebugarErros) then
{$IFDEF USEPORTUGUESE}
ShowMessage('Ocorreu algum erro quando estava tentando abrir a chave.' + #13#10 +
'Possivelmente algum programa ou o SO está bloqueando o acesso a esta chave.');
{$ELSE}
ShowMessage('An error occurred when trying to open a key.' + #13#10 +
'Possibly another program is blocking de access to the key.');
{$ENDIF}
{$ENDIF}
end;
end;
function TRegCheckBox.LerConteudoDaChave : Variant;
var
ValExist : Boolean;
Operador : String[1];
OperadorSTR : Array[0..1] of TString1;
ValCondicao : Integer;
procedure GetBool;
begin
pValor := Reg.ReadBool(pNomeChave);
end;
procedure GetInteger;
begin
pValor := Reg.ReadInteger(pNomeChave);
end;
procedure GetString;
begin
pValor := Reg.ReadString(pNomeChave);
end;
procedure GetBinary;
begin
Tamanho := Reg.GetDataSize(pNomeChave);
if Tamanho > MAX_BUFFER then
{$IFDEF INCLUDEMESSAGES}
if (Proprietario.Active) and (DebugarErros) then
{$IFDEF USEPORTUGUESE}
ShowMessage('Erro na leitura do valor binário:' + #13#10#13#10 +
'Chave: ' + pCaminhoDaChave + '\' + pNomeChave + #13#10 +
'Quantidade de dados: ' + IntToStr(Tamanho) + #13#10 +
'Comprimento do Buffer: ' + IntToStr(MAX_BUFFER) )
{$ELSE}
ShowMessage('Error reading binary value:' + #13#10 +
'Key: ' + pCaminhoDaChave + '\' + pNomeChave + #13#10 +
'Data Lenght: ' + IntToStr(Tamanho) + #13#10 +
'Buffer Length : ' + IntToStr(MAX_BUFFER) )
{$ENDIF}
{$ENDIF}
else
else
Result := Reg.ReadBinaryData(pNomeChave,Buffer,Tamanho) = Tamanho;
end;
begin
ValExist := False;
try
Checked := False;
Reg.RootKey := pRootKey;
Reg.CloseKey;
if Reg.OpenKey(pCaminhoDaChave,pSempreCriaChave) then
begin
try
if Reg.ValueExists(pNomeChave) then
begin
ValExist := True;
case pTipoDado of // Dá preferência ao tipo de dado selecionado no Object Inspector
BOOL : GetBool;
INT : GetInteger;
STR : GetString;
BIN : GetBinary;
end;
end
else
{$IFDEF INCLUDEMESSAGES}
if (Proprietario.Active) and (DebugarErros) then
if (pCaminhoDaChave <> '') and (pNomeChave <> '') then
{$IFDEF USEPORTUGUESE}
MessageBox(Self.Handle,PChar('Caminho: ' + pCaminhoDaChave + ' ' + pNomeChave),
PChar('Erro no componente ' + Name + ' . Valor não existe.'),MB_ICONWARNING + MB_OK)
{$ELSE}
MessageBox(Self.Handle,PChar('Path: ' + pCaminhoDaChave + ' ' + pNomeChave),
PChar('Component ' + Name + ' . Value do not exists.'),MB_ICONWARNING + MB_OK)
{$ENDIF}
else
{$IFDEF USEPORTUGUESE}
MessageBox(Self.Handle,'Não foi especificado uma chave para leitura/escrita do registro.',
PChar('Erro no componente ' + Name),MB_ICONERROR + MB_OK);
{$ELSE}
MessageBox(Self.Handle,'The value for read/write was not especified.',
PChar('Component ' + Name),MB_ICONERROR + MB_OK);
{$ENDIF}
{$ENDIF}
except
if ValExist then // Se o valor existe, tenta fazer outro tipo de leitura
try
try
case Reg.GetDataType(pNomeChave) of
rdInteger : GetInteger;
rdString : GetString;
rdBinary : GetBinary;
end;
finally
if VarType(pValor) = varInteger then
if (pValor = 1) or (pValor = 0) then
begin
pValor := Boolean(pValor);
Checked := pValor;
end;
end;
except
{$IFDEF INCLUDEMESSAGES}
if (Proprietario.Active) and (DebugarErros) then
{$IFDEF USEPORTUGUESE}
ShowMessage('Não foi possível fazer a leitura da chave: ' + #13#10 +
pCaminhoDaChave + '\' + pNomeChave + ' no componente ' + Name + #13#10 +
'Provavelmente deve ser algum tipo de valor desconhecido. Implementar outro tipo de leitura.');
{$ELSE}
ShowMessage('Error reading key: ' + #13#10 +
pCaminhoDaChave + '\' + pNomeChave + ' in component ' + Name + #13#10 +
'Probably the value of the reading results in an unknown type. Implement another type of reading.');
{$ENDIF}
{$ENDIF}
end;
end;
end;
finally
if pCondicao <> '' then
begin
case pTipoDado of
INT : begin
try
Operador := Copy(pCondicao,1,1); // Extrai operador
ValCondicao := StrToInt(Copy(pCondicao,2,Length(pCondicao)));
if Operador = '>' then
Checked := ValCondicao > pValor
else
if Operador = '<' then
Checked := ValCondicao < pValor
else
if Operador = '=' then
Checked := ValCondicao = pValor
else
Checked := ValCondicao <> pValor;
except
end;
end;
STR : begin
try
OperadorSTR[0] := Copy(pCondicao,1,1);
OperadorSTR[1] := Copy(pCondicao,2,1);
if UpperCase(OperadorSTR[0]) = 'I' then // Case insensitive
begin
if OperadorSTR[1] = '=' then
Checked := UpperCase(pValor) = UpperCase(Copy(pCondicao,3,Length(pCondicao)))
else
Checked := UpperCase(pValor) <> UpperCase(Copy(pCondicao,3,Length(pCondicao)));
end
else // Case sensitive
begin
if OperadorSTR[1] = '=' then
Checked := pValor = Copy(pCondicao,3,Length(pCondicao))
else
Checked := pValor <> Copy(pCondicao,3,Length(pCondicao));
end;
except
end;
end;
BOOL: begin
Result := pValor;
Checked := pValor;
end;
end;
end;
if pTipoDado <> BIN then
Result := pValor;
Reg.CloseKey;
end;
end;
procedure TRegCheckBox.SetRootKey(lRootKey : TRootKeys);
begin
// if pRootKeyTemp <> lRootKey then
// begin
case lRootKey of
HKCU : pRootKey := HKEY_CURRENT_USER;
HKLM : pRootKey := HKEY_LOCAL_MACHINE;
HKCR : pRootKey := HKEY_CLASSES_ROOT;
end;
pRootKeyTemp := lRootKey;
Invalidate;
// end;
end;
procedure TRegCheckBox.SetTipoDado(Valor : TKeyType);
begin
FillChar(Buffer,SizeOf(Buffer),0);
pTipoDado := Valor;
case Valor of
BOOL : begin
pValor := False;
pCondicao := '';
end;
STR : begin
pValor := '';
pCondicao := '';
end;
INT,BIN : begin
pValor := 0;
pCondicao := '';
end;
end;
end;
procedure Register;
begin
RegisterComponents('Plus', [TRegCheckBox]);
end;
initialization
ArqConf := ExtractFileDir(Application.ExeName) + Application.Name;
Quantidade := 0;
Reg := TRegistry.Create;
finalization
Reg.CloseKey;
Reg.Free;
Reg := nil;
end.
]]>