 |
ActiveDelphi
.: O site do programador Delphi! :.
|
| Exibir mensagem anterior :: Exibir próxima mensagem |
| Autor |
Mensagem |
adriano_servitec
Colaborador
Registrado: Sexta-Feira, 30 de Janeiro de 2004
Mensagens: 17618
|
 Enviada: Qua Set 08, 2010 1:38 pm Assunto: |
 |
|
| felipecaputo escreveu: | Adriano, se vc já tiver pronto pode deixar então mas desenvolvi um sistema de licensa com base no YPOnguarg e ficou bem bacana viu, consegui implementar todo o sistema desde validação à registro em uma única unit se você ou mais alguém tiver interesse eu posto aki.
PS.: O Serial é gerado com base na data de validade do registro, serial e numeração do hd. O Serial é principalmente para controlar qtos registro o seu cliente tem pois, se ele registrar 2 máquinas com o mesmo serial o registro da primeira será excluido! |
Olá Felipe, blz... Então eu desenvolvi um aqui em parceria com o Pestana (colega aqui do forum), porém tive (e ainda estou tendo) problemas com o windows 7, até consegui fazer funcionar no windows 7 na minha maquina, mais não consegui no cliente devido aos previlégios que o windows pede... Até fiquei de arrumar isso mudando alguns comandos que eu criei, mais devido ao tempo não pude ainda ver...
Muito bancana sua iniciativa em colaborar, se quiser postar sua classe, fique a vontade amigo.
_________________
Jogo seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.drumsetfree |
|
| Voltar ao Topo |
|
 |
