ActiveDelphi - Índice do Fórum ActiveDelphi
.: O site do programador Delphi! :.
 
 FAQFAQ   PesquisarPesquisar   MembrosMembros   GruposGrupos   RegistrarRegistrar 
 PerfilPerfil   Entrar e ver Mensagens ParticularesEntrar e ver Mensagens Particulares   EntrarEntrar 

Gerenciador de Licença?
Ir à página Anterior  1, 2, 3, 4, 5, 6, 7, 8, 9  Próximo
 
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi
Exibir mensagem anterior :: Exibir próxima mensagem  
Autor Mensagem
adriano_servitec
Colaborador
Colaborador


Registrado: Sexta-Feira, 30 de Janeiro de 2004
Mensagens: 17357

MensagemEnviada: Qua Set 08, 2010 1:38 pm    Assunto: Responder com Citação

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.
_________________
Quer uma bateria musical profissional completa em seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.hhopdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
faccruz
Colaborador
Colaborador


Registrado: Terça-Feira, 20 de Julho de 2010
Mensagens: 1563

MensagemEnviada: Qua Set 08, 2010 1:40 pm    Assunto: Responder com Citação

Posta aí para darmos uma analisada
_________________
Facc System - Sistemas para Computador
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular Visitar a homepage do Usuário
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 1:52 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
edsonalves
Colaborador
Colaborador


Registrado: Terça-Feira, 27 de Janeiro de 2009
Mensagens: 1938
Localização: Bauru - SP

MensagemEnviada: Qua Set 08, 2010 1:52 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Yahoo Messenger MSN Messenger
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 1:53 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
edsonalves
Colaborador
Colaborador


Registrado: Terça-Feira, 27 de Janeiro de 2009
Mensagens: 1938
Localização: Bauru - SP

MensagemEnviada: Qua Set 08, 2010 2:06 pm    Assunto: Responder com Citação

felipecaputo escreveu:
isso em um banco de dados criptografado ok?


então o registro é efetuado no banco de dados?
_________________
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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Yahoo Messenger MSN Messenger
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 2:21 pm    Assunto: Responder com Citação

é 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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 2:24 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
adriano_servitec
Colaborador
Colaborador


Registrado: Sexta-Feira, 30 de Janeiro de 2004
Mensagens: 17357

MensagemEnviada: Qua Set 08, 2010 3:13 pm    Assunto: Responder com Citação

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;

_________________
Quer uma bateria musical profissional completa em seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.hhopdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
adriano_servitec
Colaborador
Colaborador


Registrado: Sexta-Feira, 30 de Janeiro de 2004
Mensagens: 17357

MensagemEnviada: Qua Set 08, 2010 3:18 pm    Assunto: Responder com Citação

felipecaputo escreveu:
é 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
E mudar a data do sistema, o que aconteçe? A validade é pra quantos dias? Funciona no windows 7?

Este que eu tenho aqui existe um controle de dias para expirar
_________________
Quer uma bateria musical profissional completa em seu smartphone? Acesse o link e confira.
https://play.google.com/store/apps/details?id=br.com.couldsys.hhopdrum
https://play.google.com/store/apps/details?id=br.com.couldsys.rockdrum
Voltar ao Topo
Ver o perfil de Usuários Enviar Mensagem Particular
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 3:36 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 3:37 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 3:39 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 3:39 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
felipecaputo
Colaborador
Colaborador


Registrado: Quinta-Feira, 13 de Mai de 2010
Mensagens: 1719
Localização: Florianópolis / SC

MensagemEnviada: Qua Set 08, 2010 3:40 pm    Assunto: Responder com Citação

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
Ver o perfil de Usuários Enviar Mensagem Particular Enviar E-mail Visitar a homepage do Usuário MSN Messenger
Mostrar os tópicos anteriores:   
Novo Tópico   Responder Mensagem    ActiveDelphi - Índice do Fórum -> Delphi Todos os horários são GMT - 3 Horas
Ir à página Anterior  1, 2, 3, 4, 5, 6, 7, 8, 9  Próximo
Página 4 de 9

 
Ir para:  
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.


Powered by phpBB © 2001, 2005 phpBB Group
Traduzido por: Suporte phpBB