Fórum criar DLL que acessa outra DLL causa acess violation #414344

20/03/2012

0

Boa Noite, Caros colegas
Estou entrando em contato pois não consigo resolver um problema que estou tendo
Resolvi criar um projeto 99% DLL onde tenho DLLs para cadastro, para pesquisa
essas DLL tem funções que retorna valores, assim como funções validadoras.

todas as DLLs estão funcionando perfeitamente
porem depois de um tempo de uso acontece erro de acesso violation e não consigo mais acesso os modulos de cadastro pelas dll de pesquisa.

Abaixo tem o codigo fonte padrão de uma unit que é usada em todas as dll para cada uma poder se chamar caso queira
unit uAcessoDLLs;

interface

uses
  SqlExpr, Classes, DBClient, DB, Provider, Vcl.Forms, cxGrid, uClasse;
  {#########################################
                     DLL USO
  ##########################################}
  procedure Ler_Ini(var  Conexao, BancoDados, Usuario, Senha:string);  stdcall;
  procedure Teclanula_Dif_Enter(Sender: Tcomponent; var key: char); stdcall;
  procedure Configura_SQLConnection(CNX: TSQLConnection;
    var  BancoDados, Usuario, Senha:string);  stdcall;
  procedure Configura_SQLConnection2(CNX: TSQLConnection;
    BancoDados, Usuario, Senha:string);  stdcall;
  procedure CriarIni; stdcall;
  function ArquivoExiste(Arquivo: WideString):BOOLEAN;  stdcall;
  function Pasta_Aplicativo: WideString; stdcall;
  function Escolha_Conexao: string;  stdcall;
  procedure Conexoes(strings: Tstrings);  stdcall;
  procedure finaliza_GDI; stdcall;
  function Verificar_Usuario(DBBancoDados, DBUsuario, DBSenha,
  Usuario, Senha:string): Extended; stdcall;
  procedure ExportaGrid(Form: Tform; Grid: TcxGrid;
    Tipo: TTipoExportacao; a_abrir_arquivo: boolean);  stdcall;
  function InputDate(const ACaption, APrompt: string;
  var Value: TDate): Boolean; stdcall;

  {#########################################
                     DLL EXTRA
  ##########################################}
   function Fazer_Login(BancoDados, Usuario,
    Senha:string) : Extended; stdcall;
  {#########################################
                     DLL PESQUISA
  ##########################################}
   function PesqModal_Menu(idUser: Extended; DBBancoDados, DBUsuario,
   DBSenha: STRING;Menu,i: integer): Extended; stdcall;
  procedure PesqShow_Menu(idUser: Extended; DBBancoDados, DBUsuario,
  DBSenha: STRING;Menu,i: integer); stdcall;
    {#########################################
                     DLL CADASTRO
  ##########################################}
   procedure CadShow_Menu(idUser: Extended; DBBancoDados, DBUsuario,
   DBSenha: STRING;Menu,i, Acao: integer; Registro: extended); stdcall;
  {#########################################
                     DLL TRATATIVA
  ##########################################}
  procedure UpdateErrorMsg(Sender: TObject; DataSet: TCustomClientDataSet;
    E: EUpdateError; UpdateKind: TUpdateKind; var Response: TResolverResponse);stdcall;

  procedure ReconcileErrorMsq(DataSet: TCustomClientDataSet; E: EReconcileError;
    UpdateKind: TUpdateKind; var Action: TReconcileAction);stdcall;

  procedure ReconcileErrorMsq2(DataSet: TCustomClientDataSet; E: EReconcileError;
    UpdateKind: TUpdateKind; var Action: TReconcileAction); stdcall;

  procedure PostErrorMsg(DataSet: TDataSet; E: EDatabaseError;
    var Action: TDataAction); stdcall;

  function Desmascara(Conteudo: String): String; stdcall;
  function Alltrim(Text : string) : string; stdcall;
  function StrZero(Num : Real ; Zeros,Deci: integer): string; stdcall;
  function Mascara(Mascara, Conteudo: String): String;stdcall;
  {#########################################
              MASHUPS
  ##########################################}
  procedure Pesq_DadosReceita(cpf_cnpj: string;
  var Nome, Logr, Nro,Compl, Bair, Cid, Uf, Cep: string); stdcall;



implementation
  {#########################################
                     DLL USO
  ##########################################}
  procedure Ler_Ini(var  Conexao, BancoDados, Usuario,
    Senha:string);  external USO.DLL;
  procedure Teclanula_Dif_Enter(Sender: Tcomponent; var key: char); external USO.DLL;
  procedure Configura_SQLConnection(CNX: TSQLConnection;
    var BancoDados, Usuario, Senha:string);  external USO.DLL;
  procedure Configura_SQLConnection2(CNX: TSQLConnection;
    BancoDados, Usuario, Senha:string);  external USO.DLL;
  procedure CriarIni; external USO.DLL;
  function ArquivoExiste(Arquivo: WideString):BOOLEAN;  external USO.DLL;
  function Pasta_Aplicativo: WideString; external USO.DLL;
  function Escolha_Conexao: string;  external USO.DLL;
  procedure Conexoes(strings: Tstrings);  external USO.DLL;
  procedure finaliza_GDI; external USO.dll;
  function Verificar_Usuario(DBBancoDados, DBUsuario, DBSenha, Usuario,
     Senha:string): Extended; external USO.DLL;
  procedure ExportaGrid(Form: Tform; Grid: TcxGrid;
    Tipo: TTipoExportacao; a_abrir_arquivo: boolean);   external USO.DLL;
  function InputDate(const ACaption, APrompt: string;
  var Value: TDate): Boolean;  external USO.DLL;

  {#########################################
                     DLL EXTRA
  ##########################################}
   function Fazer_Login(BancoDados, Usuario,
    Senha:string) : Extended; external EXTRA.dll;
  {#########################################
                     DLL PESQUISA
  ##########################################}
  function PesqModal_Menu(idUser: Extended; DBBancoDados, DBUsuario,
    DBSenha: STRING;Menu,i: integer): Extended;  external PESQUISA.dll;
  procedure PesqShow_Menu(idUser: Extended; DBBancoDados, DBUsuario,
    DBSenha: STRING;Menu,i: integer); external PESQUISA.dll;


     {#########################################
                     DLL CADASTRO
  ##########################################}
   procedure CadShow_Menu(idUser: Extended; DBBancoDados, DBUsuario, DBSenha: STRING;Menu,i, Acao: integer; Registro: extended); external CADASTRO.dll;
  {#########################################
                     DLL TRATATIVA
  ##########################################}
  procedure UpdateErrorMsg(Sender: TObject; DataSet: TCustomClientDataSet;
    E: EUpdateError; UpdateKind: TUpdateKind; var Response: TResolverResponse);external TRATATIVA.dll;

  procedure ReconcileErrorMsq(DataSet: TCustomClientDataSet; E: EReconcileError;
    UpdateKind: TUpdateKind; var Action: TReconcileAction);external TRATATIVA.dll;

  procedure ReconcileErrorMsq2(DataSet: TCustomClientDataSet; E: EReconcileError;
    UpdateKind: TUpdateKind; var Action: TReconcileAction); external TRATATIVA.dll;

  procedure PostErrorMsg(DataSet: TDataSet; E: EDatabaseError;
    var Action: TDataAction); external TRATATIVA.dll;

  function Desmascara(Conteudo: String): String;  external TRATATIVA.dll;

  function Alltrim(Text : string) : string; external TRATATIVA.dll;

  function StrZero(Num : Real ; Zeros,Deci: integer): string;  external TRATATIVA.dll;

  function Mascara(Mascara, Conteudo: String): String;  external TRATATIVA.dll;
  {#########################################
              MASHUPS
  ##########################################}
  procedure Pesq_DadosReceita(cpf_cnpj: string;
  var Nome, Logr, Nro,Compl, Bair, Cid, Uf, Cep: string);stdcall; external MASHUPS.dll;
end.


Abaixo a outro codigo usado nas chamadas de pesquisa

unit uPesquisa;

interface

uses
   Classes, Vcl.Forms, Vcl.Controls, System.SysUtils;

   function PesqModal_Menu(idUser: Extended; DBBancoDados, DBUsuario, DBSenha: STRING;Menu, i: integer): Extended;
   procedure PesqShow_Menu(idUser: Extended; DBBancoDados, DBUsuario, DBSenha: STRING;Menu, i: integer);


implementation

uses uVw_Usuarios,uVw_Perfil, uVw_Entidade, uPesqGlobal, Vcl.Dialogs,
  uVw_Empresa, uVw_Perfil_Niveis, uVw_Depto, uVw_CentroCusto, uVw_AreaVenda,
  uVw_Classificacao, uVw_RamoAtividade, uVw_Prod, uVw_Prod_Classificacao,
  uVw_Prod_Cor, uVw_Prod_Grupo, uVw_Prod_Marca, uVw_Prod_SubGrupo,
  uVw_Prod_Tamanho;

{#########################################################################
FUNÇÕES
#########################################################################}
function PesqModal_Menu(idUser: Extended; DBBancoDados, DBUsuario, DBSenha: STRING;Menu, i: integer): Extended;
begin
  Result:= -1;
  case Menu of
 -001: FPesqArray[i]:= TFVw_Perfil_Niveis.Create(APPLICATION);
  001: FPesqArray[i]:= TFVw_Entidade.Create(APPLICATION);
  002: FPesqArray[i]:= TFVw_Classificacao.Create(APPLICATION);
  003: FPesqArray[i]:= TFVw_AreaVenda.Create(APPLICATION);
  004: FPesqArray[i]:= TFVw_RamoAtividade.Create(APPLICATION);
  008: FPesqArray[i]:= TFVw_CentroCusto.Create(APPLICATION);
  009: FPesqArray[i]:= TFVw_Depto.Create(APPLICATION);
  029: FPesqArray[i]:= TFVw_Usuarios.Create(APPLICATION);
  030: FPesqArray[i]:= TFVw_Perfil.Create(APPLICATION);
  037: FPesqArray[i]:= TFVw_Prod_Classificacao.Create(application);
  038: FPesqArray[i]:= TFVw_Prod.Create(application);
  039: FPesqArray[i]:= TFVw_Prod_SubGrupo.Create(application);
  040: FPesqArray[i]:= TFVw_Prod_Grupo.Create(application);
  042: FPesqArray[i]:= TFVw_Prod_Cor.Create(application);
  043: FPesqArray[i]:= TFVw_Prod_Tamanho.Create(application);
  044: FPesqArray[i]:= TFVw_Prod_Marca.Create(application);
  145: FPesqArray[i]:= TFVw_Empresa.Create(APPLICATION);
  end;

  try
    FPesqArray[i].IdForm:= i;
    FPesqArray[i].IdMenu:= Menu;
    FPesqArray[i].Sessao.Cod_Usuario:= idUser;
    FPesqArray[i].Name:= FPesq_+IntToStr(abs(i));
    FPesqArray[i].Config_Conexao(DBBancoDados, DBUsuario, DBSenha);
    FPesqArray[i].btnConfirmar.Visible:= true;
    if FPesqArray[i].ShowModal = mrok then
       Result:= FPesqArray[i].cdsPrincipal.FieldByName(FPesqArray[i].CampoPrincipal).AsVariant
    else
      Result:= -1;
  finally
    FreeAndNil(FPesqArray[i]);
  end;
end;

procedure PesqShow_Menu(idUser: Extended; DBBancoDados, DBUsuario, DBSenha: STRING;Menu,i: integer);
begin
  case Menu of
 -001: FPesqArray[i]:= TFVw_Perfil_Niveis.Create(application);
  001: FPesqArray[i]:= TFVw_Entidade.Create(application);
  002: FPesqArray[i]:= TFVw_Classificacao.Create(application);
  003: FPesqArray[i]:= TFVw_AreaVenda.Create(application);
  004: FPesqArray[i]:= TFVw_RamoAtividade.Create(application);
  008: FPesqArray[i]:= TFVw_CentroCusto.Create(application);
  009: FPesqArray[i]:= TFVw_Depto.Create(application);
  029: FPesqArray[i]:= TFVw_Usuarios.Create(application);
  030: FPesqArray[i]:= TFVw_Perfil.Create(application);
  037: FPesqArray[i]:= TFVw_Prod_Classificacao.Create(application);
  038: FPesqArray[i]:= TFVw_Prod.Create(application);
  039: FPesqArray[i]:= TFVw_Prod_SubGrupo.Create(application);
  040: FPesqArray[i]:= TFVw_Prod_Grupo.Create(application);
  042: FPesqArray[i]:= TFVw_Prod_Cor.Create(application);
  043: FPesqArray[i]:= TFVw_Prod_Tamanho.Create(application);
  044: FPesqArray[i]:= TFVw_Prod_Marca.Create(application);
  145: FPesqArray[i]:= TFVw_Empresa.Create(application);
  end;

  FPesqArray[i].IdForm:= i;
  FPesqArray[i].IdMenu:= Menu;
  FPesqArray[i].Sessao.Cod_Usuario:= idUser;
  FPesqArray[i].Name:= FPesq_+IntToStr(abs(i));
  FPesqArray[i].Config_Conexao(DBBancoDados, DBUsuario, DBSenha);
  FPesqArray[i].Show;
end;

end.


Abaixo o outro codigo usando nas chamadas de cadastro

unit uCadastro;

interface

  procedure CadShow_Menu(idUser: Extended;DBBancoDados, DBUsuario,
  DBSenha: STRING;Menu,i, Acao: integer; Registro: extended);


implementation

uses
  uCad_Usuario, Vcl.Forms, uCadGlobal, System.SysUtils, Vcl.Dialogs,
  uCad_Perfil, uCad_CentroCusto, uCad_Depto, uCad_Entidade, uCad_AreaVenda,
  uCad_Classificacao, uCad_RamoAtividade, uCad_Prod, uCad_Prod_Classificacao,
  uCad_Prod_Cor, uCad_Prod_Grupo, uCad_Prod_Marca, uCad_Prod_SubGrupo,
  uCad_Prod_Tamanho;

procedure CadShow_Menu(idUser: Extended;DBBancoDados, DBUsuario,
DBSenha: STRING;Menu,i, Acao: integer; Registro: extended);
begin
 case Menu of
  001: FCadArray[i]:= TFCad_Entidade.Create(application);
  002: FCadArray[i]:= TFCad_Classificacao.Create(application);
  003: FCadArray[i]:= TFCad_AreaVenda.Create(application);
  004: FCadArray[i]:= TFCad_RamoAtividade.Create(application);
  008: FCadArray[i]:= TFCad_CentroCusto.Create(application);
  009: FCadArray[i]:= TFCad_Depto.Create(application);
  029: FCadArray[i]:= TFCad_Usuario.Create(application);
  030: FCadArray[i]:= TFCad_Perfil.Create(application);
  037: FCadArray[i]:= TFCad_Prod_Classificacao.Create(application);
  038: FCadArray[i]:= TFCad_Prod.Create(application);
  039: FCadArray[i]:= TFCad_Prod_SubGrupo.Create(application);
  040: FCadArray[i]:= TFCad_Prod_Grupo.Create(application);
  042: FCadArray[i]:= TFCad_Prod_Cor.Create(application);
  043: FCadArray[i]:= TFCad_Prod_Tamanho.Create(application);
  044: FCadArray[i]:= TFCad_Prod_Marca.Create(application);
  //145: PesqModal_Empresa(DBBancoDados, DBUsuario, DBSenha, i,Menu);
  else
    begin
      Messagedlg(Modulo não liberado, provavelmente esta em produção, mtInformation, [mbok],0);
      abort;
    end;
  end;

  FcadArray[i].IdMenu:= Menu;
  FcadArray[i].idform:= i;
  FcadArray[i].Sessao.Cod_Usuario:= idUser;
  FcadArray[i].Acao:= Acao;
  FcadArray[i].Name:= FCad_+IntToStr(i);
  FcadArray[i].Config_Conexao(DBBancoDados, DBUsuario, DBSenha);
  FCadArray[i].Registro:= Registro;
  FCadArray[i].Procurar;
  FcadArray[i].Show;

end;

end.

Paulo Oliveira.

Paulo Oliveira.

Responder

Posts

23/03/2012

Leonardo Xavier

cara verifique com o crtl alt del u uso de memoria do seu sistema, tive problemas de access violation aqui no meu sistema mas foi por estouro de memoria mesmo, verifique o estado da memoria, tente limpar o histórico de pesquisa da memoria, após cada consulta. pra mim resolveu....
Responder

Gostei + 0

02/05/2012

Rogerio Jesus

Estou com om esmo problema, conseguiu alguma solução?

boa noite, caros colegas
estou entrando em contato pois não consigo resolver um problema que estou tendo
resolvi criar um projeto 99% dll onde tenho dlls para cadastro, para pesquisa
essas dll tem funções que retorna valores, assim como funções validadoras.

todas as dlls estão funcionando perfeitamente
porem depois de um tempo de uso acontece erro de acesso violation e não consigo mais acesso os modulos de cadastro pelas dll de pesquisa.

abaixo tem o codigo fonte padrão de uma unit que é usada em todas as dll para cada uma poder se chamar caso queira
unit uacessodlls;

interface

uses
sqlexpr, classes, dbclient, db, provider, vcl.forms, cxgrid, uclasse;
{#########################################
dll uso
##########################################}
procedure ler_ini(var conexao, bancodados, usuario, senha:string); stdcall;
procedure teclanula_dif_enter(sender: tcomponent; var key: char); stdcall;
procedure configura_sqlconnection(cnx: tsqlconnection;
var bancodados, usuario, senha:string); stdcall;
procedure configura_sqlconnection2(cnx: tsqlconnection;
bancodados, usuario, senha:string); stdcall;
procedure criarini; stdcall;
function arquivoexiste(arquivo: widestring):boolean; stdcall;
function pasta_aplicativo: widestring; stdcall;
function escolha_conexao: string; stdcall;
procedure conexoes(strings: tstrings); stdcall;
procedure finaliza_gdi; stdcall;
function verificar_usuario(dbbancodados, dbusuario, dbsenha,
usuario, senha:string): extended; stdcall;
procedure exportagrid(form: tform; grid: tcxgrid;
tipo: ttipoexportacao; a_abrir_arquivo: boolean); stdcall;
function inputdate(const acaption, aprompt: string;
var value: tdate): boolean; stdcall;

{#########################################
dll extra
##########################################}
function fazer_login(bancodados, usuario,
senha:string) : extended; stdcall;
{#########################################
dll pesquisa
##########################################}
function pesqmodal_menu(iduser: extended; dbbancodados, dbusuario,
dbsenha: string;menu,i: integer): extended; stdcall;
procedure pesqshow_menu(iduser: extended; dbbancodados, dbusuario,
dbsenha: string;menu,i: integer); stdcall;
{#########################################
dll cadastro
##########################################}
procedure cadshow_menu(iduser: extended; dbbancodados, dbusuario,
dbsenha: string;menu,i, acao: integer; registro: extended); stdcall;
{#########################################
dll tratativa
##########################################}
procedure updateerrormsg(sender: tobject; dataset: tcustomclientdataset;
e: eupdateerror; updatekind: tupdatekind; var response: tresolverresponse);stdcall;

procedure reconcileerrormsq(dataset: tcustomclientdataset; e: ereconcileerror;
updatekind: tupdatekind; var action: treconcileaction);stdcall;

procedure reconcileerrormsq2(dataset: tcustomclientdataset; e: ereconcileerror;
updatekind: tupdatekind; var action: treconcileaction); stdcall;

procedure posterrormsg(dataset: tdataset; e: edatabaseerror;
var action: tdataaction); stdcall;

function desmascara(conteudo: string): string; stdcall;
function alltrim(text : string) : string; stdcall;
function strzero(num : real ; zeros,deci: integer): string; stdcall;
function mascara(mascara, conteudo: string): string;stdcall;
{#########################################
mashups
##########################################}
procedure pesq_dadosreceita(cpf_cnpj: string;
var nome, logr, nro,compl, bair, cid, uf, cep: string); stdcall;



implementation
{#########################################
dll uso
##########################################}
procedure ler_ini(var conexao, bancodados, usuario,
senha:string); external uso.dll;
procedure teclanula_dif_enter(sender: tcomponent; var key: char); external uso.dll;
procedure configura_sqlconnection(cnx: tsqlconnection;
var bancodados, usuario, senha:string); external uso.dll;
procedure configura_sqlconnection2(cnx: tsqlconnection;
bancodados, usuario, senha:string); external uso.dll;
procedure criarini; external uso.dll;
function arquivoexiste(arquivo: widestring):boolean; external uso.dll;
function pasta_aplicativo: widestring; external uso.dll;
function escolha_conexao: string; external uso.dll;
procedure conexoes(strings: tstrings); external uso.dll;
procedure finaliza_gdi; external uso.dll;
function verificar_usuario(dbbancodados, dbusuario, dbsenha, usuario,
senha:string): extended; external uso.dll;
procedure exportagrid(form: tform; grid: tcxgrid;
tipo: ttipoexportacao; a_abrir_arquivo: boolean); external uso.dll;
function inputdate(const acaption, aprompt: string;
var value: tdate): boolean; external uso.dll;

{#########################################
dll extra
##########################################}
function fazer_login(bancodados, usuario,
senha:string) : extended; external extra.dll;
{#########################################
dll pesquisa
##########################################}
function pesqmodal_menu(iduser: extended; dbbancodados, dbusuario,
dbsenha: string;menu,i: integer): extended; external pesquisa.dll;
procedure pesqshow_menu(iduser: extended; dbbancodados, dbusuario,
dbsenha: string;menu,i: integer); external pesquisa.dll;


{#########################################
dll cadastro
##########################################}
procedure cadshow_menu(iduser: extended; dbbancodados, dbusuario, dbsenha: string;menu,i, acao: integer; registro: extended); external cadastro.dll;
{#########################################
dll tratativa
##########################################}
procedure updateerrormsg(sender: tobject; dataset: tcustomclientdataset;
e: eupdateerror; updatekind: tupdatekind; var response: tresolverresponse);external tratativa.dll;

procedure reconcileerrormsq(dataset: tcustomclientdataset; e: ereconcileerror;
updatekind: tupdatekind; var action: treconcileaction);external tratativa.dll;

procedure reconcileerrormsq2(dataset: tcustomclientdataset; e: ereconcileerror;
updatekind: tupdatekind; var action: treconcileaction); external tratativa.dll;

procedure posterrormsg(dataset: tdataset; e: edatabaseerror;
var action: tdataaction); external tratativa.dll;

function desmascara(conteudo: string): string; external tratativa.dll;

function alltrim(text : string) : string; external tratativa.dll;

function strzero(num : real ; zeros,deci: integer): string; external tratativa.dll;

function mascara(mascara, conteudo: string): string; external tratativa.dll;
{#########################################
mashups
##########################################}
procedure pesq_dadosreceita(cpf_cnpj: string;
var nome, logr, nro,compl, bair, cid, uf, cep: string);stdcall; external mashups.dll;
end.

abaixo a outro codigo usado nas chamadas de pesquisa

unit upesquisa;

interface

uses
classes, vcl.forms, vcl.controls, system.sysutils;

function pesqmodal_menu(iduser: extended; dbbancodados, dbusuario, dbsenha: string;menu, i: integer): extended;
procedure pesqshow_menu(iduser: extended; dbbancodados, dbusuario, dbsenha: string;menu, i: integer);


implementation

uses uvw_usuarios,uvw_perfil, uvw_entidade, upesqglobal, vcl.dialogs,
uvw_empresa, uvw_perfil_niveis, uvw_depto, uvw_centrocusto, uvw_areavenda,
uvw_classificacao, uvw_ramoatividade, uvw_prod, uvw_prod_classificacao,
uvw_prod_cor, uvw_prod_grupo, uvw_prod_marca, uvw_prod_subgrupo,
uvw_prod_tamanho;

{#########################################################################
funções
#########################################################################}
function pesqmodal_menu(iduser: extended; dbbancodados, dbusuario, dbsenha: string;menu, i: integer): extended;
begin
result:= -1;
case menu of
-001: fpesqarray[i]:= tfvw_perfil_niveis.create(application);
001: fpesqarray[i]:= tfvw_entidade.create(application);
002: fpesqarray[i]:= tfvw_classificacao.create(application);
003: fpesqarray[i]:= tfvw_areavenda.create(application);
004: fpesqarray[i]:= tfvw_ramoatividade.create(application);
008: fpesqarray[i]:= tfvw_centrocusto.create(application);
009: fpesqarray[i]:= tfvw_depto.create(application);
029: fpesqarray[i]:= tfvw_usuarios.create(application);
030: fpesqarray[i]:= tfvw_perfil.create(application);
037: fpesqarray[i]:= tfvw_prod_classificacao.create(application);
038: fpesqarray[i]:= tfvw_prod.create(application);
039: fpesqarray[i]:= tfvw_prod_subgrupo.create(application);
040: fpesqarray[i]:= tfvw_prod_grupo.create(application);
042: fpesqarray[i]:= tfvw_prod_cor.create(application);
043: fpesqarray[i]:= tfvw_prod_tamanho.create(application);
044: fpesqarray[i]:= tfvw_prod_marca.create(application);
145: fpesqarray[i]:= tfvw_empresa.create(application);
end;

try
fpesqarray[i].idform:= i;
fpesqarray[i].idmenu:= menu;
fpesqarray[i].sessao.cod_usuario:= iduser;
fpesqarray[i].name:= fpesq_+inttostr(abs(i));
fpesqarray[i].config_conexao(dbbancodados, dbusuario, dbsenha);
fpesqarray[i].btnconfirmar.visible:= true;
if fpesqarray[i].showmodal = mrok then
result:= fpesqarray[i].cdsprincipal.fieldbyname(fpesqarray[i].campoprincipal).asvariant
else
result:= -1;
finally
freeandnil(fpesqarray[i]);
end;
end;

procedure pesqshow_menu(iduser: extended; dbbancodados, dbusuario, dbsenha: string;menu,i: integer);
begin
case menu of
-001: fpesqarray[i]:= tfvw_perfil_niveis.create(application);
001: fpesqarray[i]:= tfvw_entidade.create(application);
002: fpesqarray[i]:= tfvw_classificacao.create(application);
003: fpesqarray[i]:= tfvw_areavenda.create(application);
004: fpesqarray[i]:= tfvw_ramoatividade.create(application);
008: fpesqarray[i]:= tfvw_centrocusto.create(application);
009: fpesqarray[i]:= tfvw_depto.create(application);
029: fpesqarray[i]:= tfvw_usuarios.create(application);
030: fpesqarray[i]:= tfvw_perfil.create(application);
037: fpesqarray[i]:= tfvw_prod_classificacao.create(application);
038: fpesqarray[i]:= tfvw_prod.create(application);
039: fpesqarray[i]:= tfvw_prod_subgrupo.create(application);
040: fpesqarray[i]:= tfvw_prod_grupo.create(application);
042: fpesqarray[i]:= tfvw_prod_cor.create(application);
043: fpesqarray[i]:= tfvw_prod_tamanho.create(application);
044: fpesqarray[i]:= tfvw_prod_marca.create(application);
145: fpesqarray[i]:= tfvw_empresa.create(application);
end;

fpesqarray[i].idform:= i;
fpesqarray[i].idmenu:= menu;
fpesqarray[i].sessao.cod_usuario:= iduser;
fpesqarray[i].name:= fpesq_+inttostr(abs(i));
fpesqarray[i].config_conexao(dbbancodados, dbusuario, dbsenha);
fpesqarray[i].show;
end;

end.

abaixo o outro codigo usando nas chamadas de cadastro

unit ucadastro;

interface

procedure cadshow_menu(iduser: extended;dbbancodados, dbusuario,
dbsenha: string;menu,i, acao: integer; registro: extended);


implementation

uses
ucad_usuario, vcl.forms, ucadglobal, system.sysutils, vcl.dialogs,
ucad_perfil, ucad_centrocusto, ucad_depto, ucad_entidade, ucad_areavenda,
ucad_classificacao, ucad_ramoatividade, ucad_prod, ucad_prod_classificacao,
ucad_prod_cor, ucad_prod_grupo, ucad_prod_marca, ucad_prod_subgrupo,
ucad_prod_tamanho;

procedure cadshow_menu(iduser: extended;dbbancodados, dbusuario,
dbsenha: string;menu,i, acao: integer; registro: extended);
begin
case menu of
001: fcadarray[i]:= tfcad_entidade.create(application);
002: fcadarray[i]:= tfcad_classificacao.create(application);
003: fcadarray[i]:= tfcad_areavenda.create(application);
004: fcadarray[i]:= tfcad_ramoatividade.create(application);
008: fcadarray[i]:= tfcad_centrocusto.create(application);
009: fcadarray[i]:= tfcad_depto.create(application);
029: fcadarray[i]:= tfcad_usuario.create(application);
030: fcadarray[i]:= tfcad_perfil.create(application);
037: fcadarray[i]:= tfcad_prod_classificacao.create(application);
038: fcadarray[i]:= tfcad_prod.create(application);
039: fcadarray[i]:= tfcad_prod_subgrupo.create(application);
040: fcadarray[i]:= tfcad_prod_grupo.create(application);
042: fcadarray[i]:= tfcad_prod_cor.create(application);
043: fcadarray[i]:= tfcad_prod_tamanho.create(application);
044: fcadarray[i]:= tfcad_prod_marca.create(application);
//145: pesqmodal_empresa(dbbancodados, dbusuario, dbsenha, i,menu);
else
begin
messagedlg(modulo não liberado, provavelmente esta em produção, mtinformation, [mbok],0);
abort;
end;
end;

fcadarray[i].idmenu:= menu;
fcadarray[i].idform:= i;
fcadarray[i].sessao.cod_usuario:= iduser;
fcadarray[i].acao:= acao;
fcadarray[i].name:= fcad_+inttostr(i);
fcadarray[i].config_conexao(dbbancodados, dbusuario, dbsenha);
fcadarray[i].registro:= registro;
fcadarray[i].procurar;
fcadarray[i].show;

end;

end.
Responder

Gostei + 0

Utilizamos cookies para fornecer uma melhor experiência para nossos usuários, consulte nossa política de privacidade.

Aceitar