faccruz
Colaborador
Registrado: Terça-Feira, 20 de Julho de 2010
Mensagens: 1563
|
| Enviada: Qua Set 08, 2010 1:40 pm Assunto: |
|
|
Posta aí para darmos uma analisada
_________________
Facc System - Sistemas para Computador |
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 1:52 pm Assunto: |
|
|
Segue a unit
A key seria uma diferente por aplicação
| Código: | unit uRegistraNFe;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uBaseGeral, OnGuard,ogUtil, StdCtrls, ExtCtrls, Buttons, jpeg, FMTBcd,
DB, SqlExpr;
type
TfrmRegistraNFe = class(TfrmBaseGeral)
txtSerial: TEdit;
txtValidade: TEdit;
Label6: TLabel;
txtRegistro1: TEdit;
Label3: TLabel;
txtRegistro2: TEdit;
Label4: TLabel;
txtRegistro3: TEdit;
Label5: TLabel;
txtRegistro4: TEdit;
txtIdComputador: TEdit;
Label2: TLabel;
Label1: TLabel;
OgMakeKeys: TOgMakeKeys;
Label7: TLabel;
txtProprietario: TEdit;
btnRegistrar: TBitBtn;
Panel1: TPanel;
Panel2: TPanel;
Image1: TImage;
Label8: TLabel;
Label9: TLabel;
Label10: TLabel;
Label11: TLabel;
procedure txtValidadeChange(Sender: TObject);
procedure txtRegistro1Change(Sender: TObject);
procedure txtSerialKeyPress(Sender: TObject; var Key: Char);
procedure btnRegistrarClick(Sender: TObject);
procedure FormCreate(Sender: TObject);
private
{ Private declarations }
public
class procedure RegistrarNFe;
{ Public declarations }
end;
var
frmRegistraNFe: TfrmRegistraNFe;
const
Chave : TKey = (#####################################);
implementation
uses uDTMNfe, uproced_comuns, uDtmPrincipal;
{$R *.dfm}
procedure TfrmRegistraNFe.txtValidadeChange(Sender: TObject);
begin
inherited;
if Length(TEdit(Sender).Text) = 6 then
perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TfrmRegistraNFe.txtRegistro1Change(Sender: TObject);
begin
inherited;
if Length(TEdit(Sender).Text) = 4 then
perform(WM_NEXTDLGCTL, 0, 0);
end;
procedure TfrmRegistraNFe.txtSerialKeyPress(Sender: TObject; var Key: Char);
begin
inherited;
if not (key in ['0'..'9',#8,#127]) then
key := #0;
end;
procedure TfrmRegistraNFe.btnRegistrarClick(Sender: TObject);
var
Code : TCode;
CodeString,Codigo: String;
Serial, i, vazios: Integer;
dtmAberto: Boolean;
Key : TKey;
tmp : TSQLDataSet;
Validade : TDateTime;
begin
vazios := 0;
for i := 0 to ComponentCount -1 do
begin
if Components[i] is TEdit then
begin
If length(Trim(Tedit(Components[i]).Text)) = 0 then
begin
vazios := vazios + 1;
TEdit(Components[i]).Color := $00D5D5FF;
end
else
TEdit(Components[i]).Color := clWhite;
end;
end;
if vazios > 0 then
Raise Exception.Create('Os campos em vermelho não podem ser vazios!');
Key := Chave;
CodeString := txtRegistro1.Text + txtRegistro2.Text + txtRegistro3.Text +
txtRegistro4.Text;
Serial := StrtoInt(txtSerial.Text);
OgMakeKeys.ApplyModifierToKey(StrtoInt(txtIdComputador.Text),key,sizeof(key));
Validade := Trunc(StrtoInt(txtValidade.Text));
InitSerialNumberCode(Key,serial,Trunc(StrtoInt(txtValidade.Text)),Code);
If CodeString = BufferToHex(code,sizeof(code)) then
begin
dtmaberto := Assigned(dtmnfe);
if not dtmaberto then
dtmnfe := tdtmnfe.Create(Application);
tmp := TSQLDataSet.Create(self);
tmp.SQLConnection := dtmnfe.ConexaoRegistro;
tmp.CommandText := 'SELECT '+
' CD_REGISTROS, '+
' NUM_SERIAL, '+
' DATAVALIDADE, '+
' CODIGOREGISTRO, '+
' DATA_REGISTRADO, '+
' REGISTRADOPARA, '+
' NUMEROCOMPUTADOR '+
' FROM '+
' REGISTROS '+
' WHERE '+
' NUM_SERIAL = ' + txtSerial.Text;
tmp.Open;
if tmp.eof then
begin
tmp.Close;
tmp.CommandText := 'INSERT INTO ' +
' REGISTROS ' +
' ( ' +
' CD_REGISTROS, ' +
' NUM_SERIAL, ' +
' DATAVALIDADE, ' +
' CODIGOREGISTRO, ' +
' DATA_REGISTRADO, ' +
' REGISTRADOPARA, ' +
' NUMEROCOMPUTADOR ' +
' ) ' +
' VALUES ( ' +
' ' + inttostr(dtmnfe.Obter_ProxId('GEN_REGISTROS')) + ',' +
' ' + txtSerial.Text + ', ' +
' ' + QuotedStr(FormatDateTime('MM/DD/YYYY',Validade)) + ',' +
' ' + QuotedStr(CodeString) +', ' +
' ' + QuotedStr(FormatDateTime('MM/DD/YYYY',Now)) + ',' +
' ' + QuotedStr(txtProprietario.Text)+', ' +
' ' + txtIdComputador.Text + ' );';
tmp.ExecSQL();
end
else
begin
codigo := tmp.Fields[0].AsString;
tmp.Close;
tmp.CommandText := 'UPDATE REGISTROS SET NUM_SERIAL = ' + txtSerial.Text + ','
+ 'DATAVALIDADE = ' + QuotedStr(FormatDateTime('MM/DD/YYYY',Validade))
+ ',CODIGOREGISTRO = ' + QuotedStr(CodeString) +',DATA_REGISTRADO = '
+ QuotedStr(FormatDateTime('MM/DD/YYYY',Now)) + ',REGISTRADOPARA = '
+ QuotedStr(txtProprietario.Text)+',NUMEROCOMPUTADOR = '
+ txtIdComputador.Text + ' WHERE CD_REGISTROS = ' + Codigo;
tmp.ExecSQL();
end;
tmp.CommandText := 'INSERT INTO ' +
' HISTORICO_REGISTROS ' +
' ( ' +
' CD_HISTORICO_REG, ' +
' SERIAL_REG, ' +
' DATAREG, ' +
' DATAVALIDADE ' +
' ) ' +
' VALUES ( ' +
' ' + inttostr(dtmNFe.Obter_ProxId('GEN_HISTORICO_REGISTROS')) + ',' +
' ' + TXTSERIAL.Text + ', ' +
' ' + QuotedStr(FormatDateTime('MM/DD/YYYY',Now)) + ',' +
' ' + QuotedStr(FormatDateTime('MM/DD/YYYY',Validade)) +
' ); ';
tmp.ExecSQL();
if MensagemSimNao('Registro Efetuado com sucesso, o aplicativo precisa '+#13+#10+'ser finalizado para que as alterações entrem em vigor. Deseja finalizar agora?') then
Application.Terminate
else
ModalResult := MrOk;
end
else
MensagemdeErro('Código de registro informado está incorreto, tente novamente');
end;
class procedure TfrmRegistraNFe.RegistrarNFe;
begin
try
if not Assigned(frmRegistraNFe) then
frmRegistraNFe := TfrmRegistraNFe.Create(Application);
frmRegistraNFe.txtIdComputador.Text := Inttostr(frmRegistraNFe.OgMakeKeys.GenerateMachineModifier);
frmRegistraNFe.ShowModal;
finally
FreeAndNil(frmRegistraNFe);
end;
end;
procedure TfrmRegistraNFe.FormCreate(Sender: TObject);
var
tmp : TSqlDataSet;
dtmaberto : Boolean;
begin
inherited;
tmp := TSqlDataSet.Create(Self);
dtmaberto := assigned(dtmnfe);
if not dtmaberto then
dtmnfe := tdtmnfe.Create(Application);
tmp.SQLConnection := dtmnfe.ConexaoRegistro;
tmp.Close;
tmp.CommandText := 'SELECT '+
' CD_REGISTROS, '+
' NUM_SERIAL, '+
' DATAVALIDADE, '+
' CODIGOREGISTRO, '+
' DATA_REGISTRADO, '+
' REGISTRADOPARA, '+
' NUMEROCOMPUTADOR '+
' FROM '+
' REGISTROS '+
' WHERE '+
' NUMEROCOMPUTADOR = ' + IntToStr(dtmnfe.NumeroDoComputador);
tmp.Open;
if not tmp.Eof then
begin
txtserial.Text := tmp.Fields[1].AsString;
txtserial.ReadOnly := true;
txtProprietario.Text := tmp.Fields[5].AsString;
txtProprietario.ReadOnly := true;
end;
FreeAndNil(tmp);
if not dtmaberto then
FreeAndNil(dtmNFe);
end;
end.
|
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
edsonalves
Colaborador
Registrado: Terça-Feira, 27 de Janeiro de 2009
Mensagens: 1938
Localização: Bauru - SP
|
| Enviada: Qua Set 08, 2010 1:52 pm Assunto: |
|
|
tbm gostaria de dar uma olhada, pois utilizo um componente aqui, mas gostaria de mudar ele, pois não tenho os fontes do mesmo...
_________________
Cria em mim, ó Deus, um coração puro, e renova em mim um espírito reto.
http://twitter.com/edson_alves_
Skype: edson.alvesan
http://www.vacabikers.wordpress.com/ |
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 1:53 pm Assunto: |
|
|
isso em um banco de dados criptografado ok?
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
edsonalves
Colaborador
Registrado: Terça-Feira, 27 de Janeiro de 2009
Mensagens: 1938
Localização: Bauru - SP
|
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 2:21 pm Assunto: |
|
|
é sim por causa do seguinte: Preciso ter gravado o id_computador, o serial, a data de validade e o codigo de registro.
Se o usuário acessar o banco e alterar qualquer destes dados o sistema perde a licensa
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 2:24 pm Assunto: |
|
|
esqueci de colocar a rotina que valida o registro
PS: a chave gerada é de 6 digitos numéricos + 16 alfanumericos hexadecimais
É a seguinte:
| Código: | class function TdtmNFe.VerificarRegistro: Integer;
var
f : TextFile;
caminhobd,CodigoRegistro,s : string;
Serial : Integer;
Validade:TDateTime;
tmp : TSQLDataSet;
registrado,dtmaberto : Boolean;
Chave : TKey;
Code : TCode;
begin
//-------------------Rotina de Registro do Sistema-----------------------------
//Retornos da Função:
// 20 : Registrado
// 21 : Não Registrado
// 22 : Registro Expirado
// 23 : Registro Diferente do Código
// 24 : Data do Sistema Anterior à Data Registrada
//
if not FilesExists(ExtractFileDir(Application.ExeName) + '\conexao.conf') then
begin
showmessage(ExtractFileDir(Application.ExeName) + '\conexao.conf');
result := 21;
MensagemdeErro('Conexao.conf não encontrado!');
end
else
begin
AssignFile(f,ExtractFileDir(Application.ExeName) + '\conexao.conf');
reset(f);
readln(f,s);
closefile(f);
chave := Key;
dtmaberto := Assigned(dtmnfe);
if not dtmaberto then
dtmnfe := TdtmNfe.Create(application);
caminhobd := copy(s,1,length(s)-13) + 'DATAREG.AD';
with dtmnfe do
begin
try
tmp := TSQLDataSet.Create(Application);
tmp.SQLConnection := ConexaoRegistro;
tmp.CommandText := 'Select CD_ULTIMOACESSO, dataultimoacesso from ultimoacesso order by dataultimoacesso desc';
tmp.Open;
if tmp.eof then
ConexaoRegistro.ExecuteDirect('INSERT INTO ULTIMOACESSO(CD_ULTIMOACESSO, DATAULTIMOACESSO) VALUES (1,CURRENT_TIMESTAMP)');
if Now >= tmp.Fields[1].AsDateTime then
begin
ConexaoRegistro.ExecuteDirect('update ULTIMOACESSO set dataultimoacesso=CURRENT_TIMESTAMP where cd_ULTIMOACESSO = 1');
tmp.Close;
tmp.CommandText := 'SELECT '+
' CD_REGISTROS, '+
' NUM_SERIAL, '+
' DATAVALIDADE, '+
' CODIGOREGISTRO, '+
' DATA_REGISTRADO, '+
' REGISTRADOPARA, '+
' NUMEROCOMPUTADOR '+
' FROM '+
' REGISTROS '+
' WHERE '+
' NUMEROCOMPUTADOR = ' + IntToStr(NumeroDoComputador);
tmp.Open;
if tmp.eof then
begin
Result := 21;
end
else
begin
Serial := tmp.Fields[1].AsInteger;
CodigoRegistro := tmp.Fields[3].AsString;
Validade := tmp.Fields[2].AsDateTime;
OgMakeKeys.ApplyModifierToKey(NumeroDoComputador,Chave,sizeof(chave));
InitSerialNumberCode(Chave,serial,validade,Code);
if CodigoRegistro = BufferToHex(Code,Sizeof(Code)) then
begin
if IsSerialNumberCodeExpired(Chave,Code) then
begin
result := 22;
if Validade <> GetExpirationDate(Chave,Code) then
begin
validade := GetExpirationDate(Chave,Code);
ConexaoRegistro.ExecuteDirect('update registros set datavalidade = ' + QuotedStr(FormatDateTime('MM/DD/YYYY',Validade)) + ' where serial = ' + inttostr(Serial));
end;
end
else
begin
result := 20;
end;
end
else
result := 23;
end;
end
else
result := 24;
finally
freeandnil(tmp);
if not dtmaberto then
freeandnil(dtmnfe);
end;
end;
end;
//-------------------Rotina de Registro do Sistema-----------------------------
end; |
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
adriano_servitec
Colaborador
Registrado: Sexta-Feira, 30 de Janeiro de 2004
Mensagens: 17618
|
| Enviada: Qua Set 08, 2010 3:13 pm Assunto: |
|
|
Felipe...Para rodar esta classe, precisa de todos este aqui
| Citação: | uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, uBaseGeral, OnGuard,ogUtil, StdCtrls, ExtCtrls, Buttons, jpeg, FMTBcd,
DB, SqlExpr; |
_________________
Jogo seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.drumsetfree |
|
| Voltar ao Topo |
|
|
adriano_servitec
Colaborador
Registrado: Sexta-Feira, 30 de Janeiro de 2004
Mensagens: 17618
|
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 3:36 pm Assunto: |
|
|
Roda no windows 7 -> Sim
Validade é configuravel
Se mudar a data do programa o sistema bloqueia
uBaseGeral - Pode Excluir e mudar para TForm na classe embaixo, é pq trabalho com forms herdados das principais funções.
data do herdado é nescessário
as units - onGuard e ogUtil são do Componente TPOnguard (Free) - Link
http://sourceforge.net/projects/tponguard/
FMTBCD é por causa dos campos BCD do firebird (NUMERIC)
unit para gerar chave de registro: Esqueci dela...rs:
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 3:37 pm Assunto: |
|
|
| Código: | unit UGeraRegistro;
interface
uses
Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls, Buttons, ExtCtrls, OnGuard, Clipbrd, OgUtil, DB,
DBCtrls;
type
TfrmGerarRegistro = class(TForm)
Panel1: TPanel;
txtIdMaquina: TEdit;
Label1: TLabel;
Label2: TLabel;
dtpValidade: TDateTimePicker;
chkValidade: TCheckBox;
Label3: TLabel;
lblNumRegistro: TLabel;
OgMakeKeys: TOgMakeKeys;
btnGerarRegistro: TBitBtn;
Label5: TLabel;
txtSerial: TEdit;
btnCopiar: TBitBtn;
cmbAplicativo: TDBLookupComboBox;
ds: TDataSource;
txtNRegistros: TEdit;
chkNreg: TCheckBox;
procedure FormActivate(Sender: TObject);
procedure chkValidadeExit(Sender: TObject);
procedure btnGerarRegistroClick(Sender: TObject);
procedure btnCopiarClick(Sender: TObject);
procedure FormKeyPress(Sender: TObject; var Key: Char);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure chkNregClick(Sender: TObject);
private
ChaveKey: Tkey;
{ Private declarations }
public
inserindo: boolean;
Class Procedure AdicionarRegistro;
Class Procedure EditarRegistro;
{ Public declarations }
end;
var
frmGerarRegistro: TfrmGerarRegistro;
implementation
uses uproced_comuns, udtmCadastros, udtmPrincipal, Windows;
{$R *.dfm}
class procedure TfrmGerarRegistro.AdicionarRegistro;
begin
if not Assigned(frmGerarRegistro) then
frmGerarRegistro := TfrmGerarRegistro.Create(Application);
frmGerarRegistro.inserindo := true;
if frmGerarRegistro.ShowModal <> mrok then
dtmCadastros.cdsRegistros.CancelUpdates;
FreeAndNil(frmGerarRegistro);
end;
procedure TfrmGerarRegistro.btnCopiarClick(Sender: TObject);
begin
Clipboard.AsText := lblNumRegistro.Caption;
end; |
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 3:39 pm Assunto: |
|
|
| Código: | procedure TfrmGerarRegistro.btnGerarRegistroClick(Sender: TObject);
var
Chave: Tkey;
MachineMod: Integer;
Validade: TDate;
Serial: LongInt;
CodigoRegistro: TCode;
CodeString,Nmaquinas,valortemp: String;
I, valor : Integer;
begin
try
MachineMod := StrToInt(txtIdMaquina.Text);
except
MensagemdeErro('Número Identificador do Computador não é valido');
exit;
end;
try
Serial := StrToInt(txtSerial.Text) except MensagemdeErro
('Número Serial informado não é valido');
exit;
end;
if Length(cmbAplicativo.Text) = 0 then
begin
MensagemdeErro('Selecione o software do registro');
exit;
end;
btnGerarRegistro.Enabled := false;
OgUtil.HexToBuffer(cmbAplicativo.KeyValue, Chave, sizeof(Chave));
if chkValidade.Checked then
Validade := dtpValidade.Date
else
Validade := StrtoDate('31/12/2199');
OgMakeKeys.SetKey(Chave);
OgMakeKeys.ApplyModifierToKey(MachineMod, Chave, sizeof(Chave));
InitSerialNumberCode(Chave, Serial, Validade, CodigoRegistro);
CodeString := BufferToHex(CodigoRegistro, sizeof(CodigoRegistro));
System.Insert('-', CodeString, 13);
System.Insert('-', CodeString, 09);
System.Insert('-', CodeString, 05);
if txtNRegistros.Enabled then
begin
if length(txtNRegistros.Text) <= 2 then
begin
txtNRegistros.Text := FormatFloat('00',strtoint(txtNRegistros.Text));
Nmaquinas := Chr(65+(Random(6)))+Copy(txtNRegistros.Text,1,1)+Chr(65+(Random(6)))+Copy(txtNRegistros.Text,2,1);
end
else if length(txtNRegistros.Text) = 3 then
begin
txtNRegistros.Text := FormatFloat('000',strtoint(txtNRegistros.Text));
Nmaquinas := Copy(txtNRegistros.Text,1,1)+Chr(65+(Random(6)))+Copy(txtNRegistros.Text,2,1)+Copy(txtNRegistros.Text,3,1);
end;
for I := 1 to Length(Nmaquinas) do
valor := valor + Strtointdef(Nmaquinas[i],0);
valortemp := FormatFloat('000',((valor*1.75)));
valor := (Strtoint(valortemp[1]) + StrToInt(valortemp[2])+StrToInt(valortemp[3])) div 2;
CodeString := CodeString + '-'+Nmaquinas+inttostr(valor);
end;
if inserindo then
begin
with dtmCadastros do
begin
cdsSistemas.Locate('KEY_REGISTRO', cmbAplicativo.KeyValue, []);
cdsRegistros.Append;
cdsRegistrosCD_CLIENTES.Value := cdsClientesCD_CLIENTES.Value;
cdsRegistrosCD_SISTEMAS.Value := cdsSistemasCD_SISTEMAS.Value;
cdsRegistrosDATA_PRIM_LIB.Value := Now;
cdsRegistrosDATA_ULT_LIB.Value := Now;
cdsRegistrosSERIAL.Value := Serial;
cdsRegistrosID_COMPUTADOR.Value := MachineMod;
cdsRegistrosVALIDADE.Value := Validade;
cdsRegistrosCODIGO_GERADO.Value := FormatFloat('000000', Trunc(Validade))
+ '-' + CodeString;
cdsRegistrosCD_USUARIOS.Value := dtmprincipal.FuncLogado;
cdsRegistros.Post;
cdsRegistros.ApplyUpdates(-1);
end;
end
|
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 3:39 pm Assunto: |
|
|
| Código: | else
begin
with dtmCadastros do
begin
cdsSistemas.Locate('KEY_REGISTRO', cmbAplicativo.KeyValue, []);
cdsRegistros.Edit;
cdsRegistrosDATA_ULT_LIB.Value := Now;
cdsRegistrosID_COMPUTADOR.Value := MachineMod;
cdsRegistrosVALIDADE.Value := Validade;
cdsRegistrosCODIGO_GERADO.Value := FormatFloat('000000', Trunc(Validade))
+ '-' + CodeString;
cdsRegistrosCD_USUARIOS.Value := dtmprincipal.FuncLogado;
cdsRegistros.Post;
cdsRegistros.ApplyUpdates(-1);
end;
end;
lblNumRegistro.Caption := FormatFloat('000000', Trunc(Validade))
+ '-' + CodeString;
end;
procedure TfrmGerarRegistro.chkNregClick(Sender: TObject);
begin
txtNRegistros.Enabled := chkNreg.Checked;
end;
procedure TfrmGerarRegistro.chkValidadeExit(Sender: TObject);
begin
dtpValidade.Enabled := chkValidade.Checked;
end;
class procedure TfrmGerarRegistro.EditarRegistro;
begin
if not Assigned(frmGerarRegistro) then
frmGerarRegistro := TfrmGerarRegistro.Create(Application);
frmGerarRegistro.inserindo := false;
if frmGerarRegistro.ShowModal <> mrok then
dtmCadastros.cdsRegistros.CancelUpdates;
FreeAndNil(frmGerarRegistro);
end; |
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
felipecaputo
Colaborador
Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC
|
| Enviada: Qua Set 08, 2010 3:40 pm Assunto: |
|
|
| Código: | procedure TfrmGerarRegistro.FormActivate(Sender: TObject);
var
I: Integer;
begin
// txtIdMaquina.Text := InttoStr(OgMakeKeys.GenerateMachineModifier);
dtpValidade.Date := (Trunc(Now) + 90);
dtpValidade.Enabled := false;
if not inserindo then
begin
txtSerial.Enabled := false;
cmbAplicativo.Enabled := false;
txtSerial.Text := dtmCadastros.cdsRegistrosSERIAL.AsString;
dtmCadastros.cdsSistemas.Locate('cd_sistemas',
dtmCadastros.cdsRegistrosCD_SISTEMAS.Value, []);
cmbAplicativo.KeyValue := dtmCadastros.cdsSistemasKEY_REGISTRO.Value;
end
else
begin
Randomize;
for I := 0 to 7 do
txtSerial.Text := txtSerial.Text + InttoStr(Trunc(Random(9)));
end;
end;
procedure TfrmGerarRegistro.FormCloseQuery(Sender: TObject;
var CanClose: Boolean);
begin
if btnGerarRegistro.Enabled then
ModalResult := mrCancel
else
ModalResult := mrok;
end;
procedure TfrmGerarRegistro.FormKeyPress(Sender: TObject; var Key: Char);
begin
if Key = #13 then
begin
Key := #0;
perform(40, 0, 0);
end;
if Key = #27 then
begin
Key := #0;
Self.Close;
end;
end;
end. |
_________________
if Post.State = psResolvido then
Post.Caption := Post.Caption + ' [RESOLVIDO]';
_____________________________________________
O único homem que está isento de erros, é aquele que não arrisca acertar. Albert Einstein |
|
| Voltar ao Topo |
|
|
|
|
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.
|
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
