Inclua na seção uses: Windows
{ Esta função liga/desliga Caps Lock, conforme o parãmetro State }
procedure tbSetCapsLock(State: boolean);
begin
if (State and ((GetKeyState(VK_CAPITAL) and 1) = 0)) or
((not State) and ((GetKeyState(VK_CAPITAL) and 1) = 1)) then
begin
keybd_event(VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY or 0, 0);
keybd_event(VK_CAPITAL, $45, KEYEVENTF_EXTENDEDKEY or KEYEVENTF_KEYUP, 0);
end;
end;
{ Exemplos de uso: }
tbSetCapsLock(true); { Liga Caps Lock }
tbSetCapsLock(false); { Desliga Caps Lock }
Observações
Aparentemente, podemos usar esta mesma técnica para ligar/desligar Num Lock. Neste caso trocaríamos VK_CAPITAL por VK_NUMLOCK. Por incrível que pareça não funcionou (pelo menos no teste que fiz). E tem mais: isto está na documentação do (R)Windows.
sexta-feira, 13 de agosto de 2010
Descobrir o código ASCII de uma tecla
- Coloque um Label no form (Label1);
- Mude a propriedade KeyPreview do form para true;
- Altere o evento OnKeyDown do form como abaixo:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Label1.Caption :=
Format('O código da tecla pressionada é: %d', [Key]);
end;
Observações
Para testar execute e observe o Label enquanto pressiona as teclas desejadas.
- Mude a propriedade KeyPreview do form para true;
- Altere o evento OnKeyDown do form como abaixo:
procedure TForm1.FormKeyDown(Sender: TObject; var Key: Word;
Shift: TShiftState);
begin
Label1.Caption :=
Format('O código da tecla pressionada é: %d', [Key]);
end;
Observações
Para testar execute e observe o Label enquanto pressiona as teclas desejadas.
Como usar as teclas de função F1, F2, etc
- Para você colocar chamadas usando as teclas de função basta colocar o seguinte código no evento 'OnKeyDown' do formulário:
procedure Tform1.FormKeyDown(Sender:TObject; var Key: Word; Shift: TShifState);
begin
if key = vk_F1 then begin
{ instrucoes a serem executadas }
end;
end;
- OBSERVAÇÃO:
Não se esqueça de colocar a propriedade 'KeyPreview' do formulário em 'True'.
Você também pode usar as variáveis VK_F1 até VK_F12 referentes as outras teclas de função.
quinta-feira, 12 de agosto de 2010
Traduzindo a mensagem "Delete Record ?"
Quando clicamos sobre o botão de deleção no DBNavigator (o do sinal de menos) surge uma box com a mensagem "Delete Record?" com botões Ok e Cancel.
Para fazer aparecer a mensagem em português deverá selecionar o componente Table e mudar a propriedade ConfirmDelete para False e no evento da tabela BeforeDelete colocar o seguinte:
procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);
begin
if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;
end;
Para fazer aparecer a mensagem em português deverá selecionar o componente Table e mudar a propriedade ConfirmDelete para False e no evento da tabela BeforeDelete colocar o seguinte:
procedure TForm1.Table1BeforeDelete(DataSet:TDataSet);
begin
if MessageDlg('Eliminar o Registro?',mtConfirmation,[mbYes,mbNo],0)<>mrYes then Abort;
end;
Tradução de Mensagens
Depois de algum tempo pesquisando uma forma de fazer aparecer as mensagens em português, consegui uma solução muito fácil de implementar no ambientede programação do Delphi.
CHEGA DE YES/NO !!!
messagedlg('Confirma ? mtConfirmation, [mbYes, mbNo], 0);
Aí vai:
1 - No diretório DELPHI\LIB, copie o arquivo consts.dcu para consts.old;
2 - Inicie o Delphi e crie um nova Unit;
3 - Insira nesta, o arquivo consts.int do diretório DELPHI\DOC E faça as devidas alterações nas mensagens que desejares alterar e nas partes duplicadas da Unit como "implement" e etc, também deixe o cabeçalho como Unit Consts.
4 - Salve esta nova Unit no diretório DELPHI\LIB e pronto todas as mensagens alteradas por você estarão aplicadas nos seus próximos programas sem uma linha de programa e da forma que você quiser.
No Delphi você deve nenomear o arquivo consts.dcu para consts.old e modificar o arquivo constst.pas. (Há outros arquivos *consts*.pas que podem ser modificados).
CHEGA DE YES/NO !!!
messagedlg('Confirma ? mtConfirmation, [mbYes, mbNo], 0);
Aí vai:
1 - No diretório DELPHI\LIB, copie o arquivo consts.dcu para consts.old;
2 - Inicie o Delphi e crie um nova Unit;
3 - Insira nesta, o arquivo consts.int do diretório DELPHI\DOC E faça as devidas alterações nas mensagens que desejares alterar e nas partes duplicadas da Unit como "implement" e etc, também deixe o cabeçalho como Unit Consts.
4 - Salve esta nova Unit no diretório DELPHI\LIB e pronto todas as mensagens alteradas por você estarão aplicadas nos seus próximos programas sem uma linha de programa e da forma que você quiser.
No Delphi você deve nenomear o arquivo consts.dcu para consts.old e modificar o arquivo constst.pas. (Há outros arquivos *consts*.pas que podem ser modificados).
Como saber se o CD está no drive
Function MidiaPresente(MediaPlayer: TMediaPlayer): Boolean;
var
Params: MCI_STATUS_PARMS;
S: array [0.255] of char;
r: Integer;
begin
//verifica se existe um cd inserido
Params.dwItem:= MCI_STATUS_MEDIA_PRESENT;
r:= MCISendCommand(MediaPlayer.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Integer(Addr(Params)));
if r <> 0 then
begin
MCIGetErrorString(r, S, SizeOf(S));
ShowMessage('Erro: ' + StrPas(S));
end
else
Result:= Params.dwReturn = 1;
end;
var
Params: MCI_STATUS_PARMS;
S: array [0.255] of char;
r: Integer;
begin
//verifica se existe um cd inserido
Params.dwItem:= MCI_STATUS_MEDIA_PRESENT;
r:= MCISendCommand(MediaPlayer.DeviceID, MCI_STATUS, MCI_STATUS_ITEM, Integer(Addr(Params)));
if r <> 0 then
begin
MCIGetErrorString(r, S, SizeOf(S));
ShowMessage('Erro: ' + StrPas(S));
end
else
Result:= Params.dwReturn = 1;
end;
Relatórios em HTML
QuickRep1.ExportToFilter(TQRHtmlExportFilter.Create('teste.html'));
FindNearest numa Query
Query1.Locate('campo onde ira porcurar','Texto a buscar',[loPartialKey,loCaseInsensitive]);
Preenche com quantidade determinada de zeros o lado esquerdo de uma string
unit Zero;
interface
function RetZero(ZEROS:string;QUANT:integer):String;
implementation
function RetZero(ZEROS:string;QUANT:integer):String;
var
I,Tamanho:integer;
aux: string;
begin
aux:=zeros;
Tamanho:=length(ZEROS);
ZEROS:='';
for I:=1 to quant-tamanho do
ZEROS:=ZEROS+'0';
aux:=zeros+aux;
RetZero:=aux;
end;
end.
interface
function RetZero(ZEROS:string;QUANT:integer):String;
implementation
function RetZero(ZEROS:string;QUANT:integer):String;
var
I,Tamanho:integer;
aux: string;
begin
aux:=zeros;
Tamanho:=length(ZEROS);
ZEROS:='';
for I:=1 to quant-tamanho do
ZEROS:=ZEROS+'0';
aux:=zeros+aux;
RetZero:=aux;
end;
end.
Gera número por extenso
unit Ext;
interface
function extenso (valor: real): string;
implementation
uses
SysUtils, Dialogs;
function extenso (valor: real): string;
var
Centavos, Centena, Milhar, Milhao, Texto, msg: string;
const
Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco', 'Seis', 'Sete', 'Oito', 'Nove');
Dez: array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze', 'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');
Dezenas: array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta', 'Sessenta', 'Setenta', 'Oitenta', 'Noventa');
Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos', 'Quinhentos', 'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');
function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;
begin
if Expressao
then Result:=CasoVerdadeiro
else Result:=CasoFalso;
end;
function MiniExtenso (trio: string): string;
var
Unidade, Dezena, Centena: string;
begin
Unidade:='';
Dezena:='';
Centena:='';
if (trio[2]='1') and (trio[3]<>'0') then
begin
Unidade:=Dez[strtoint(trio[3])];
Dezena:='';
end
else
begin
if trio[2]<>'0' then Dezena:=Dezenas[strtoint(trio[2])];
if trio[3]<>'0' then Unidade:=Unidades[strtoint(trio[3])];
end;
if (trio[1]='1') and (Unidade='') and (Dezena='')
then Centena:='cem'
else
if trio[1]<>'0'
then Centena:=Centenas[strtoint(trio[1])]
else Centena:='';
Result:= Centena + ifs((Centena<>'') and ((Dezena<>'') or (Unidade<>'')), ' e ', '')
+ Dezena + ifs((Dezena<>'') and (Unidade<>''),' e ', '') + Unidade;
end;
begin
if (valor>999999.99) or (valor<0) then
begin
msg:='O valor está fora do intervalo permitido.';
msg:=msg+'O número deve ser maior ou igual a zero e menor que 999.999,99.';
msg:=msg+' Se não for corrigido o número não será escrito por extenso.';
showmessage(msg);
Result:='';
exit;
end;
if valor=0 then
begin
Result:='';
Exit;
end;
Texto:=formatfloat('000000.00',valor);
Milhar:=MiniExtenso(Copy(Texto,1,3));
Centena:=MiniExtenso(Copy(Texto,4,3));
Centavos:=MiniExtenso('0'+Copy(Texto,8,2));
Result:=Milhar;
if Milhar<>'' then
if copy(texto,4,3)='000' then
Result:=Result+' Mil Reais'
else
Result:=Result+' Mil, ';
if (((copy(texto,4,2)='00') and (Milhar<>'')
and (copy(texto,6,1)<>'0')) or (centavos=''))
and (Centena<>'') then Result:=Result+' e ';
if (Milhar+Centena <>'') then Result:=Result+Centena;
if (Milhar='') and (copy(texto,4,3)='001') then
Result:=Result+' Real'
else
if (copy(texto,4,3)<>'000') then Result:=Result+' Reais';
if Centavos='' then
begin
Result:=Result+'.';
Exit;
end
else
begin
if Milhar+Centena='' then
Result:=Centavos
else
Result:=Result+', e '+Centavos;
if (copy(texto,8,2)='01') and (Centavos<>'') then
Result:=Result+' Centavo.'
else
Result:=Result+' Centavos.';
end;
end;
end.
interface
function extenso (valor: real): string;
implementation
uses
SysUtils, Dialogs;
function extenso (valor: real): string;
var
Centavos, Centena, Milhar, Milhao, Texto, msg: string;
const
Unidades: array[1..9] of string = ('Um', 'Dois', 'Tres', 'Quatro', 'Cinco', 'Seis', 'Sete', 'Oito', 'Nove');
Dez: array[1..9] of string = ('Onze', 'Doze', 'Treze', 'Quatorze', 'Quinze', 'Dezesseis', 'Dezessete', 'Dezoito', 'Dezenove');
Dezenas: array[1..9] of string = ('Dez', 'Vinte', 'Trinta', 'Quarenta', 'Cinquenta', 'Sessenta', 'Setenta', 'Oitenta', 'Noventa');
Centenas: array[1..9] of string = ('Cento', 'Duzentos', 'Trezentos', 'Quatrocentos', 'Quinhentos', 'Seiscentos', 'Setecentos', 'Oitocentos', 'Novecentos');
function ifs(Expressao: Boolean; CasoVerdadeiro, CasoFalso: String): String;
begin
if Expressao
then Result:=CasoVerdadeiro
else Result:=CasoFalso;
end;
function MiniExtenso (trio: string): string;
var
Unidade, Dezena, Centena: string;
begin
Unidade:='';
Dezena:='';
Centena:='';
if (trio[2]='1') and (trio[3]<>'0') then
begin
Unidade:=Dez[strtoint(trio[3])];
Dezena:='';
end
else
begin
if trio[2]<>'0' then Dezena:=Dezenas[strtoint(trio[2])];
if trio[3]<>'0' then Unidade:=Unidades[strtoint(trio[3])];
end;
if (trio[1]='1') and (Unidade='') and (Dezena='')
then Centena:='cem'
else
if trio[1]<>'0'
then Centena:=Centenas[strtoint(trio[1])]
else Centena:='';
Result:= Centena + ifs((Centena<>'') and ((Dezena<>'') or (Unidade<>'')), ' e ', '')
+ Dezena + ifs((Dezena<>'') and (Unidade<>''),' e ', '') + Unidade;
end;
begin
if (valor>999999.99) or (valor<0) then
begin
msg:='O valor está fora do intervalo permitido.';
msg:=msg+'O número deve ser maior ou igual a zero e menor que 999.999,99.';
msg:=msg+' Se não for corrigido o número não será escrito por extenso.';
showmessage(msg);
Result:='';
exit;
end;
if valor=0 then
begin
Result:='';
Exit;
end;
Texto:=formatfloat('000000.00',valor);
Milhar:=MiniExtenso(Copy(Texto,1,3));
Centena:=MiniExtenso(Copy(Texto,4,3));
Centavos:=MiniExtenso('0'+Copy(Texto,8,2));
Result:=Milhar;
if Milhar<>'' then
if copy(texto,4,3)='000' then
Result:=Result+' Mil Reais'
else
Result:=Result+' Mil, ';
if (((copy(texto,4,2)='00') and (Milhar<>'')
and (copy(texto,6,1)<>'0')) or (centavos=''))
and (Centena<>'') then Result:=Result+' e ';
if (Milhar+Centena <>'') then Result:=Result+Centena;
if (Milhar='') and (copy(texto,4,3)='001') then
Result:=Result+' Real'
else
if (copy(texto,4,3)<>'000') then Result:=Result+' Reais';
if Centavos='' then
begin
Result:=Result+'.';
Exit;
end
else
begin
if Milhar+Centena='' then
Result:=Centavos
else
Result:=Result+', e '+Centavos;
if (copy(texto,8,2)='01') and (Centavos<>'') then
Result:=Result+' Centavo.'
else
Result:=Result+' Centavos.';
end;
end;
end.
Verifica Validade de CGC e CPF
unit CPFeCGC;
interface
function cpf(num: string): boolean;
function cgc(num: string): boolean;
implementation
uses SysUtils;
function cpf(num: string): boolean;
var
n1,n2,n3,n4,n5,n6,n7,n8,n9: integer;
d1,d2: integer;
digitado, calculado: string;
begin
n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[4]);
n5:=StrToInt(num[5]);
n6:=StrToInt(num[6]);
n7:=StrToInt(num[7]);
n8:=StrToInt(num[8]);
n9:=StrToInt(num[9]);
d1:=n9*2+n8*3+n7*4+n6*5+n5*6+n4*7+n3*8+n2*9+n1*10;
d1:=11-(d1 mod 11);
if d1>=10 then d1:=0;
d2:=d1*2+n9*3+n8*4+n7*5+n6*6+n5*7+n4*8+n3*9+n2*10+n1*11;
d2:=11-(d2 mod 11);
if d2>=10 then d2:=0;
calculado:=inttostr(d1)+inttostr(d2);
digitado:=num[10]+num[11];
if calculado=digitado then
cpf:=true
else
cpf:=false;
end;
function cgc(num: string): boolean;
var
n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12: integer;
d1,d2: integer;
digitado, calculado: string;
begin
n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[4]);
n5:=StrToInt(num[5]);
n6:=StrToInt(num[6]);
n7:=StrToInt(num[7]);
n8:=StrToInt(num[8]);
n9:=StrToInt(num[9]);
n10:=StrToInt(num[10]);
n11:=StrToInt(num[11]);
n12:=StrToInt(num[12]);
d1:=n12*2+n11*3+n10*4+n9*5+n8*6+n7*7+n6*8+n5*9+n4*2+n3*3+n2*4+n1*5;
d1:=11-(d1 mod 11);
if d1>=10 then d1:=0;
d2:=d1*2+n12*3+n11*4+n10*5+n9*6+n8*7+n7*8+n6*9+n5*2+n4*3+n3*4+n2*5+n1*6;
d2:=11-(d2 mod 11);
if d2>=10 then d2:=0;
calculado:=inttostr(d1)+inttostr(d2);
digitado:=num[13]+num[14];
if calculado=digitado then
cgc:=true
else
cgc:=false;
end;
end.
interface
function cpf(num: string): boolean;
function cgc(num: string): boolean;
implementation
uses SysUtils;
function cpf(num: string): boolean;
var
n1,n2,n3,n4,n5,n6,n7,n8,n9: integer;
d1,d2: integer;
digitado, calculado: string;
begin
n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[4]);
n5:=StrToInt(num[5]);
n6:=StrToInt(num[6]);
n7:=StrToInt(num[7]);
n8:=StrToInt(num[8]);
n9:=StrToInt(num[9]);
d1:=n9*2+n8*3+n7*4+n6*5+n5*6+n4*7+n3*8+n2*9+n1*10;
d1:=11-(d1 mod 11);
if d1>=10 then d1:=0;
d2:=d1*2+n9*3+n8*4+n7*5+n6*6+n5*7+n4*8+n3*9+n2*10+n1*11;
d2:=11-(d2 mod 11);
if d2>=10 then d2:=0;
calculado:=inttostr(d1)+inttostr(d2);
digitado:=num[10]+num[11];
if calculado=digitado then
cpf:=true
else
cpf:=false;
end;
function cgc(num: string): boolean;
var
n1,n2,n3,n4,n5,n6,n7,n8,n9,n10,n11,n12: integer;
d1,d2: integer;
digitado, calculado: string;
begin
n1:=StrToInt(num[1]);
n2:=StrToInt(num[2]);
n3:=StrToInt(num[3]);
n4:=StrToInt(num[4]);
n5:=StrToInt(num[5]);
n6:=StrToInt(num[6]);
n7:=StrToInt(num[7]);
n8:=StrToInt(num[8]);
n9:=StrToInt(num[9]);
n10:=StrToInt(num[10]);
n11:=StrToInt(num[11]);
n12:=StrToInt(num[12]);
d1:=n12*2+n11*3+n10*4+n9*5+n8*6+n7*7+n6*8+n5*9+n4*2+n3*3+n2*4+n1*5;
d1:=11-(d1 mod 11);
if d1>=10 then d1:=0;
d2:=d1*2+n12*3+n11*4+n10*5+n9*6+n8*7+n7*8+n6*9+n5*2+n4*3+n3*4+n2*5+n1*6;
d2:=11-(d2 mod 11);
if d2>=10 then d2:=0;
calculado:=inttostr(d1)+inttostr(d2);
digitado:=num[13]+num[14];
if calculado=digitado then
cgc:=true
else
cgc:=false;
end;
end.
Protegendo o seu programa e o seu bolso
Caso você seja um desenvolvedor contratado por alguma empresa criando sistemas específicos para cada cliente talvez isto nunca seja uma preocupação séria pois há poucas possibilidades do sistema interessar outra pessoa física ou jurídica com características operacionais diferentes (não estou me referindo a código-fonte aqui mas ao produto acabado).
Mas caso você esteja no mercado de softwares para o público em geral, bem-vindo ao grande clube dos programas pirateados. Este artigo visa introduzir alguns conceitos de proteção de software para programadores em geral mas antes de começarmos há uma coisa muito importante sobre a qual gostaria de dizer: Muitas grandes empresas liberam softwares com baixa proteção contra pirataria exatamente visando uma divulgação indireta do produto (ocorre muito com componentes para Delphi, a maioria possui uma chave publicamente divulgada). É uma tática que dá certo em países aonde há uma certa lei e consciência por parte dos usuários com software mas isto acredito não se aplica ao Brasil.Um conselho: não faça isso ! Ninguém vai comprar aqui o seu produto e a quantidade que comprar não cobrirá os custo do desenvolvimento.
Você poderá distribuir o seu software como produto de prateleira ou como um shareware pela Internet. A grande vantagem do shareware é a divulgação boca à boca (ou seria clique à clique ?) que ele oferece mas o ideal é as duas abordagens ao mesmo tempo. Isto possibilita que o usuário que ficou hesitante em adquirir o produto na loja possa baixar e testá-lo. Obviamente nunca esqueça de divulgar o seu site na embalagem.
Para vender software, um bem intangível materialmente, é preciso um bom sistema de proteção pois o seu programa poderá virar um freeware em poucos segundo. É só encontrar um hacker que goste dele. Interessante é que dificilmente um hacker irá quebrar a proteção de um produto do qual não goste ou não use, portanto quando encontrar cracks para o seu programa em vários sites da web sinta-se elogiado ! Depois pode ficar triste por não ter recebido um tostão com o seu trabalho.
Algumas técnicas de proteção (os prós e contras)
Para avaliação do software:
Nag-Screen: O programa sempre exibe uma tela avisando que é uma cópia de execução restrita (ou algo semelhante) e solicita o registro do mesmo por um determinando período.
Prós: O Usuário sempre é lembrado com uma tela de aviso que está com uma cópia restrita ou não totalmente funcional. Alguns nag-screens apenas roubam um pouco do tempo de uso do software mas não chegam a atrapalhar o uso efetivo, o que é ótimo para o usuário: a lógica da comida grátis que vicia.
Contras: Se a limitação for apenas o nag-screen todo mundo se acostuma com ela e depois de um certo tempo até se esquece que ela existe. Não é eficiente.
Período: Um programa funciona dentro de um certo período de avaliação.
Prós: O usuário usará todo o software com todos os recursos e poderá testar tudo.
Contras: É comum o usuário esquecer que está com uma cópia de avaliação. Alguns softwares, com uma péssima proteção, podem ser contornados simplesmente voltando o calendário do sistema.
Recursos Chaves Desabilitados: O programa possui alguns recursos que não funcionam como opções para salvar, exportar etc.
Prós: O Usuário tem mais liberdade que todos os métodos acima e sempre que tentar fazer o salvamento de dados lembrará que está com um software não totalmente funcional forçando uma compra.
Contras: É uma das formas mais fáceis de um programa receber um crack para liberar o recurso protegido.
Para licenciamento do software:
Número Serial: O Programa possui um número único serial que o habilita completamente.
Prós: O usuário somente digita o serial e pronto, o programa está liberado. Ideal para softwares de prateleira aonde o usuário já adquiriu o produto. O sistema preferido para a divulgação indireta.
Contras: Centenas de outros usuários somente digitam o mesmo serial e pronto: centenas de programas registrados. Use esta forma caso não deseje receber pelo seu programa ou queira uma divulgação indireta do mesmo e esperar pela consciência do usuário, isso não funciona no Brasil. Centenas ou milhares de usuário podem usar o mesmo serial. Esta caindo em desuso rapidamente pois há centenas de sites com index sofisticados de seriais para qualquer programa o que torna o sistema quase completamente inútil hoje em dia.
HardLocks: Um pequeno dispositivo é colocado na porta serial, paralela ou USB com uma identificação única para liberar o funcionamento do sistema.
Prós: Um dos sistemas mais difíceis de serem quebrados e definitivamente o mais seguro. Garante a taxa de uma licença por máquina o que é o ideal. Para sistemas caros (algo acima de $1000,00) considere seriamente o uso de HardLocks.
Contras: Custo do HardLock por cópia licenciada e alguns problemas (raros) com periféricos usando aquela mesma porta, mas nada tão sério assim para prejudicar o usuário. As portas seriais e paralelas estão caindo em desuso com o USB e já existem HardLocks para elas também. Os Hardlocks pode apresentar defeitos dependendo do tipo.
Você deve adquirir um kit de gravação e um Hardlock para cada cópia de distribuição. Não é muito caro mas o seu software deve compensar isto obviamente.
Disquete de Habilitação: Um disquete é fornecido junto com o programa para a sua habilitação ou desabilitação.
Prós: É o hardlock dos pobres sem o mesmo nível de proteção.
Contras: Não faça proteção via disquetes de habilitação/desabilitação como o Dr. Case e outros. É perda de tempo ! Há vários utilitários que fazem a cópia perfeita do disquete sendo possível habilitá-lo em qualquer máquina. E ainda pode-se ter o problema de superfície no disco e um belo dia quando o usuário precisar instalar o software em outra máquina ele terá a surpresa do disco já mofado ou perdido. Tenha certeza que isto sempre acontece no final de semana quando ele liga para o seu escritório na segunda descarregando o seu vocabulário.
Identidade Única: Uma das melhores e mais eficientes tipos de proteções é de identidade do equipamentos recentemente implementado pela própria Microsoft. Isto consiste em recolher dados únicos sobre o seu computador como serial do HD, informação da BIOS (não aconselhável), Versão do OS, Nome do computador etc. Com base nestas informações você poderá gerar uma fechadura de identificação. Essa fechadura precisará de uma chave fornecida por você para habilitar o seu software unicamente para aquela máquina.
Prós: Difícil de ser quebrado quando bem implementado e permite alta adaptabilidade contra cracks criado contra o sistema como patchs invisíveis que permitem a modificação do sistema. Permite a taxa de apenas uma licença por computador.
Contras: Caso o usuário formate a maquina, modifique periféricos chaves o sistema pode desabilitar a cópia automaticamente. Isto cria problemas com a solicitação de uma nova licença para instalação. O usuário pode simplesmente ligar alegando este fato e de boa fé você terá que fornecer uma nova liberação.
Habilitação Pela Internet: Ao adquirir um produto o usuário recebe uma senha que permite a geração de um número para habilitação e instalação em uma máquina.
Prós: Após habilitar, o número é automaticamente invalidado para outros usuário o que evita o problema de divulgação do mesmo pela rede.
Contras: O seu site deve estar em um provedor 100% confiável ou esteja preparado para aquele cliente que comprou o produto no sábado a tarde e o seu site ficou fora do ar no domingo sem ele poder autorizar o software para o uso.
Conclusão
Não há método melhor ou pior na minha opinião para proteger um programa mas, mais trabalhoso ou menos trabalhoso para um hacker quebrar. O Ideal é que que você use duas ou mais técnicas para proteger o programa.
Há um princípio básico que ao se usar dois sistemas simples de proteção independentes cria-se um sistema forte de proteção. Por exemplo, caso use o sistema de data é fácil monitorar aonde se esta gravando esta informação (quando o programa foi instalado) e adiar o tempo limite de uso. Nag-Screens podem ser rastreadas e um hacker com bons conhecimentos de assembler pode editar diretamente o seu código binário fazendo jumps nas avaliações de restrições. Agora combinando duas ou três técnicas as coisas complicam para ele e talvez o trabalho não valha a pena (coisa que ele realmente não é acostumado).
Mas antes de começar a desenvolver o sistema de proteção para o seu programa, siga algumas dicas que aprendemos depois de muito prejuízo com pirataria.
1- Nunca coloque literalmente as mensagens referentes a registro, nag-screens, avisos de limitação e etcs, em um formato legível para um ser humano. Faça uma encriptação destas mensagens. Uma técnica bem simples dos hackers consiste em procurar no código binário por uma determinada ocorrência tipo " Cópia Trial" e perto tem um "IF" aonde se pode bloquear e lá se foi a sua proteção. Portanto, faça uma função de codificação e decodificação e grave todas as mensagens codificadas no seu programa (no código-fonte) sendo que as mesmas somente serão exibidas quando você chamar a função de decodificação.
2- Faça uma estampa no software. Ou seja, todos os programas possuem uma informação referente ao seu tamanho físico, data e hora de criação e CRC. Caso o seu programa tenha sido alterado após aquela data, através de uma função, o programa poderá verificar em sua estampa interna se ele foi modificado. Aqui pode ocorrer alguns problemas com programas anti-virus que usam a mesma técnica para monitorar alteração de executáveis aplicando uma "vacina" neles mas já é da responsabilidade do usuário.
3- Grave dados no registry sempre encriptados e, se eles forem sobre as informações de registro nunca coloque na mesma árvore das outras definições do seu software. Isto dificulta e muito as coisa. Mas se o hacker possui um programa de monitoramento do registry ele poderá facilmente contornar isto mas não antes sem um bom trabalho de adivinhação. E, nunca use chaves com nomes óbvios tipo "Serial", "SenhaPrograma", "DataLimite" e etc. Dê sempre preferência a gravar dados de configuração e autorização no registry do que em arquivos INI (lembra-se deles ?). O registry é mais difícil de ser manipulado por um leigo e é possível colocar chaves observando a mudança de outras chaves o que torna as coisas mais complexas.
4- Se possível, implemente um sistema periódico de verificação da licença via site na web.
Coloque este alerta em seu termo de uso do seu software e o faça de tal forma que seja invisível, indolor (não fique interrompendo o usuário) e que desabilite o software imediatamente ao verificar uma cópia com o número de série irregular ou divulgado. É importante aqui implementar nos CGI do site um alerta via e-mail quando ocorrer várias tentativas de liberação de um mesmo serial. Assim você descobre rapidamente quem vazou um serial para o público.
5- Tenha uma proteção não divulgada. Por exemplo, após o software executar 300 vezes uma mensagem surge do nada indicando o download de uma cópia mais atualizada. Nesta nova cópia você já deve ter contornado todos os problemas com cracks que apareceram no período.
6- Faça Check Point em pontos não óbvios do seu software e em vários lugares. Use uma periodicidade completamente aleatória para fazer isto. Por exemplo, quando o usuário abrir uma determinada tela não muito utilizada, ocorre uma verificação em background sobre a validade da licença esta verificação pode e deve ser aleatória. Após validar e algo estiver errado, nunca exiba no mesmo momento que a licença é irregular pois se torna uma referência para o Hacker aonde ele deve procurar no código binário para quebrar o seu programa. Lembre-se que tudo serve como marcação no código binário: um caption de um form, o conteúdo string de um controle etc.
7- Use constantes. Abuse delas em vez de escrever diretamente nos dialogs para comunicação com usuário. Faça uma Unit separada aonde somente é armazenado estas constantes. Isso confunde quem olha o código binário do executável pois fisicamente no executável elas não estarão próximas.
Todas estas informações foram adquiridas com a nossa experiência e, principalmente, com dicas de dois conhecidos especialistas em quebras de programas e criação de cracks. Na primeira divulgação de um dos nossos softwares um deles me retornou uma cópia crackeada em questão de horas (segundo ele, estava sem tempo por isso demorou tanto), e ficamos envergonhados para dizer a verdade. Depois ao implementarmos a codificação de string e outras técnicas, ele levou uma semana mas não conseguiu liberar todos os recursos. Ao ativarmos os sistemas randômicos de verificação em background e validação pelo site ainda não tivemos uma quebra. Claro que ela irá ocorrer, mas enquanto isto estamos recebendo pelo nosso trabalho.
Acho que seguindo estas dicas você terá uma boa chance de receber pelo seu trabalho na quantidade justa. Lembre-se que há uma legião de pessoas ai fora tentando quebrar a proteção pelo simples prazer de dizer que foram eles.
Portanto a questão não é fazer um sistema 100% seguro (o que é quase impossível) mas um que seja 110% trabalhoso para eles. Tenha em mente também que eles são em maior número e problema não é se vão quebrar a segurança mas quando e o que você vai fazer em seguida.
Não poderíamos terminar este artigo sem falar sobre alguns componentes para proteção.
Uma coisa que percebi é que certos componentes de proteção são tão complicados que você as vezes tem que passar uma semana implementando ele no seu sistema. Mas aqui estão alguns que são ótimos pela simplicidade e fácil implementação.:
OnGuard (TurboPower) - Não é propaganda pessoal ! Os componentes da TurboPower tem uma grande qualidade e o OnGuard faz tudo o que se precisa de proteção. Validação e criação de serial, limitação por data, estampa no executável, dias de execução e muito mais. A grande vantagem é que há exemplos para tudo que podem ser fácil e rapidamente adaptados.
Lock&Key - Gosto do Lock&Key pela sua simplicidade de uso. Ele gera uma "fechadura" com base nos dados do HD do usuário e com este número-fechadura você cria um número único para liberar o software. Trabalha com níveis o que é ideal para proteção progressiva. Não estamos usando mais este, apesar de sua boa qualidade.
SharewareIt - Crie sistemas de shareware de forma bem simples. A vantagem é que é gratuito.
Mas caso você esteja no mercado de softwares para o público em geral, bem-vindo ao grande clube dos programas pirateados. Este artigo visa introduzir alguns conceitos de proteção de software para programadores em geral mas antes de começarmos há uma coisa muito importante sobre a qual gostaria de dizer: Muitas grandes empresas liberam softwares com baixa proteção contra pirataria exatamente visando uma divulgação indireta do produto (ocorre muito com componentes para Delphi, a maioria possui uma chave publicamente divulgada). É uma tática que dá certo em países aonde há uma certa lei e consciência por parte dos usuários com software mas isto acredito não se aplica ao Brasil.Um conselho: não faça isso ! Ninguém vai comprar aqui o seu produto e a quantidade que comprar não cobrirá os custo do desenvolvimento.
Você poderá distribuir o seu software como produto de prateleira ou como um shareware pela Internet. A grande vantagem do shareware é a divulgação boca à boca (ou seria clique à clique ?) que ele oferece mas o ideal é as duas abordagens ao mesmo tempo. Isto possibilita que o usuário que ficou hesitante em adquirir o produto na loja possa baixar e testá-lo. Obviamente nunca esqueça de divulgar o seu site na embalagem.
Para vender software, um bem intangível materialmente, é preciso um bom sistema de proteção pois o seu programa poderá virar um freeware em poucos segundo. É só encontrar um hacker que goste dele. Interessante é que dificilmente um hacker irá quebrar a proteção de um produto do qual não goste ou não use, portanto quando encontrar cracks para o seu programa em vários sites da web sinta-se elogiado ! Depois pode ficar triste por não ter recebido um tostão com o seu trabalho.
Algumas técnicas de proteção (os prós e contras)
Para avaliação do software:
Nag-Screen: O programa sempre exibe uma tela avisando que é uma cópia de execução restrita (ou algo semelhante) e solicita o registro do mesmo por um determinando período.
Prós: O Usuário sempre é lembrado com uma tela de aviso que está com uma cópia restrita ou não totalmente funcional. Alguns nag-screens apenas roubam um pouco do tempo de uso do software mas não chegam a atrapalhar o uso efetivo, o que é ótimo para o usuário: a lógica da comida grátis que vicia.
Contras: Se a limitação for apenas o nag-screen todo mundo se acostuma com ela e depois de um certo tempo até se esquece que ela existe. Não é eficiente.
Período: Um programa funciona dentro de um certo período de avaliação.
Prós: O usuário usará todo o software com todos os recursos e poderá testar tudo.
Contras: É comum o usuário esquecer que está com uma cópia de avaliação. Alguns softwares, com uma péssima proteção, podem ser contornados simplesmente voltando o calendário do sistema.
Recursos Chaves Desabilitados: O programa possui alguns recursos que não funcionam como opções para salvar, exportar etc.
Prós: O Usuário tem mais liberdade que todos os métodos acima e sempre que tentar fazer o salvamento de dados lembrará que está com um software não totalmente funcional forçando uma compra.
Contras: É uma das formas mais fáceis de um programa receber um crack para liberar o recurso protegido.
Para licenciamento do software:
Número Serial: O Programa possui um número único serial que o habilita completamente.
Prós: O usuário somente digita o serial e pronto, o programa está liberado. Ideal para softwares de prateleira aonde o usuário já adquiriu o produto. O sistema preferido para a divulgação indireta.
Contras: Centenas de outros usuários somente digitam o mesmo serial e pronto: centenas de programas registrados. Use esta forma caso não deseje receber pelo seu programa ou queira uma divulgação indireta do mesmo e esperar pela consciência do usuário, isso não funciona no Brasil. Centenas ou milhares de usuário podem usar o mesmo serial. Esta caindo em desuso rapidamente pois há centenas de sites com index sofisticados de seriais para qualquer programa o que torna o sistema quase completamente inútil hoje em dia.
HardLocks: Um pequeno dispositivo é colocado na porta serial, paralela ou USB com uma identificação única para liberar o funcionamento do sistema.
Prós: Um dos sistemas mais difíceis de serem quebrados e definitivamente o mais seguro. Garante a taxa de uma licença por máquina o que é o ideal. Para sistemas caros (algo acima de $1000,00) considere seriamente o uso de HardLocks.
Contras: Custo do HardLock por cópia licenciada e alguns problemas (raros) com periféricos usando aquela mesma porta, mas nada tão sério assim para prejudicar o usuário. As portas seriais e paralelas estão caindo em desuso com o USB e já existem HardLocks para elas também. Os Hardlocks pode apresentar defeitos dependendo do tipo.
Você deve adquirir um kit de gravação e um Hardlock para cada cópia de distribuição. Não é muito caro mas o seu software deve compensar isto obviamente.
Disquete de Habilitação: Um disquete é fornecido junto com o programa para a sua habilitação ou desabilitação.
Prós: É o hardlock dos pobres sem o mesmo nível de proteção.
Contras: Não faça proteção via disquetes de habilitação/desabilitação como o Dr. Case e outros. É perda de tempo ! Há vários utilitários que fazem a cópia perfeita do disquete sendo possível habilitá-lo em qualquer máquina. E ainda pode-se ter o problema de superfície no disco e um belo dia quando o usuário precisar instalar o software em outra máquina ele terá a surpresa do disco já mofado ou perdido. Tenha certeza que isto sempre acontece no final de semana quando ele liga para o seu escritório na segunda descarregando o seu vocabulário.
Identidade Única: Uma das melhores e mais eficientes tipos de proteções é de identidade do equipamentos recentemente implementado pela própria Microsoft. Isto consiste em recolher dados únicos sobre o seu computador como serial do HD, informação da BIOS (não aconselhável), Versão do OS, Nome do computador etc. Com base nestas informações você poderá gerar uma fechadura de identificação. Essa fechadura precisará de uma chave fornecida por você para habilitar o seu software unicamente para aquela máquina.
Prós: Difícil de ser quebrado quando bem implementado e permite alta adaptabilidade contra cracks criado contra o sistema como patchs invisíveis que permitem a modificação do sistema. Permite a taxa de apenas uma licença por computador.
Contras: Caso o usuário formate a maquina, modifique periféricos chaves o sistema pode desabilitar a cópia automaticamente. Isto cria problemas com a solicitação de uma nova licença para instalação. O usuário pode simplesmente ligar alegando este fato e de boa fé você terá que fornecer uma nova liberação.
Habilitação Pela Internet: Ao adquirir um produto o usuário recebe uma senha que permite a geração de um número para habilitação e instalação em uma máquina.
Prós: Após habilitar, o número é automaticamente invalidado para outros usuário o que evita o problema de divulgação do mesmo pela rede.
Contras: O seu site deve estar em um provedor 100% confiável ou esteja preparado para aquele cliente que comprou o produto no sábado a tarde e o seu site ficou fora do ar no domingo sem ele poder autorizar o software para o uso.
Conclusão
Não há método melhor ou pior na minha opinião para proteger um programa mas, mais trabalhoso ou menos trabalhoso para um hacker quebrar. O Ideal é que que você use duas ou mais técnicas para proteger o programa.
Há um princípio básico que ao se usar dois sistemas simples de proteção independentes cria-se um sistema forte de proteção. Por exemplo, caso use o sistema de data é fácil monitorar aonde se esta gravando esta informação (quando o programa foi instalado) e adiar o tempo limite de uso. Nag-Screens podem ser rastreadas e um hacker com bons conhecimentos de assembler pode editar diretamente o seu código binário fazendo jumps nas avaliações de restrições. Agora combinando duas ou três técnicas as coisas complicam para ele e talvez o trabalho não valha a pena (coisa que ele realmente não é acostumado).
Mas antes de começar a desenvolver o sistema de proteção para o seu programa, siga algumas dicas que aprendemos depois de muito prejuízo com pirataria.
1- Nunca coloque literalmente as mensagens referentes a registro, nag-screens, avisos de limitação e etcs, em um formato legível para um ser humano. Faça uma encriptação destas mensagens. Uma técnica bem simples dos hackers consiste em procurar no código binário por uma determinada ocorrência tipo " Cópia Trial" e perto tem um "IF" aonde se pode bloquear e lá se foi a sua proteção. Portanto, faça uma função de codificação e decodificação e grave todas as mensagens codificadas no seu programa (no código-fonte) sendo que as mesmas somente serão exibidas quando você chamar a função de decodificação.
2- Faça uma estampa no software. Ou seja, todos os programas possuem uma informação referente ao seu tamanho físico, data e hora de criação e CRC. Caso o seu programa tenha sido alterado após aquela data, através de uma função, o programa poderá verificar em sua estampa interna se ele foi modificado. Aqui pode ocorrer alguns problemas com programas anti-virus que usam a mesma técnica para monitorar alteração de executáveis aplicando uma "vacina" neles mas já é da responsabilidade do usuário.
3- Grave dados no registry sempre encriptados e, se eles forem sobre as informações de registro nunca coloque na mesma árvore das outras definições do seu software. Isto dificulta e muito as coisa. Mas se o hacker possui um programa de monitoramento do registry ele poderá facilmente contornar isto mas não antes sem um bom trabalho de adivinhação. E, nunca use chaves com nomes óbvios tipo "Serial", "SenhaPrograma", "DataLimite" e etc. Dê sempre preferência a gravar dados de configuração e autorização no registry do que em arquivos INI (lembra-se deles ?). O registry é mais difícil de ser manipulado por um leigo e é possível colocar chaves observando a mudança de outras chaves o que torna as coisas mais complexas.
4- Se possível, implemente um sistema periódico de verificação da licença via site na web.
Coloque este alerta em seu termo de uso do seu software e o faça de tal forma que seja invisível, indolor (não fique interrompendo o usuário) e que desabilite o software imediatamente ao verificar uma cópia com o número de série irregular ou divulgado. É importante aqui implementar nos CGI do site um alerta via e-mail quando ocorrer várias tentativas de liberação de um mesmo serial. Assim você descobre rapidamente quem vazou um serial para o público.
5- Tenha uma proteção não divulgada. Por exemplo, após o software executar 300 vezes uma mensagem surge do nada indicando o download de uma cópia mais atualizada. Nesta nova cópia você já deve ter contornado todos os problemas com cracks que apareceram no período.
6- Faça Check Point em pontos não óbvios do seu software e em vários lugares. Use uma periodicidade completamente aleatória para fazer isto. Por exemplo, quando o usuário abrir uma determinada tela não muito utilizada, ocorre uma verificação em background sobre a validade da licença esta verificação pode e deve ser aleatória. Após validar e algo estiver errado, nunca exiba no mesmo momento que a licença é irregular pois se torna uma referência para o Hacker aonde ele deve procurar no código binário para quebrar o seu programa. Lembre-se que tudo serve como marcação no código binário: um caption de um form, o conteúdo string de um controle etc.
7- Use constantes. Abuse delas em vez de escrever diretamente nos dialogs para comunicação com usuário. Faça uma Unit separada aonde somente é armazenado estas constantes. Isso confunde quem olha o código binário do executável pois fisicamente no executável elas não estarão próximas.
Todas estas informações foram adquiridas com a nossa experiência e, principalmente, com dicas de dois conhecidos especialistas em quebras de programas e criação de cracks. Na primeira divulgação de um dos nossos softwares um deles me retornou uma cópia crackeada em questão de horas (segundo ele, estava sem tempo por isso demorou tanto), e ficamos envergonhados para dizer a verdade. Depois ao implementarmos a codificação de string e outras técnicas, ele levou uma semana mas não conseguiu liberar todos os recursos. Ao ativarmos os sistemas randômicos de verificação em background e validação pelo site ainda não tivemos uma quebra. Claro que ela irá ocorrer, mas enquanto isto estamos recebendo pelo nosso trabalho.
Acho que seguindo estas dicas você terá uma boa chance de receber pelo seu trabalho na quantidade justa. Lembre-se que há uma legião de pessoas ai fora tentando quebrar a proteção pelo simples prazer de dizer que foram eles.
Portanto a questão não é fazer um sistema 100% seguro (o que é quase impossível) mas um que seja 110% trabalhoso para eles. Tenha em mente também que eles são em maior número e problema não é se vão quebrar a segurança mas quando e o que você vai fazer em seguida.
Não poderíamos terminar este artigo sem falar sobre alguns componentes para proteção.
Uma coisa que percebi é que certos componentes de proteção são tão complicados que você as vezes tem que passar uma semana implementando ele no seu sistema. Mas aqui estão alguns que são ótimos pela simplicidade e fácil implementação.:
OnGuard (TurboPower) - Não é propaganda pessoal ! Os componentes da TurboPower tem uma grande qualidade e o OnGuard faz tudo o que se precisa de proteção. Validação e criação de serial, limitação por data, estampa no executável, dias de execução e muito mais. A grande vantagem é que há exemplos para tudo que podem ser fácil e rapidamente adaptados.
Lock&Key - Gosto do Lock&Key pela sua simplicidade de uso. Ele gera uma "fechadura" com base nos dados do HD do usuário e com este número-fechadura você cria um número único para liberar o software. Trabalha com níveis o que é ideal para proteção progressiva. Não estamos usando mais este, apesar de sua boa qualidade.
SharewareIt - Crie sistemas de shareware de forma bem simples. A vantagem é que é gratuito.
Criando uma base de dados MS Access pelo Delphi
Resumo:
Aprenda como criar uma base de dados MS Access sem o MS Access. Cria a base, as tabelas, índices, enfim, tudo utilizando puro código delphi.
INTRODUÇÃO:
Quando se cria um sistema para ambientes desktop sempre surge a dúvida de qual base de dados usar. Geralmente são usados bancos DBase, Paradox ou MS Access. Destes, a base mais robusta e confiável é, sem dúvida, MS Access. Mas existe um grande problema para se criar a base de dados MS Access, pois faz-se necessário o uso do ambiente MS Access.
Algumas pessoas não têm este aplicativo instalado em sua máquina e então torna-se inviável o uso desta base de dados, impedindo, desta forma, um crescimento tecnológico do programador que fica preso a ferramentas obsoletas.
Neste tutorial você irá aprender como criar uma base de dados MS Access a partir do nada, usando puro código Delphi e a Tecnologia ADO Extensions que é distribuída pela Microsoft.
ADOX, faz parte dos componentes ADO, quer dizer, é uma extensão do ADO. O ADOX fornece ferramentas de acesso a estrutura, segurança, definições de tabelas e muitos outros.
Como dito anteriormente, ADOX é uma library distribuída pela Microsoft, o arquivo chama-se "Msadox.dll", sua definição é "Microsoft ADO Ext. 2.x for DDL and Security" e é este arquivo que iremos importar para nossa IDE no Delphi.
INSTALANDO:
Para usar este objetos no Delphi basta seguir os seguintes passos:
1- Selecione PROJECT > IMPORT TYPE LIBRARY
2- Procure pela descrição: "Microsoft ADO Ext. 2.x for DDL and Security (Version 2.x)"
2- Em CLASS NAMES, altere o nome dos objetos acrescentando ADOX após a letra T, exemplo: TTable mude para TADOXTable, TColumm mude para TADOXColumn. Repita este procedimento para todos objetos nesta lista.
3- Em PALETTE PAGE selecione ou digite um novo nome para a paleta onde os componentes ficarão, exemplo: ADOX.
4- Pressione INSTALL, logo depois pressione Ok confirmando o início da instalação.
5- Pressione YES confirmando que você quer instalar os componentes.
6- Pressione Ok na tela que indica os objetos instalados.
7- Selecione FILE > CLOSE ALL e pressione YES para salvar este package criado.
O motivo da troca do nome dos objetos é muito óbvio, estes nomes de classe como Ttable já existem, então iria gerar conflitos na compilação, por isso bastou trocar o nome da classe.
Pronto, os objetos estão instalados, agora sempre que você utilizar estes objetos será inserido na clausula USES a Unit ADOX_TLB pois este é o nome da unit criada a partir da importação da DLL.
INICIANDO:
DEFININDO A BASE DE DADOS E OBJETOS A SEREM USADOS
Vamos criar uma base onde serão armazenados informaçõe sobre animais de estimação (para sair um pouco da rotina de CLIENTES/PRODUTOS/PEDIDOS).
Para esta base serão criadas as seguintes tabelas:
> PROPRIETARIO
> PRO_ID
> PRO_NOME
>ANIMAL
> ANI_ID
> ANI_PROPRIETARIO
> ANI_NOME
> ANI_NASCIMENTO
Onde um proprietario pode ter mais de um animal formando assim um relacionamento UM PARA MUITOS.
No Delphi, crie uma nova aplicação. Será criado um novo Form, a este insira os seguintes componentes:
> 3 TButtons
Para lançar os procedimentos de criação da base de dados e das tabelas.
Altere as seguintes propriedades para cada TButtons respectivamente:
Caption: Criar base
Name: btnBase
Caption: Criar tabelas
Name: btnTabelas
Caption: Navegar
Name: btnNavegar
> 1 TEdit
Para armazenar o path da base de dados a ser criada.
Altere as seguintes propriedades:
Name: edtPath
Text: (deixe em branco)
> 1 TSaveDialog
Para navegar no disco e informar o path da base de dados.
Altere as seguintes propriedades:
Filter: Base MS Access|*.mdb
Title: Salvar como...
DefaultExt: .mdb
> 1 TADOConnection
Para fazer a conexão com a base criada.
Altere as seguintes propriedades:
Login prompt: False
> 1 TADOCommand
Para fazer a ligação e criação das tabelas.
Altere as seguintes propriedades:
Connection: Selecione o ADOConnection1
> 1 TADOXCatalog
Para criar a base de dados.
CRIANDO A BASE DE DADOS:
Agora vamos ao código. Clique duas vezes no objeto btnNavegar e digite:
procedure TForm1.btnNavegarClick(Sender: TObject);
begin
if SaveDialog1.Execute then
edtPath.Text := SaveDialog1.FileName;
end;
Com isso informamos o nome que a base terá.
Clique duas vezes no objeto btnBase e digite o seguinte procedimento:
procedure TForm1.btnBaseClick(Sender: TObject);
var
Base: String;
begin
if edtPath.Text = '' then
begin
ShowMessage('Nome da base de dados não informada.');
exit;
end;
Base := 'Provider=Microsoft.Jet.OLEDB.4.0'+
';Data Source=' + edtPath.Text +
';Jet OLEDB:Engine Type=4';
ADOXCatalog1.Create1(Base);
end;
Primeiro verificamos se há algum texto no objeto TEdit, em seguida atribuímos a string de conexão à variável BASE informando vários parâmetros, mas atente para a seguinte linha: "...Engine Type=4...", isto quer dizer que iremos criar uma base Access 97, para Access 2000 informe 5.
Em seguida é efetivamente criado a base de dados através do método Create1 do objeto ADOXCatalog, passando para este a string da BASE. Observe que o método é Create1 e não simplesmente Create, pois o método Create já existe e é da classe.
Pronto, criamos uma base de dados vazia, não existe nada nela, mas já é um arquivo comum ao MS Access e pode ser aberto normalmente.
CRIANDO TABELAS:
procedure TForm1.btnNavegarClick(Sender: TObject);
begin
if SaveDialog1.Execute then
edtPath.Text := SaveDialog1.FileName;
end;
Com isso informamos o nome que a base terá.
Clique duas vezes no objeto btnBase e digite o seguinte procedimento:
procedure TForm1.btnBaseClick(Sender: TObject);
var
Base: String;
begin
if edtPath.Text = '' then
begin
ShowMessage('Nome da base de dados não informada.');
exit;
end;
Base := 'Provider=Microsoft.Jet.OLEDB.4.0'+
';Data Source=' + edtPath.Text +
';Jet OLEDB:Engine Type=4';
ADOXCatalog1.Create1(Base);
end;
Primeiro verificamos se há algum texto no objeto TEdit, em seguida atribuímos a string de conexão à variável BASE informando vários parâmetros, mas atente para a seguinte linha: "...Engine Type=4...", isto quer dizer que iremos criar uma base Access 97, para Access 2000 informe 5.
Em seguida é efetivamente criado a base de dados através do método Create1 do objeto ADOXCatalog, passando para este a string da BASE. Observe que o método é Create1 e não simplesmente Create, pois o método Create já existe e é da classe.
Pronto, criamos uma base de dados vazia, não existe nada nela, mas já é um arquivo comum ao MS Access e pode ser aberto normalmente.
CRIANDO TABELAS:
Vamos começar a criar as tabelas, seus índices e integridade referencial. Para isso clique duas vezes no objeto btnTabelas e digite:
procedure TForm1.btnTabelasClick(Sender: TObject);
var
base, comando: string;
begin
{ definindo a base de dados }
base := 'Provider=Microsoft.Jet.OLEDB.4.0' +
';Data Source=' + edtPath.Text +
';Persist Security Info=False';
ADOConnection1.ConnectionString := base;
{ Criando as tabelas... }
{>>> PROPRIETARIO <<<}
comando := 'CREATE TABLE PROPRIETARIO (' +
'PRO_ID INT,' +
'PRO_NOME TEXT(50))';
ADOCommand1.CommandText := comando;
ADOCommand1.Execute;
{ ADICIONANDO INDICES }
comando := 'CREATE INDEX IDX_PRO_ID ' +
'ON PROPRIETARIO (PRO_ID) WITH PRIMARY';
ADOCommand1.CommandText := comando;
ADOCommand1.Execute;
{>>> ANIMAL <<<}
comando := 'CREATE TABLE ANIMAL (' +
'ANI_ID INT,' +
'ANI_PROPRIETARIO INT ' +
'CONSTRAINT IDX_PRO_ID ' +
'REFERENCES PROPRIETARIO (PRO_ID),' +
'ANI_NOME TEXT (50),' +
'ANI_NASCIMENTO DATETIME)';
ADOCommand1.CommandText := comando;
ADOCommand1.Execute;
end;
CONCLUÍNDO:
Pronto, tudo muito fácil e simples. Agora rode o programa e faça os testes. Clique em navegar, selecione um diretório e digite o nome que sua base terá, então clique em CRIAR BASE e veja que o programa criará a base, logo após isto clique em CRIAR TABELAS então as tabelas serão criadas.
Agora ficou fácil criar sistemas desktops usando uma base mais robusta sem a necessidade de se ter o MS Access instalado em sua máquina. É possível criar e acessar todos os recursos de tabelas da base de dados MS Access usando os objetos ADOX, aqui foi mostrado como criar utilizando linguagem DDL, ou seja, escrevemos diretamente para que o comando fosse executado, mas é possível ter acesso à estes recursos diretamente com os componentes distribuídos por esta library, mas este assunto ficará para outra ocasião.
Se você tiver o MS Access instalado em sua máquina pode abri-lo e verificar nossa base de dados, caso contrário (como é o meu caso) crie uma simples aplicação com dois DBGrids para exibir os campos das tabelas, assim como inserir dados.
Cuidado quando gravar arquivos binarios
Quando gravar em arquivos binários deve evitar o uso em seus records de longStrings pois, por default, uma longstring é uma string "sem fim" . Se vc tentar gravar em um arquivo binário ele irá truncá-la(ou seja, vai cortar uma parte da string) e vc poderá perder dados. Ao invés disso, use shorstrings para arquivos binários...
Criar sub-diretório no diretório do EXE
Inclua na seção uses: FileCtrl, SysUtils
Problema:
Gostaria de criar um sub-diretório dentro do diretório onde se encontra o EXE de minha aplicação. Como fazer?
Solução:
Primeiramente vamos conhecer algumas funções do Delphi que precisaremos usá-las:
ParamStr(Indice) - Retorna valores passados na linha de comando quando executamos o programa. Se o valor de Indice for 0 (zero) será retornado o caminho+nome do EXE.
ExtractFilePath(NomeArq) - Retorna o caminho (path) do nome de arquivo informado.
Exemplo:
S := 'C:\NomeDir\Programa.exe';
ExtractFilePath(S); { retorna: 'C:\NomeDir\' }
DirectoryExists(CaminhoDir) - Retorna true se o diretório informado existe. False em caso contrário.
CreateDir(CaminhoDir) - Tenta criar o diretório informado.
Se conseguir, retorna true. Caso contrário retorna false.
Agora que sabemos como trabalham estas funções, vamos escrever uma função que precisamos para criar um sub-diretório conforme proposto.
function CriaSubDir(const NomeSubDir: string): boolean;
var
Caminho: string;
begin
Caminho := ExtractFilePath(ParamStr(0)) + NomeSubDir;
if DirectoryExists(Caminho) then
Result := true
else
Result := CreateDir(Caminho);
end;
Exemplo de uso:
- Chame a função no evento OnCreate do form:
procedure TForm1.FormCreate(Sender: TObject);
begin
if not CriaSubDir('MeuSubDir') then
ShowMessage('Não foi possível criar o sub-diretório MeuSubDir.');
end;
Problema:
Gostaria de criar um sub-diretório dentro do diretório onde se encontra o EXE de minha aplicação. Como fazer?
Solução:
Primeiramente vamos conhecer algumas funções do Delphi que precisaremos usá-las:
ParamStr(Indice) - Retorna valores passados na linha de comando quando executamos o programa. Se o valor de Indice for 0 (zero) será retornado o caminho+nome do EXE.
ExtractFilePath(NomeArq) - Retorna o caminho (path) do nome de arquivo informado.
Exemplo:
S := 'C:\NomeDir\Programa.exe';
ExtractFilePath(S); { retorna: 'C:\NomeDir\' }
DirectoryExists(CaminhoDir) - Retorna true se o diretório informado existe. False em caso contrário.
CreateDir(CaminhoDir) - Tenta criar o diretório informado.
Se conseguir, retorna true. Caso contrário retorna false.
Agora que sabemos como trabalham estas funções, vamos escrever uma função que precisamos para criar um sub-diretório conforme proposto.
function CriaSubDir(const NomeSubDir: string): boolean;
var
Caminho: string;
begin
Caminho := ExtractFilePath(ParamStr(0)) + NomeSubDir;
if DirectoryExists(Caminho) then
Result := true
else
Result := CreateDir(Caminho);
end;
Exemplo de uso:
- Chame a função no evento OnCreate do form:
procedure TForm1.FormCreate(Sender: TObject);
begin
if not CriaSubDir('MeuSubDir') then
ShowMessage('Não foi possível criar o sub-diretório MeuSubDir.');
end;
Criando um arquivo de log
procedure AddLog;
var
log: textfile;
begin
try
AssignFile(log, 'c:\log.log');
if not FileExists('c:\log.log') then Rewrite(log,'c:\log.log');
Append(log);
WriteLn(log, 'informações a serem inclusas');
finally
CloseFile(log);
end;
end;
var
log: textfile;
begin
try
AssignFile(log, 'c:\log.log');
if not FileExists('c:\log.log') then Rewrite(log,'c:\log.log');
Append(log);
WriteLn(log, 'informações a serem inclusas');
finally
CloseFile(log);
end;
end;
Criando diretório
Para criar um diretório você precisa usar a função ForceDirectories, o exemplo a baixo testa se não existe um diretório e cria o diretório apartir de uma variável string testando se o diretório já existe
Unit
FileCtrl
procedure TForm1.Button1Click(Sender: TObject);
var
Dir: string;
begin
Dir := 'C:\APPS\SALES\LOCAL';
if not DirectoryExists(Dir) then
ForceDirectories(Dir);
Label1.Caption := Dir + ' foi criado';
end;
quarta-feira, 11 de agosto de 2010
Alterando a fonte de determinado registro em um DBGrid
Para trocar a fonte de um DBGrid, utilize a rotina abaixo no evento OnDrawDataCell:
if Tabela.FieldByName ('Salario').Value >= 10000 then begin
DbGrid1.Canvas.Font.Color := clRed;
DbGrid1.Canvas.Font.Style := [fsBold];
end;
DbGrid1.DefaultDrawDataCell(Rect, Field, State);
No caso, somente os registros com salário maior que R$ 10.000,00 ficarão com cor vermelha e em negrito.
Nota: Não é necessário mover o ponteiro da tabela para colorir os registros.
if Tabela.FieldByName ('Salario').Value >= 10000 then begin
DbGrid1.Canvas.Font.Color := clRed;
DbGrid1.Canvas.Font.Style := [fsBold];
end;
DbGrid1.DefaultDrawDataCell(Rect, Field, State);
No caso, somente os registros com salário maior que R$ 10.000,00 ficarão com cor vermelha e em negrito.
Nota: Não é necessário mover o ponteiro da tabela para colorir os registros.
Adicionar o evento OnClick do DBGrid
Problema:
Meu programa precisa processar algo quando o usuário clicar no DBGrid em um determinado form. O problema é que o DBGrid não possui o evento OnClick. É possível adicionar este evento no DBGrid?
Solução:
É possível sim. Afinal é muito simples. Siga os passos abaixo para resolver seu problema:
- Monte seu form normalmente, colocando o DBGrid e demais componentes;
- Vá na seção "private" da unit e declare a procedure abaixo:
private
procedure DBGridClick(Sender: TObject);
- Logo após a palavra "implementation", escreva a procedure:
implementation
{$R *.DFM}
procedure TForm1.DBGridClick(Sender: TObject);
begin
ShowMessage('Clicou no DBGrid.');
end;
- Coloque as instruções abaixo no evento OnCreate do Form:
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.ControlStyle :=
DBGrid1.ControlStyle + [csClickEvents];
TForm(DBGrid1).OnClick := DBGridClick;
end;
- E pronto. Execute e teste.
Observações:
O segredo principal desta dica está OnCreate do Form. A primeira instrução ativa o evento OnClick. A segunda instrução acessa o manipulador do evento OnClick. Para isto precisamos tratar o DBGrid como se fosse Form, pois o evento OnClick está declarado como protegido (protected) na classe TDBGrid.
Meu programa precisa processar algo quando o usuário clicar no DBGrid em um determinado form. O problema é que o DBGrid não possui o evento OnClick. É possível adicionar este evento no DBGrid?
Solução:
É possível sim. Afinal é muito simples. Siga os passos abaixo para resolver seu problema:
- Monte seu form normalmente, colocando o DBGrid e demais componentes;
- Vá na seção "private" da unit e declare a procedure abaixo:
private
procedure DBGridClick(Sender: TObject);
- Logo após a palavra "implementation", escreva a procedure:
implementation
{$R *.DFM}
procedure TForm1.DBGridClick(Sender: TObject);
begin
ShowMessage('Clicou no DBGrid.');
end;
- Coloque as instruções abaixo no evento OnCreate do Form:
procedure TForm1.FormCreate(Sender: TObject);
begin
DBGrid1.ControlStyle :=
DBGrid1.ControlStyle + [csClickEvents];
TForm(DBGrid1).OnClick := DBGridClick;
end;
- E pronto. Execute e teste.
Observações:
O segredo principal desta dica está OnCreate do Form. A primeira instrução ativa o evento OnClick. A segunda instrução acessa o manipulador do evento OnClick. Para isto precisamos tratar o DBGrid como se fosse Form, pois o evento OnClick está declarado como protegido (protected) na classe TDBGrid.
Copiando Arquivos Via Programação
Function CopiaArquivo(scrname,destname:string):byte;
var
source,destination:file;
buffer:array[1..1024] of byte;
readcnt,writecnt:word;
pname,dname,fname,ename:String;
{ USO: R:=COPIAARQUIVO('C:\diretorio\FILE.EXT','C:\diretorio\FILE.EXT'); Devolve 0=Ok, 1=Erro no Origem, 2=Erro no Destino, 3=Disco Cheio }
begin
AssignFile(source,scrname);
Try
Reset(source,1);
Except
CopiaArquivo:=1;
Exit;end;If destname[length(destname)]='\' then
begin
pname:=scrname;
destname:=destname+separa(scrname,'\',Ocorre(scrname,'\')+1);
end;
AssignFile(destination,destname);
Try
Rewrite(destination,1);
Except
CopiaArquivo:=2;
Exit;
end;
Repeat
BlockRead(source,buffer,sizeof(buffer),readcnt);
Try
BlockWrite(destination,buffer,readcnt,writecnt);
Except
CopiaArquivo:=3; {Disco Cheio?}
Exit;
end;
until (readcnt=0) or (writecnt<>readcnt);
CloseFile(destination);
CloseFile(source);
CopiaArquivo:=0;
end;
var
source,destination:file;
buffer:array[1..1024] of byte;
readcnt,writecnt:word;
pname,dname,fname,ename:String;
{ USO: R:=COPIAARQUIVO('C:\diretorio\FILE.EXT','C:\diretorio\FILE.EXT'); Devolve 0=Ok, 1=Erro no Origem, 2=Erro no Destino, 3=Disco Cheio }
begin
AssignFile(source,scrname);
Try
Reset(source,1);
Except
CopiaArquivo:=1;
Exit;end;If destname[length(destname)]='\' then
begin
pname:=scrname;
destname:=destname+separa(scrname,'\',Ocorre(scrname,'\')+1);
end;
AssignFile(destination,destname);
Try
Rewrite(destination,1);
Except
CopiaArquivo:=2;
Exit;
end;
Repeat
BlockRead(source,buffer,sizeof(buffer),readcnt);
Try
BlockWrite(destination,buffer,readcnt,writecnt);
Except
CopiaArquivo:=3; {Disco Cheio?}
Exit;
end;
until (readcnt=0) or (writecnt<>readcnt);
CloseFile(destination);
CloseFile(source);
CopiaArquivo:=0;
end;
Copiando arquivos de diretório para diretório
procedure CopyDir(const cFrom, cTo : string);
var
OpStruc : TSHFileOpStruct;
frombuf, tobuf : array[0..128] of Char;
begin
FillChar(frombuf, Sizeof(frombuf), 0);
FillChar(tobuf, Sizeof(tobuf), 0);
StrPCopy(frombuf, cFrom);
StrPCopy(tobuf, cTo);
with OpStruc do begin
Wnd := Application.Handle;
wFunc := FO_COPY;
pFrom := @frombuf;
pTo := @tobuf;
fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end; // with
ShFileOperation(OpStruc);
end; // CopyDir
var
OpStruc : TSHFileOpStruct;
frombuf, tobuf : array[0..128] of Char;
begin
FillChar(frombuf, Sizeof(frombuf), 0);
FillChar(tobuf, Sizeof(tobuf), 0);
StrPCopy(frombuf, cFrom);
StrPCopy(tobuf, cTo);
with OpStruc do begin
Wnd := Application.Handle;
wFunc := FO_COPY;
pFrom := @frombuf;
pTo := @tobuf;
fFlags := FOF_NOCONFIRMATION or FOF_RENAMEONCOLLISION;
fAnyOperationsAborted := False;
hNameMappings := nil;
lpszProgressTitle := nil;
end; // with
ShFileOperation(OpStruc);
end; // CopyDir
Algumas dicas Uteis
Apagar arquivos via MS-DOS:
WinExec('Command.com /c Del c:\temp\*.tmp', 0)
-----------------------------------------------------------------------------------
Como extrair o tamanho de um arquivo:
function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;
Utilize a função assim:
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;
-----------------------------------------------------------------------------------
Como verificar se um arquivo existe:
If not(fileexists('c:\windows\nuvens.bmp')) then Showmessage('Arquivo inexistente');
-----------------------------------------------------------------------------------
Copiando arquivos:
Função: CopyFile('Origem','Destino',True);
Exemplo: CopyFile('c:\logo.sys','c:\logo.bmp',True)
True : Instrui para sobrescrever o arquivo destino (caso encontre)
WinExec('Command.com /c Del c:\temp\*.tmp', 0)
-----------------------------------------------------------------------------------
Como extrair o tamanho de um arquivo:
function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;
Utilize a função assim:
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;
-----------------------------------------------------------------------------------
Como verificar se um arquivo existe:
If not(fileexists('c:\windows\nuvens.bmp')) then Showmessage('Arquivo inexistente');
-----------------------------------------------------------------------------------
Copiando arquivos:
Função: CopyFile('Origem','Destino',True);
Exemplo: CopyFile('c:\logo.sys','c:\logo.bmp',True)
True : Instrui para sobrescrever o arquivo destino (caso encontre)
terça-feira, 10 de agosto de 2010
Compara dois arquivos textos
procedure TForm1.Button1Click(Sender: TObject);
var
filename1 : string;
filename2 : string;
begin
filename1 := Edit1.Text;
filename2 := Edit2.Text;
compfile(filename1, filename2);
showmessage('Veja o resultado no arquivo c:Tempdiff.txt');
end;
procedure tform1.compfile(filename1, filename2 : string);
var
f1 : system.textfile;
f2 : system.textfile;
diff : system.textfile;
buf1 : string;
buf2 : string;
l : integer;
begin
assignfile(f1, filename1);
assignfile(f2, filename2);
assignfile(diff, 'c:Tempdiff.txt');
reset(f1);
reset(f2);
rewrite(diff);
l := 1;
while not eof(f1) do begin
readln(f1, buf1);
readln(f2, buf2);
if not (compstr(buf1, buf2) )then begin
writeln(diff, 'line: '+ inttostr(l) + '-' + buf1);
writeln(diff, 'line: '+ inttostr(l) + '-' + buf2);
writeln(diff, ' ');
end;
inc(l);
end;
closefile(f1);
closefile(f2);
closefile(diff);
end;
function tform1.compstr(s1, s2 : string) : boolean;
var
i : integer;
btemp : boolean;
begin
btemp := true;
if (length(s1) <> length(s2)) then begin
btemp := false;
end{if}
else begin
for i:= 1 to length(s1) do begin
if (s1[i] <> s2[i]) then begin
btemp := false;
exit;
end;{if}
end;{for}
end;{else}
result := btemp;
end;
var
filename1 : string;
filename2 : string;
begin
filename1 := Edit1.Text;
filename2 := Edit2.Text;
compfile(filename1, filename2);
showmessage('Veja o resultado no arquivo c:Tempdiff.txt');
end;
procedure tform1.compfile(filename1, filename2 : string);
var
f1 : system.textfile;
f2 : system.textfile;
diff : system.textfile;
buf1 : string;
buf2 : string;
l : integer;
begin
assignfile(f1, filename1);
assignfile(f2, filename2);
assignfile(diff, 'c:Tempdiff.txt');
reset(f1);
reset(f2);
rewrite(diff);
l := 1;
while not eof(f1) do begin
readln(f1, buf1);
readln(f2, buf2);
if not (compstr(buf1, buf2) )then begin
writeln(diff, 'line: '+ inttostr(l) + '-' + buf1);
writeln(diff, 'line: '+ inttostr(l) + '-' + buf2);
writeln(diff, ' ');
end;
inc(l);
end;
closefile(f1);
closefile(f2);
closefile(diff);
end;
function tform1.compstr(s1, s2 : string) : boolean;
var
i : integer;
btemp : boolean;
begin
btemp := true;
if (length(s1) <> length(s2)) then begin
btemp := false;
end{if}
else begin
for i:= 1 to length(s1) do begin
if (s1[i] <> s2[i]) then begin
btemp := false;
exit;
end;{if}
end;{for}
end;{else}
result := btemp;
end;
Como extrair o tamanho de um arquivo
function TForm1.TamArquivo(Arquivo: string): Integer;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;
Utilize a função assim:
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;
begin
with TFileStream.Create(Arquivo, fmOpenRead or fmShareExclusive) do
try
Result := Size;
finally
Free;
end;
end;
Utilize a função assim:
procedure TForm1.Button1Click(Sender: TObject);
begin
edit1.text:= inttostr(TamArquivo('CAMINHO\NOMEDOARQUIVO'));
end;
Adiciona a barra invertida a um texto selecionado
function AddBarra(S: string): string;
var
Temp: string;
begin
Temp := S;
if S[Length(Temp)] <> '\' then
Temp := Temp + '\';
Result := Temp;
end;
var
Temp: string;
begin
Temp := S;
if S[Length(Temp)] <> '\' then
Temp := Temp + '\';
Result := Temp;
end;
Abrir arquivos com aplicativo associado
Inclua a unit SHELLAPI na clausula uses do seu form.
procedure TForm1.ExecFile(F: String);
var
r: String;
begin
case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of
ERROR_FILE_NOT_FOUND: r := 'The specified file was not found.';
ERROR_PATH_NOT_FOUND: r := 'The specified path was not found.';
ERROR_BAD_FORMAT: r := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
SE_ERR_ACCESSDENIED: r := 'Windows 95 only: The operating system denied access to the specified file.';
SE_ERR_ASSOCINCOMPLETE: r := 'The filename association is incomplete or invalid.';
SE_ERR_DDEBUSY: r := 'The DDE transaction could not be completed because other DDE transactions were being processed.';
SE_ERR_DDEFAIL: r := 'The DDE transaction failed.';
SE_ERR_DDETIMEOUT: r := 'The DDE transaction could not be completed because the request timed out.';
SE_ERR_DLLNOTFOUND: r := 'Windows 95 only: The specified dynamic-link library was not found.';
SE_ERR_NOASSOC: r := 'There is no application associated with the given filename extension.';
SE_ERR_OOM: r := 'Windows 95 only: There was not enough memory to complete the operation.';
SE_ERR_SHARE: r := 'A sharing violation occurred.';
else
Exit;
end;
ShowMessage(r);
end;
Utilize a função assim:
procedure TForm1.ExecFile(F: String);
var
r: String;
begin
case ShellExecute(Handle, nil, PChar(F), nil, nil, SW_SHOWNORMAL) of
ERROR_FILE_NOT_FOUND: r := 'The specified file was not found.';
ERROR_PATH_NOT_FOUND: r := 'The specified path was not found.';
ERROR_BAD_FORMAT: r := 'The .EXE file is invalid (non-Win32 .EXE or error in .EXE image).';
SE_ERR_ACCESSDENIED: r := 'Windows 95 only: The operating system denied access to the specified file.';
SE_ERR_ASSOCINCOMPLETE: r := 'The filename association is incomplete or invalid.';
SE_ERR_DDEBUSY: r := 'The DDE transaction could not be completed because other DDE transactions were being processed.';
SE_ERR_DDEFAIL: r := 'The DDE transaction failed.';
SE_ERR_DDETIMEOUT: r := 'The DDE transaction could not be completed because the request timed out.';
SE_ERR_DLLNOTFOUND: r := 'Windows 95 only: The specified dynamic-link library was not found.';
SE_ERR_NOASSOC: r := 'There is no application associated with the given filename extension.';
SE_ERR_OOM: r := 'Windows 95 only: There was not enough memory to complete the operation.';
SE_ERR_SHARE: r := 'A sharing violation occurred.';
else
Exit;
end;
ShowMessage(r);
end;
Utilize a função assim:
procedure TForm1.Button1Click(Sender: TObject);
begin
ExecFile('c:\windows\ladrilhos.bmp');
end;
begin
ExecFile('c:\windows\ladrilhos.bmp');
end;
segunda-feira, 9 de agosto de 2010
Apagando todos os registros da tabela
Para apagar os registros de uma tabela utiliza-se a função delete.
Através de um comando de repetição (While) é possível excluir todos os registros da tabela, usando como flag a quantidade de registros existentes na tabela (RecordCount > 0).
Código Completo:
Procedure ApagarTodosReg(Origem:TDataSet);
Begin
With Origem do
While RecordCount > 0 do
Delete;
End;
Como Usar:
ApagarTodosReg(Table1);
Através de um comando de repetição (While) é possível excluir todos os registros da tabela, usando como flag a quantidade de registros existentes na tabela (RecordCount > 0).
Código Completo:
Procedure ApagarTodosReg(Origem:TDataSet);
Begin
With Origem do
While RecordCount > 0 do
Delete;
End;
Como Usar:
ApagarTodosReg(Table1);
Arquivos AVI e WAV em tabelas
O Exemplo Abaixo Demonstra Como Gravar Um Arquivo .Avi Ou .Wav Dentro De Um Arquivo Paradox. Mostra Também Como Reproduzir Estes Arquivos.
Para Que O Código Abaixo Funcione Inclua Em Um Form 02 Componentes Button, 01 Componente Panel, 01 Componente Dbgrid, 01 Componente Table, 01 Componente Datasource E 01 Componente Opendialog.
Crie Um Arquivo Paradox Com A Seguinte Estrutura:
Nome Tipo Tamanho
Codigo +
Nome A 100
Avi B
Unit Unit1;
Interface
Uses
Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs,
Stdctrls, Db, Dbtables, Extctrls, Mplayer, Dbctrls, Grids, Dbgrids;
Type
Tform1 = Class(Tform)
Button1: Tbutton;
Button2: Tbutton;
Table1: Ttable;
Datasource1: Tdatasource;
Dbgrid1: Tdbgrid;
Panel1: Tpanel;
Opendialog1: Topendialog;
Table1codigo: Tautoincfield;
Table1nome: Tstringfield;
Table1avi: Tblobfield;
Procedure Button1click(Sender: Tobject);
Procedure Button2click(Sender: Tobject);
Procedure Formdestroy(Sender: Tobject);
Procedure Formshow(Sender: Tobject);
Procedure Formclose(Sender: Tobject; Var Action: Tcloseaction);
Private
{ Private Declarations }
Public
{ Public Declarations }
End;
Var Form1: Tform1;
Filename : String;
Mediaplayer1 : Tmediaplayer;
Implementation
{$R *.Dfm}
{Esta Função Cria Um Arquivo Temporário Para O Sistema}
Function Gettemporaryfilename : String;
{$Ifndef Win32}
Const Max_path = 144;
{$Endif}
Var
{$Ifdef Win32}
Lppathbuffer : Pchar;
{$Endif}
Lpbuffer : Pchar;
Begin
{Get The File Name Buffer}
Getmem(Lpbuffer, Max_path);
{$Ifdef Win32}
{Get The Temp Path Buffer}
Getmem(Lppathbuffer, Max_path); {Get The Temp Path}
Gettemppath(Max_path, Lppathbuffer); {Get The Temp File Name}
Gettempfilename(Lppathbuffer,'Tmp',0,Lpbuffer);
Freemem(Lppathbuffer, Max_path);
{$Else} {Get The Temp File Name}
Gettempfilename(Gettempdrive('C'),'Tmp',0,Lpbuffer);
{$Endif} {Create A Pascal String Containg}
{The Temp File Name And Return It}
Result := Strpas(Lpbuffer);
{Free The File Name Buffer}
Freemem(Lpbuffer, Max_path);
End;
{Grava Avi Ou Wav No Arquivo Paradox}
Procedure Tform1.Button1click(Sender: Tobject);
Var Filestream: Tfilestream; {Para Ler O Arquivo Avi}
Blobstream: Tblobstream; {Para Salvar No Campo Blob}
Begin
Application.Processmessages;
Button1.Enabled := False;
Button2.Enabled := False;
If Opendialog1.Execute Then
Filestream := Tfilestream.Create(Opendialog1.Filename,Fmopenread);
Table1.Append;
Table1nome.Value := Opendialog1.Filename;
Blobstream := Tblobstream.Create(Table1avi, Bmreadwrite);
Blobstream.Seek(0, Sofrombeginning);
Blobstream.Truncate;
Blobstream.Copyfrom(Filestream, Filestream.Size);
Filestream.Free;
Blobstream.Free;
Table1.Post;
Button1.Enabled := True;
Button2.Enabled := True;
End;
{Reproduz O Que Está Gravado No Campo Blob}
Procedure Tform1.Button2click(Sender: Tobject);
Var Filestream: Tfilestream; {A Temp File}
Blobstream: Tblobstream; {The Avi Blob}
Begin
Blobstream := Tblobstream.Create(Table1avi, Bmread);
If Blobstream.Size = 0 Then
Begin
Blobstream.Free;
Exit;
End;
Mediaplayer1.Close; {Reset The File Name}
Mediaplayer1.Filename := ''; {Refresh The Play Window}
Mediaplayer1.Display := Panel1;
Panel1.Refresh;
If Filename <> '' Then
Deletefile(Filename); {Get A Temp File Name}
Filename := Gettemporaryfilename; {Create A Temp File Stream}
Filestream := Tfilestream.Create(Filename,Fmcreate Or Fmopenwrite);
Filestream.Copyfrom(Blobstream, Blobstream.Size); {Free The Streams}
Filestream.Free; Blobstream.Free;
Mediaplayer1.Filename := Filename;
Mediaplayer1.Devicetype := Dtavivideo;
Mediaplayer1.Open;
Mediaplayer1.Play;
End;
// Evento Ondestroy Do Form
Procedure Tform1.Formdestroy(Sender: Tobject);
Begin
Mediaplayer1.Close;
Mediaplayer1.Filename := '';
If Filename <> '' Then
Deletefile(Filename);
End;
// Evento Onshow Do Form
Procedure Tform1.Formshow(Sender: Tobject);
Begin
Mediaplayer1 := Tmediaplayer.Create(Self);
With Mediaplayer1 Do
Begin
Parent := Self ;
Visible := False;
End;
Table1.Open;
End;
// Evento Onclose Do Form
Procedure Tform1.Formclose(Sender: Tobject; Var Action: Tcloseaction);
Begin
Table1.Close;
End;
End.
Para Que O Código Abaixo Funcione Inclua Em Um Form 02 Componentes Button, 01 Componente Panel, 01 Componente Dbgrid, 01 Componente Table, 01 Componente Datasource E 01 Componente Opendialog.
Crie Um Arquivo Paradox Com A Seguinte Estrutura:
Nome Tipo Tamanho
Codigo +
Nome A 100
Avi B
Unit Unit1;
Interface
Uses
Windows, Messages, Sysutils, Classes, Graphics, Controls, Forms, Dialogs,
Stdctrls, Db, Dbtables, Extctrls, Mplayer, Dbctrls, Grids, Dbgrids;
Type
Tform1 = Class(Tform)
Button1: Tbutton;
Button2: Tbutton;
Table1: Ttable;
Datasource1: Tdatasource;
Dbgrid1: Tdbgrid;
Panel1: Tpanel;
Opendialog1: Topendialog;
Table1codigo: Tautoincfield;
Table1nome: Tstringfield;
Table1avi: Tblobfield;
Procedure Button1click(Sender: Tobject);
Procedure Button2click(Sender: Tobject);
Procedure Formdestroy(Sender: Tobject);
Procedure Formshow(Sender: Tobject);
Procedure Formclose(Sender: Tobject; Var Action: Tcloseaction);
Private
{ Private Declarations }
Public
{ Public Declarations }
End;
Var Form1: Tform1;
Filename : String;
Mediaplayer1 : Tmediaplayer;
Implementation
{$R *.Dfm}
{Esta Função Cria Um Arquivo Temporário Para O Sistema}
Function Gettemporaryfilename : String;
{$Ifndef Win32}
Const Max_path = 144;
{$Endif}
Var
{$Ifdef Win32}
Lppathbuffer : Pchar;
{$Endif}
Lpbuffer : Pchar;
Begin
{Get The File Name Buffer}
Getmem(Lpbuffer, Max_path);
{$Ifdef Win32}
{Get The Temp Path Buffer}
Getmem(Lppathbuffer, Max_path); {Get The Temp Path}
Gettemppath(Max_path, Lppathbuffer); {Get The Temp File Name}
Gettempfilename(Lppathbuffer,'Tmp',0,Lpbuffer);
Freemem(Lppathbuffer, Max_path);
{$Else} {Get The Temp File Name}
Gettempfilename(Gettempdrive('C'),'Tmp',0,Lpbuffer);
{$Endif} {Create A Pascal String Containg}
{The Temp File Name And Return It}
Result := Strpas(Lpbuffer);
{Free The File Name Buffer}
Freemem(Lpbuffer, Max_path);
End;
{Grava Avi Ou Wav No Arquivo Paradox}
Procedure Tform1.Button1click(Sender: Tobject);
Var Filestream: Tfilestream; {Para Ler O Arquivo Avi}
Blobstream: Tblobstream; {Para Salvar No Campo Blob}
Begin
Application.Processmessages;
Button1.Enabled := False;
Button2.Enabled := False;
If Opendialog1.Execute Then
Filestream := Tfilestream.Create(Opendialog1.Filename,Fmopenread);
Table1.Append;
Table1nome.Value := Opendialog1.Filename;
Blobstream := Tblobstream.Create(Table1avi, Bmreadwrite);
Blobstream.Seek(0, Sofrombeginning);
Blobstream.Truncate;
Blobstream.Copyfrom(Filestream, Filestream.Size);
Filestream.Free;
Blobstream.Free;
Table1.Post;
Button1.Enabled := True;
Button2.Enabled := True;
End;
{Reproduz O Que Está Gravado No Campo Blob}
Procedure Tform1.Button2click(Sender: Tobject);
Var Filestream: Tfilestream; {A Temp File}
Blobstream: Tblobstream; {The Avi Blob}
Begin
Blobstream := Tblobstream.Create(Table1avi, Bmread);
If Blobstream.Size = 0 Then
Begin
Blobstream.Free;
Exit;
End;
Mediaplayer1.Close; {Reset The File Name}
Mediaplayer1.Filename := ''; {Refresh The Play Window}
Mediaplayer1.Display := Panel1;
Panel1.Refresh;
If Filename <> '' Then
Deletefile(Filename); {Get A Temp File Name}
Filename := Gettemporaryfilename; {Create A Temp File Stream}
Filestream := Tfilestream.Create(Filename,Fmcreate Or Fmopenwrite);
Filestream.Copyfrom(Blobstream, Blobstream.Size); {Free The Streams}
Filestream.Free; Blobstream.Free;
Mediaplayer1.Filename := Filename;
Mediaplayer1.Devicetype := Dtavivideo;
Mediaplayer1.Open;
Mediaplayer1.Play;
End;
// Evento Ondestroy Do Form
Procedure Tform1.Formdestroy(Sender: Tobject);
Begin
Mediaplayer1.Close;
Mediaplayer1.Filename := '';
If Filename <> '' Then
Deletefile(Filename);
End;
// Evento Onshow Do Form
Procedure Tform1.Formshow(Sender: Tobject);
Begin
Mediaplayer1 := Tmediaplayer.Create(Self);
With Mediaplayer1 Do
Begin
Parent := Self ;
Visible := False;
End;
Table1.Open;
End;
// Evento Onclose Do Form
Procedure Tform1.Formclose(Sender: Tobject; Var Action: Tcloseaction);
Begin
Table1.Close;
End;
End.
Cuidados ao usar o OnExit
É comum fazermos uso do evento OnExit quando queremos validar o conteúdo de um Edit. E essa pode ser uma boa prática quando necessitamos verificar o que foi digitado apenas quando o usuário terminar de fazer a entrada de dados, como, por exemplo, um Edit que vai receber o CPF ou CNPJ.
Ao colocarmos um código qualquer no evento OnExit ele sempre será executado quando o usuário sair do Edit, o que acontece quando ele pressiona a tecla TAB, clica com o mouse em um outro Edit ou pressiona um botão OK, por exemplo.
No entanto, existem algumas situações especiais em que o evento OnExit não é gerado. Quer um exemplo? Você está no Edit e, ao invés de clicar no botão OK, você pressiona as teclas ALT + O (considerando que o botão OK tem a tecla O como atalho). É como se você tivesse pressionado o botão OK, porém, sem perder o foco que está no Edit. Só mais um exemplo: Os botões do tipo SpeedButton não recebem foco, então, mesmo que clique com o mouse sobre um SpeedButton, o foco continuará no Edit e, conseqüentemente, o evento OnExit não será gerado.
E a solução?
A solução para esse pequeno inconveniente é simples. Basta você colocar o seguinte código no evento OnClick do botão.
procedure TForm1.Button1Click(Sender: TObject);
begin
ActiveControl := nil;
...
end;
Suponhamos que você possua 2 Edits em um formulário. Supondo também que você queira dar alguma informação ao usuário da aplicação logo depois que ele sair do Edit1 você faz:
procedure TForm1.Edit1Exit(Sender: TObject);
begin
MessageDlg('Mensagem...', mtInformation, [mbOk], 0);
end;
A princípio está tudo ok, ou melhor, parece estar tudo ok.
Se você altera o foco para o outro Edit através do pressionamento da tecla TAB, tudo bem. Mas experimente alterar o foco clicando com o mouse sobre o Edit2. Neste segundo caso a mensagem será exibida normalmente. Mas ao fechar o dialogo onde aparece a mensagem, o foco simplesmente se perde. Para setar o foco no Edit2 é necessário clicar novamente sobre ele.
Isso poderia não problema nenhum até que seu usuário experimente esta situação. Nada que ele digitar será acatado.
Mas existe uma maneira fácil de resolver o problema. Basta você cancelar o foco e forçar uma reentrada no componente Edit2. Como fazer isso? Veja o código:
procedure TForm1.Edit1Exit(Sender: TObject);
begin
MessageDlg('Mensagem...', mtInformation, [mbOk], 0);
// cancela o foco e força novamente a entrada
ActiveControl := nil;
PostMessage(Edit2.Handle, WM_SETFOCUS, 0, 0);
Edit2.SetFocus;
end;
Porém, você nunca terá certeza se o usuário clicou foi no Edit2. Então temos que criar uma rotina genérica que leva o foco para qualquer outro controle:
procedure TForm1.Edit1Exit(Sender: TObject);
var
Ctrl: TWinControl;
begin
MessageDlg('Mensagem...', mtInformation, [mbOk], 0);
// cancela o foco e força novamente a entrada
Ctrl := ActiveControl;
ActiveControl := nil;
PostMessage(TWinControl(Ctrl).Handle, WM_SETFOCUS, 0, 0);
TWinControl(Ctrl).SetFocus;
end;
Observe que antes de cancelar o foco com ActiveControl := nil, salvamos qual é o controle que detém o foco fazendo Ctrl := ActiveControl.
Depois enviamos uma mensagem ao controle que detinha o foco, forçando-o a receber o foco novamente.
Rave - Imprimindo Gráficos (Chart)
Uma coisa muito comum nos sistemas, são os relatórios com gráficos estatísticos, os famosos Charts.
Antigamente eu usava o QuickReport e o ReportBuilder, porém relatórios com gráficos só precisei fazer no QuickReport e não tive muitas dificuldade, pois ele já tem um componente que facilita a vida.
Mas, como agora larguei o QuickReport e estou usando somente o Rave, houve então a necessidade de saber como fazer relatórios nele com gráficos.
Comecei então a fuçar no Rave e percebi que não existia nenhum componente que facilitasse a vida. Então fiz algumas pesquisas na internet para saber se não existiam componentes de terceiros, mas infelizmente não achei nenhum, porém nessas pesquisas, achei duas soluções para o caso :
1 – Salvar o conteúdo de um TCustomChart em um BMP e imprimir esse BMP no Rave
2 – Usar o método WriteChartData disponível na unit RPTChart
2 – Usar o método WriteChartData disponível na unit RPTChart
Esta última solução é a indicada pela Nevrona.
Fiz o teste com as duas soluções e as duas foram satisfatórias, porém gostei mais da última solução, pois como disse, é indicada pela própria Nevrona e não aparenta ser uma "gambiarra" :-) como a primeira solução.
Depois desta pesquisa, resolvi escrever este artigo para demonstrar como não é um bicho de sete cabeças fazer isso funcionar.
Então vamos lá...
Antes de iniciarmos, gostaria de explicar como a "coisa funciona", para depois partirmos para prática.
O método WriteChartData, "escreve" o conteúdo de um TCustomChart dentro de um campo do tipo Graphic. Então, a princípio, nosso gráfico será montado no TChart ou TDBChart do Delphi, e depois disso, iremos utilizar o WriteChartData para fazer com que o conteúdo do gráfico seja impresso, desenhado dentro do nosso relatório.
Agora vamos colocar em prática esta teoria...
Irei utilizar um RVCustomConnection, pois não preciso estar conectado a um DataSet para gerar o gráfico no Rave, só preciso de alguém que me disponibilize um campo para poder usá-lo na impressão, então o RVCustomConnection é o ideal para isso. Para quem não sabe para que serve o RVCustomConnection, vale a pena começar a mexer nele, pois é muito interessante.
Agora é serio, chega de teoria e vamos para prática...:-)
1 - Insira os seguintes componentes no Form:
TRVProject
TRVCustomConnection
TRVSystem
TChart
TRVProject
TRVCustomConnection
TRVSystem
TChart
2 – Na clausula uses, insira a unit RPTChart. É esta unit que nos disponibilizará o método WriteChartData
3 - Ajuste a propriedade Engine do RaveProject, apontando para o RVSystem.
4 - Ajuste o Chart, de forma que represente algum gráfico, só para podermos visualizar o resultado final.
5 – Agora iremos ajustar dois eventos do componente RVCustomConnection:
OnGetCols:
Este evento é chamado quando o Rave necessita extrair os meta-data dos campos. É aqui que criaremos nosso campo do tipo graphic. Para isso, coloque o seguinte código neste evento:
Este evento é chamado quando o Rave necessita extrair os meta-data dos campos. É aqui que criaremos nosso campo do tipo graphic. Para isso, coloque o seguinte código neste evento:
with Connection do
begin
WriteField('CampoChart', dtGraphic, 0, '', '');
end;
begin
WriteField('CampoChart', dtGraphic, 0, '', '');
end;
OnGetRow:
Este evento é chamado quando o Rave necessita extrair os valores dos campos do registro atual. É aqui que iremos alimentar o valor do campo que criamos acima. Para isso, coloque o seguinte código neste evento:
Este evento é chamado quando o Rave necessita extrair os valores dos campos do registro atual. É aqui que iremos alimentar o valor do campo que criamos acima. Para isso, coloque o seguinte código neste evento:
WriteChartData(Connection, Chart1);
Chart1 é o nome do TChart que inserimos no Form.
A parte de codificação já está pronta, agora vamos para parte visual.
6 – Entre no RaveDesigner
7 – Crie uma Region e dentro desta Region crie uma banda simples.
8 – Dentro da Band1(que acabou de ser criada), insira o componente MetaFile, que está na palheta Standard do Rave.
9 – Crie uma DataView, da mesma forma que se fosse criar uma outra qualquer, a diferença é que os dados agora virão de um RVCustomConnection.
10 - Após ter criado, perceba que na TreeView o DataView1 está disponível, porém se clicar no sinal de mais do DataView1 para exibir os campos, perceberá que o campo que criamos via código(CampoChart) não está disponível, só tem um campo, que é o que vem de brinde, mas não use-o. Para que o nosso campo possa ser criado, o evento OnGetCols terá que ser chamado, e como fazer isso em tempo de projeto ?
O segredo é : O RaveDesigner tem que estar aberto juntamente com a aplicação e depois chamar o Refresh do DataView.
Então vamos lá...
11 - Execute a aplicação e volte para o RaveDesigner, mas não feche a aplicação ainda.
12 – Selecione o DataView1 lá na TreeView e clique com o botão direito do mouse sobre o DataView1. Aparecerá um item chamado Refresh, basta clicar nele e...bingo :-). Pronto, o campo que criamos via código irá aparecer na lista. Quando clicar pela primeira vez no Refresh, vai aparecer uma mensagem, é uma alerta de que um campo será excluído, isso ocorre pois quando criamos a DataView, já veio aquele campo de brinde, mas como não criamos ele no OnGetCols, então a mensagem alertará de que o mesmo será excluído.
13 – Agora selecione o componente MetaFile que foi inserindo em Band1 e altere duas propriedades dele:
DataField : CampoChart (nome do campo que criamos)
DataView : DataView1 (nome da dataview criada)
DataView : DataView1 (nome da dataview criada)
Pronto...Pode executar a aplicação e fazer o teste.
Caso queira fazer o teste no próprio preview do RaveDesigner, basta deixar a aplicação aberta, caso contrário, se a aplicação não estiver aberta e você chamar o preview do RaveDesigner, receberá de presente um errinho básico, o famoso "Acess violation..." :-)
Lembre-se, o exemplo que fizemos foi com um TChart, o mesmo poderá ser feito com um TDBChart.
Outro detalhe, utilizamos um RVCustomConnection, mas poderíamos utilizar um RVDataSetConnection sem problemas, porém neste caso, só fique atento com o seguinte:
No evento OnGetCols, antes de criar o campo, chame o método DoGetCols do Connection que vem como parâmetro neste evento. Isso deve ser feito para que primeiro sejam criadas as colunas do DataSet que está associado e depois sim poder criar as suas colunas.
E no evento OnGetRow, antes de chamar o WriteChartData, chame o método DoGetRow do Connection que vem como parâmetro neste evento. Isso deve ser feito para que primeiro seja alimentando os campos do DataSet que está associado e depois sim poder alimentar seus campos criados manualmente.
Espero que um dia possa surgir um componente para utilizarmos no Rave, pois assim ficará muito mais fácil, mas enquanto isso não acontece, temos esta solução.
Utilizando DBExpress de uma Maneira Fácil
DBExpress, segundo meus testes, é a melhor tecnologia para comunicação com banco de dados. Mas, infelizmente, exige a configuração de vários parâmetros e manipulação de vários componentes visuais.
Pensando neste problema, resolvi criar um componente que contém um conjunto de classes, para facilitar a vida do programador em trabalhar com esta maravilhosa tecnologia.
Procurei criar as classes da melhor maneira possível, com os nomes dos métodos e propriedades o mais parecido possível com o que conhecemos e utilizamos em BDE, Zeos, ADO e mesmo no DBExpress.
Neste artigo, descreverei como instalar e fazer uma aplicação simples. Espero que seja útil para a comunidade e, talvez, os pacotes e classes de suas regras de negócio a utilizem.
Neste artigo, descreverei como instalar e fazer uma aplicação simples. Espero que seja útil para a comunidade e, talvez, os pacotes e classes de suas regras de negócio a utilizem.
Passo 1
Download http://sourceforge.net/projects/dddbxfacil/
Este pacote comtém o componente dddbxfacil com suas classes, bem como uma aplicação simples para utilizá-la.
Este pacote comtém o componente dddbxfacil com suas classes, bem como uma aplicação simples para utilizá-la.
Passo 2
Criar arquivo de configuração. Este arquivo, já está contido no pacote de exemplo e, ele contém a estrutura que é usada pelo dbconnections.ini e, serve para indicar os parâmetros para conexão ao banco de dados. Eu não costumo deixar o login e password contido neste arquivo mas, nada impede de se inserir nele.
A configuração que defini, foi para o Oracle mas, pode ser para qualquer banco que o Dbexpress é compatível que, acho que são todos:
[NOMESECAOCONFIGORACLE]
CONNECTIONNAME=OracleConnection
GETDRIVERFUNC=getSQLDriverORACLE
VENDORLIB=oci.dll
LibraryName=dbxora30.dll
DriverName=Oracle
HostName=
Database=
User_Name=
Password=
BlobSize=-1
ErrorResourceFile=
LocaleCode=0000
Compressed=False
Encrypted=False
CONNECTIONNAME=OracleConnection
GETDRIVERFUNC=getSQLDriverORACLE
VENDORLIB=oci.dll
LibraryName=dbxora30.dll
DriverName=Oracle
HostName=
Database=
User_Name=
Password=
BlobSize=-1
ErrorResourceFile=
LocaleCode=0000
Compressed=False
Encrypted=False
Passo 3
No uses de sua unit, vamos inserir as seguintes units:
DB, DBTables, ddcomumDBX, ddconexaoDBX, ddsqlDBX, ddproviderDBX.
DB, DBTables, ddcomumDBX, ddconexaoDBX, ddsqlDBX, ddproviderDBX.
Passo 4
Vamos no private e, colocar as seguintes “variáveis”:
ConexaoDBX: TConexaoDBX;
ProviderDBX: TProviderDBX;
SqlDBX: TsqlDBX;
ProviderDBX: TProviderDBX;
SqlDBX: TsqlDBX;
Passo 5
Este passo é opcional mas, para mostrar melhor o funcionamento da classe, criaremos um método chamado MeuDataChange, novamente apontar ele.
//No private:
procedure MeuDataChange(Sender: TObject; Field: Tfield); //No implementation
procedure TForm2.MeuDataChange(Sender: TObject; Field: TField);
begin
// Nao é necessário colocar teste para ver se tabela tá aberta, DisableControls, etc…
grbTesteGrid.Caption := ‘Testando o grid. Agora são ‘+
FormatDateTime(‘dd/mm/yyyy hh:nn:ss’, now);
end;
procedure MeuDataChange(Sender: TObject; Field: Tfield); //No implementation
procedure TForm2.MeuDataChange(Sender: TObject; Field: TField);
begin
// Nao é necessário colocar teste para ver se tabela tá aberta, DisableControls, etc…
grbTesteGrid.Caption := ‘Testando o grid. Agora são ‘+
FormatDateTime(‘dd/mm/yyyy hh:nn:ss’, now);
end;
Passo 6
Precisamos instanciar as variáveis que criamos no private. Para isso, criei procedimentos para facilitar isso. No formShow, colocaremos o seguinte código:
ddconexaoDBX.ConexaoDBXInit(ConexaoDBX, nil,
IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+‘configuracao.ini’,
‘NOMESECAOCONFIGORACLE’); ConexaoDBX.Login := ‘usuario’;
ConexaoDBX.Senha := ‘senha’;
ddproviderDBX.ProviderDBXInit(ProviderDBX,
ConexaoDBX,
DBGrid1,
‘ROWID’,
true,
MeuDataChange);
ddsqlDBX.SqlDBXInit(SqlDBX, ConexaoDBX);
IncludeTrailingPathDelimiter(ExtractFilePath(Application.ExeName))+‘configuracao.ini’,
‘NOMESECAOCONFIGORACLE’); ConexaoDBX.Login := ‘usuario’;
ConexaoDBX.Senha := ‘senha’;
ddproviderDBX.ProviderDBXInit(ProviderDBX,
ConexaoDBX,
DBGrid1,
‘ROWID’,
true,
MeuDataChange);
ddsqlDBX.SqlDBXInit(SqlDBX, ConexaoDBX);
Passo 7
Exemplo de código para executar busca no banco de dados:
procedure TForm2.btnProcurarClick(Sender: TObject);
var
Retorno: TProviderRetorno;
begin
ConexaoDBX.ConectarSeDesconectado; ProviderDBX.ClearAll;
with ProviderDBX, ProviderDBX.LinhaSQL do
begin
Add(‘SELECT * FROM TABELA’);
Retorno := OpenDQL;
end;
end;
var
Retorno: TProviderRetorno;
begin
ConexaoDBX.ConectarSeDesconectado; ProviderDBX.ClearAll;
with ProviderDBX, ProviderDBX.LinhaSQL do
begin
Add(‘SELECT * FROM TABELA’);
Retorno := OpenDQL;
end;
end;
Passo 8
Exemplo de evento de inclusão:
procedure TForm2.btnincluirClick(Sender: TObject);
var
iProximoCodigo: integer;
begin
ConexaoDBX.ConectarSeDesconectado; // Pegar Próximo Codigo
with SQLDBX do
begin
setLinhaSQL(‘SELECT MAX(CODIGO) PROXIMO FROM TABELA’);
OpenDQL;
iProximoCodigo := SQLDQl.FieldByName(‘PROXIMO’).AsInteger+1;
end;
ConexaoDBX.Transacao_Abrir;
try
// Incluir
with SqlDBX do
begin
ClearAll;
with LinhaSQL do
begin
Add(‘INSERT INTO TABELA (CODIGO, DESCRICAO)’);
Add(‘VALUES’);
Add(‘(:P_CODIGO,
_DESCRICAO)’);
end;
AddParam(ftInteger, ‘P_CODIGO’, iProximoCodigo);
AddParam(ftString, ‘P_DESCRICAO’, ‘nome ‘+IntToStr(iProximoCodigo));
ExecDML;
end;
ConexaoDBX.Transacao_Commit;
except
on E:Exception do
begin
ConexaoDBX.Transacao_RollBack;
ShowMessage(E.Message);
end;
end;
end;
var
iProximoCodigo: integer;
begin
ConexaoDBX.ConectarSeDesconectado; // Pegar Próximo Codigo
with SQLDBX do
begin
setLinhaSQL(‘SELECT MAX(CODIGO) PROXIMO FROM TABELA’);
OpenDQL;
iProximoCodigo := SQLDQl.FieldByName(‘PROXIMO’).AsInteger+1;
end;
ConexaoDBX.Transacao_Abrir;
try
// Incluir
with SqlDBX do
begin
ClearAll;
with LinhaSQL do
begin
Add(‘INSERT INTO TABELA (CODIGO, DESCRICAO)’);
Add(‘VALUES’);
Add(‘(:P_CODIGO,
_DESCRICAO)’);end;
AddParam(ftInteger, ‘P_CODIGO’, iProximoCodigo);
AddParam(ftString, ‘P_DESCRICAO’, ‘nome ‘+IntToStr(iProximoCodigo));
ExecDML;
end;
ConexaoDBX.Transacao_Commit;
except
on E:Exception do
begin
ConexaoDBX.Transacao_RollBack;
ShowMessage(E.Message);
end;
end;
end;
Assinar:
Postagens (Atom)