[erro] Out of memory

[Jaqueline Fernandes]

Olá Pessoal!

 

 já acompanho o grupo a um tempo, no entanto este é meu primeiro post.

 Fiz uma aplicação que captura os dados de uma página web... e salva num banco MYSQL

 Os erros são esses que estão nas imagens. Os erros ocorrem depois de umas 250 inserções no banco...

 e tenho que reinicar a maquina para que funcione normalmente, pois quando ocorre o erro não tenho como executar nenhuma outra aplicação ...

 

 Utilizo:

 Windows XP SP3

 Core 2 Duo T5800, 3G de Ram e mais de 300 G de Espaço livre no hd..

 

 Delphi 07, Mysql 5

 Componentes ADO

 O executável tem 1.6M

 São criados apenas 2 formulários

 

Acompanhei a aplicação num dos computadores, utilizando o Gerenciador de Tarefas do windows, ela consome em media de 40M ~ 55M.

 

 

 Pesquisei no google e encontrei relatos sobre a troca de uma dll, Link32.dll. Substitui pela versão do delphi 2010.

 Excluir o executável, e todos os arquivos ~.

 Recompilei e fiz o teste em duas máquinas.. todas apresentaram o mesmo erro de novo...

 

 Peço desculpa de antemão, por não saber relatar com mais detalhe pois sou iniciante em delphi e

aprendo muito lendo as discursões do grupo.

 

obrigada

 

--
Jaqueline Fernandes
----------------------------------------
"E assim, esperando com paciência, alcançou a promessa "
Hebreus 6:15

[Maurício Lauxen]

Possívelmente você está criando algum objeto em tempo de execução e não está liberando o mesmo da memória.

Pode enviar o fonte para tentarmos ajudar?

--
Você recebeu esta mensagem porque está inscrito no "DUG-RS -
Delphi Users Group Rio Grande do Sul" em Grupos do Google.
Acesse o nosso BLOG em http://www.dug-rs.org e contribua com a comunidade Delphi do Rio Grande do Sul
Para postar neste grupo, envie um e-mail para dug...@googlegroups.com
Para cancelar a sua inscrição neste grupo, envie um e-mail para
dug-rs-un...@googlegroups.com
Para ver mais opções, visite este grupo em
http://groups.google.com.br/group/dug-rs?hl=pt-BR
Twitter: @dugrs

--
Att,

Maurício Lauxen
lau...@gmail.com

[Marcelo Bortolini]

Jaqueline, como vc está carregando estes inserts ?
Você cria está adicionando em um componente SQL todas as linhas e depois executa ?

Já tive problemas assim com o componente IB_QUERY do IBO, no caso eu estava carregando todas
as linhas de insert no componente para depois executava. Havia problema qndo os registros chegavam em ~2.500 pois este era o limite de linhas do componente. Resolvi usando o componete IB_SCRIPT que a limitação é muito maior.

Porém como o Maurício postou, com o código fonte é mais fácil de analisar.

t+

Marcelo Bortolini

[Secaio]

Oi Jaqueline, tdo bem???

 

olha, pela imagem do erro que vc enviou eu tb vou arriscar dizer que é a qtde de linhas do componente onde vc está montando o sql....

 

vc diz que o erro acontece após umas 250 inserções no banco certo? então vc já rodou as 250 "primeiras" linhas do teu sql é isso?

 

pergunto, como vc monta o sql?  esses dados que vc pega na pag web, são pegos todos de uma vez? vc monta o sql e manda executar..... ou carrega os dados, executa, carrega mais dados, executa, etc, etc, etc....

 

e apos a execução de um comando sql, vc exclui essa linha de comando ou passa para a proxima apenas?

 

att

--
Secaio

 

2010/11/9 Marcelo Bortolini <mbbor...@gmail.com>

--
Secaio

[Felipe Dal Pizzol]

Buenos dias!

eu na minha modéstia e seguindo a linha do nobre Secaio e outros
que responderam,  sugiro verificar ou até mesmo que nos  informe
como estão sendo  feitas as inserções:

1) É feito um insert pra cada registro, com execsql e já aplicando no banco?
   - isso pode ter limitação de numero de consultas abertas...
     ocorre seguido quando, por exemplo, se executa várias
     consultas (open/close) seguidas em componentes de consulta;

2) É feito via script, com vários inserts, seguindo de um commit
   no banco?
   - limitação de linhas do componente.

3) Apesar de nao ter muita influência, o banco é local ou está
   em um servidor específico?

Buenas... nesse momento me vou....

Espero que resolva isso breve!

Cordialmente,
Felipe D. Dal Pizzol.
[Bons treinos - HAPKI!!!]

Felipe Dornelles Dal'Pizzol

[Jaqueline Fernandes]

Instalei o delphi 2009 e o erro continua. No debug deu a seguinet mensagem: Invalid Address specified to RtlFreeHeap

unit Principal;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, OleCtrls, SHDocVw, ComCtrls, StdCtrls, ToolWin, ImgList,
  Menus,Registry,mshtml, ExtCtrls, ExtDlgs, DB, ADODB, Mask, DBCtrls,
  Buttons, DBTables, AppEvnts, Clipbrd, Grids, DBGrids, Shellapi;

type
  TMainform = class(TForm)
    MainMenu1: TMainMenu;
    Arquivo1: TMenuItem;
    Editar1: TMenuItem;
    MNovaJanela: TMenuItem;
    MAbrir: TMenuItem;
    MSalvar: TMenuItem;
    N1: TMenuItem;
    MImprimir: TMenuItem;
    MVisualizar: TMenuItem;
    MConfigurar: TMenuItem;
    N2: TMenuItem;
    MPropriedades: TMenuItem;
    N3: TMenuItem;
    MSair: TMenuItem;
    MRecortar: TMenuItem;
    MCopiar: TMenuItem;
    MColar: TMenuItem;
    N4: TMenuItem;
    MLocalizar: TMenuItem;
    ImageList1: TImageList;
    CoolBar1: TCoolBar;
    ToolBar1: TToolBar;
    btnVoltar: TToolButton;
    btnAvancar: TToolButton;
    btnParar: TToolButton;
    btnAtualizar: TToolButton;
    ToolButton1: TToolButton;
    StatusBar1: TStatusBar;
    OpenDialog1: TOpenDialog;
    ComboBox1: TComboBox;
    OpenPictureDialog1: TOpenPictureDialog;
    PageControl1: TPageControl;
    TabSheet3: TTabSheet;
    PageControl_Principal: TPageControl;
    Panel1: TPanel;
    WebBrowser1: TWebBrowser;
    Cadastros1: TMenuItem;
    PessoaFsica1: TMenuItem;
    PF: TTabSheet;
    GroupBox1: TGroupBox;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Sexo: TLabel;
    PF_bt_capturar: TButton;
    PF_EditNome: TDBEdit;
    PF_EditCPF: TDBEdit;
    PF_EditEleitor: TDBEdit;
    PF_EditMae: TDBEdit;
    PF_EditUnidAdm: TDBEdit;
    PF_EditNasc: TDBEdit;
    PF_EditSituacao: TDBEdit;
    PF_EditSexo: TDBEdit;
    PF_EditObito: TDBEdit;
    PF_EditEndereco: TDBMemo;
    PF_bt_salvar: TBitBtn;
    PF_bt_cancelar: TBitBtn;
    GroupBox2: TGroupBox;
    PF_bt_novo_voltar: TButton;
    PF_bt_novo: TButton;
    Timer1: TTimer;
    ProgressBar1: TProgressBar;
    Label32: TLabel;
    Label66: TLabel;
    tsDados: TTabSheet;
    GroupBox7: TGroupBox;
    Panel2: TPanel;
    Label28: TLabel;
    rb_type: TRadioButton;
    Panel3: TPanel;
    Label29: TLabel;
    rbCPF: TRadioButton;
    rbNome: TRadioButton;
    rbNomeMae: TRadioButton;
    rbTitulo: TRadioButton;
    rbDataNascimento: TRadioButton;
    rbObito: TRadioButton;
    GroupBox8: TGroupBox;
    btnConsultarBase: TButton;
    BitBtn1: TBitBtn;
    Memo1: TMemo;
    Edit1: TEdit;
    Label30: TLabel;
    Label12: TLabel;
    edtContador: TEdit;
    Bevel1: TBevel;
    Button1: TButton;
    procedure btnVoltarClick(Sender: TObject);
    procedure btnAvancarClick(Sender: TObject);
    procedure btnPararClick(Sender: TObject);
    procedure btnAtualizarClick(Sender: TObject);
    procedure btnHomeClick(Sender: TObject);
    procedure btnPesquisaClick(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure WebBrowser1CommandStateChange(Sender: TObject;
      Command: Integer; Enable: WordBool);
    procedure WebBrowser1BeforeNavigate2(Sender: TObject;
      const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
      Headers: OleVariant; var Cancel: WordBool);
    procedure ComboBox1KeyPress(Sender: TObject; var Key: Char);
    procedure WebBrowser1StatusTextChange(Sender: TObject;
      const Text: WideString);
    procedure MNovaJanelaClick(Sender: TObject);
    procedure MAbrirClick(Sender: TObject);
    procedure MSairClick(Sender: TObject);
    procedure PF_bt_capturarClick(Sender: TObject);
    procedure PF_bt_salvarClick(Sender: TObject);
    procedure PF_bt_cancelarClick(Sender: TObject);
    procedure ApplicationEvents1Exception(Sender: TObject; E: Exception);
    procedure PF_bt_novoClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure PF_bt_novo_voltarClick(Sender: TObject);
    procedure WebBrowser1TitleChange(Sender: TObject;
      const Text: WideString);
    procedure Timer1Timer(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure WebBrowser1ProgressChange(Sender: TObject; Progress,
      ProgressMax: Integer);
    procedure BitBtn1Click(Sender: TObject);
    procedure btnConsultarBaseClick(Sender: TObject);
    procedure Button1Click(Sender: TObject);

  private

    { Private declarations }
  public
    { Public declarations }

    Procedure ExibirURLsVisitadas(Urls: TStrings);
    function ParteTexto(Frase: string; Parte: string): string;
    function SelecaoTexto(RefInicial, RefFinal:string;NumCaracter:integer;WB: TWebBrowser): string;
    function TextoExato(Texto, RefIni: string; salto,NumCaract:integer): string;
    procedure Delay(MSec: Cardinal);
    procedure imgSalvaImagem(sArq: String);
    procedure FillInGMXForms(WB: ShDocVW.IWebbrowser2; IDoc1: IHTMLDocument2;Document: Variant; P_CNPJ : string);

 

  end;

var
  Mainform: TMainform;
  AndrewLinoDispach:TWEBBROWSER;
  ppDisp:IDispatch;
  sql_dados : string;

 

implementation

uses DateUtils, DM,  ActiveX, jpeg;

{$R *.dfm}

procedure TMainform.btnVoltarClick(Sender: TObject);
begin
  webbrowser1.GoBack;
end;

procedure TMainform.btnAvancarClick(Sender: TObject);
begin
  WebBrowser1.GoForward;
end;

procedure TMainform.btnPararClick(Sender: TObject);
begin
  WebBrowser1.Stop;
end;

procedure TMainform.btnAtualizarClick(Sender: TObject);
begin
  WebBrowser1.Refresh;
end;

procedure TMainform.btnHomeClick(Sender: TObject);
begin
  WebBrowser1.GoHome;
end;

procedure TMainform.btnPesquisaClick(Sender: TObject);
begin
  WebBrowser1.GoSearch;
end;

procedure TMainform.ExibirURLsVisitadas(Urls: TStrings);
{
Exibe as urls vistadas no combobox de endereço
}
var
  Reg: TRegistry;
  S: TStringList;
  i: Integer;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_CURRENT_USER;
    if Reg.OpenKey('Software\Microsoft\Internet '+
        'Explorer\TypedURLs', False) then
    begin
      S := TStringList.Create;
      try
        reg.GetValueNames(S);
        for i := 0 to S.Count - 1 do
        begin
          Urls.Add(reg.ReadString(S.Strings[i]));
        end;
      finally
        S.Free;
      end;
      Reg.CloseKey;
    end;
    finally
      Reg.Free;
    end;
end;

procedure TMainform.FormCreate(Sender: TObject);
begin
// Abrir no webbrowser a página do infoseg
  webbrowser1.Navigate('www.mp.pb.gov.br');

end;

procedure TMainform.WebBrowser1CommandStateChange(Sender: TObject;
  Command: Integer; Enable: WordBool);
begin
case Command of
CSC_NAVIGATEBACK: begin
//Ativa e Desativa Automaticamente o Botão Voltar,
//Caso tenha alguma página para voltar
  BtnVoltar.Enabled := Enable;
end;
CSC_NAVIGATEFORWARD: begin

//Ativa e Desativa Automaticamente o Botão Avançar,
//Caso tenha alguma página para avançar
BtnAvancar.Enabled := Enable;
end;
end;
end;

procedure TMainform.WebBrowser1BeforeNavigate2(Sender: TObject;
  const pDisp: IDispatch; var URL, Flags, TargetFrameName, PostData,
  Headers: OleVariant; var Cancel: WordBool);
begin
{Ao Nevagar uma página, ele coloca automaticamente
o endereço dela no combobox, para sabermos que página
estamos entrando, o endereço da mesma}
combobox1.Text:=url;
end;

procedure TMainform.ComboBox1KeyPress(Sender: TObject; var Key: Char);
begin
//Se a tecla pressionada for Enter, então navegue até a página tal.
    if (key=#13) then
      begin
        webbrowser1.Navigate(combobox1.Text);
    end;
end;

procedure TMainform.WebBrowser1StatusTextChange(Sender: TObject;
  const Text: WideString);
begin
  StatusBar1.Panels[0].Text:=text;
end;

procedure TMainform.MNovaJanelaClick(Sender: TObject);
begin
//  WinExec(pchar(application.exename),SW_MAXIMIZE);
end;

procedure TMainform.MAbrirClick(Sender: TObject);
begin
if OpenDialog1.Execute then
  webbrowser1.Navigate(OpenDialog1.FileName)
else
  exit;
end;

procedure TMainform.MSairClick(Sender: TObject);
begin
  application.Terminate;
end;

function TMainform.SelecaoTexto(RefInicial, RefFinal:string;NumCaracter:integer;WB: TWebBrowser): string;
{
 RefInicial: texto inicial do refinamento
 RefFinal: texto final do refinamento
 NumCaracter: quantidade aproximada de caracter que contem a refinicial e reffinal
 wb: webbrower que será copiada as informações(strings)
}

var
  iall : IHTMLElement;
  texto,selecao: String;
  ColonPosIni,ColonPosFinal:integer;

begin
if Assigned(WB.Document) then
   begin
     iall := (WB.Document AS IHTMLDocument2).body;

     while iall.parentElement <> nil do
     begin
       iall := iall.parentElement;
     end;
     texto:=iall.outerHTML;

     ColonPosIni := Pos(RefInicial,texto);
     Selecao := Copy(texto,ColonPosIni,NumCaracter);
     Result:= ParteTexto(Copy(texto,ColonPosIni,NumCaracter),RefFinal);

   end;
end;

function TMainform.ParteTexto(Frase, Parte: string): string;
//
// Retorna uma parte de um texto antes de um caractere especificado
//
var
i,max: integer;
buff: string;
begin
i := 1;
buff := '';
max := length(parte);
while (i <= length(Frase)) and (buff <> parte) do
       begin
       buff := buff + Frase[i];
       if length(buff) > max then
          begin
          buff := copy(buff,2,max);
          end;
       inc(i);
       end;
if buff = Parte then
   begin
   Result := copy(Frase,1,i - max -1);
   Frase := copy(Frase,i,length(Frase)+1 -i);
   end
else
   begin
   Result := Frase;
   Frase := '';
   end;
end;

function TMainform.TextoExato(Texto, RefIni: string; salto,NumCaract:integer): string;
{
Recebe o texto com a parte inicial definida e remete o texto do inicio até o caracter '<'
Texto: é o texto que será localizado a string
Refini: é minha referencia inicial
salto: é o numero de caracteres que deve saltar para chegar o inicio do texto desejado
numcaract: é a quantidade maxima de caracter que desejamos que seja copiado
}
var
 PosicaoInicial : integer;
 comando,ComandoPos:string;

begin
    PosicaoInicial := Pos(RefIni,texto);
    Comando := Copy(texto,PosicaoInicial+salto,NumCaract);
    Result := ParteTexto(Comando,'<');
end;
procedure TMainform.PF_bt_capturarClick(Sender: TObject);
var
 cpf,nome,referencia, ver_pag: string;
 num: integer;

begin

 ver_pag := SelecaoTexto('Pesquisa Pessoa Fisica - Detalhes','<',100,WebBrowser1); //verifica se se está no form pessoa fisica

if ver_pag = 'Pesquisa Pessoa Fisica - Detalhes' then
 begin
   referencia:= SelecaoTexto('Nome','Pesquisar Relacionamentos',2000,WebBrowser1);

// tratamento do campo cpf

   cpf := TextoExato(referencia,'CPF',49,12);
   num:= length(cpf);

   if num < 11 then
      begin
         case num of
            10: cpf := '0' + cpf;
             9: cpf := '00' + cpf;
             8: cpf := '000' + cpf;
             7: cpf := '0000' + cpf;
             6: cpf := '00000' + cpf;
         end;
      end;

   nome := TextoExato(referencia,'Nome',63,200);

   PF_EditCPF.Text:= cpf;
   PF_EditNome.Text:= nome;
   PF_EditNasc.Text:= TextoExato(referencia,'Data Nasc',65,10);
   PF_EditMae.Text:= TextoExato(referencia,'Mãe',42,200);
   PF_EditEleitor.Text:= TextoExato(referencia,'Eleitor:',43,20);
   PF_EditSexo.Text:= TextoExato(referencia,'Sexo',40,12);
   PF_EditUnidAdm.Text:= TextoExato(referencia,'Administrativa:',50,100);
   PF_EditSituacao.Text:= TextoExato(referencia,'Cadastral:',55,30);
   PF_EditObito.Text:= TextoExato(referencia,'Obito',51,10);
   PF_EditEndereco.Text:= TextoExato(referencia,'Endere',54,300);
 end
 else
 begin
   ShowMessage('Selecione a Página de dados de Pessoa Física');
   exit;
 end;

end;

procedure TMainform.PF_bt_salvarClick(Sender: TObject);
begin

if DataModule1.Tb_PessoaFisica.State in [dsinsert, dsedit] then
   begin
    DataModule1.Tb_PessoaFisica.Post;
//    ShowMessage('Cadastro Efetuado com sucesso');

   end
else
  ShowMessage('A tabela não está em modo de Inserção de dados');
end;

procedure TMainform.PF_bt_cancelarClick(Sender: TObject);
begin
DataModule1.Tb_PessoaFisica.Cancel;

end;

procedure TMainform.ApplicationEvents1Exception(Sender: TObject;
  E: Exception);
var mensagem: string;

    Pos1, Pos2: integer;

begin

   If Pos(UpperCase('is not a valid date'), UpperCase(E.Message)) <> 0 then
           showmessage('Data inválida, proceda a correção.')
   else
      if Pos(UpperCase('must have a value'), UpperCase(E.Message)) <> 0 then
           begin
              Pos1:=Pos('''', E.Message);
              mensagem:=E.Message;
              Delete(mensagem, Pos1, 1);
              Pos2:=Pos('''', mensagem);
              mensagem:=copy(E.Message, Pos1 + 1, Pos2 - Pos1);
              showmessage('É obrigatório o preenchimento do campo '+ mensagem + '.');
           end
   else
      If Pos(UpperCase('key violation'), UpperCase(E.Message)) <> 0 then
           showmessage('Houve violação de Chave.  Registro já incluido.')
   else
      If Pos(UpperCase('Input value'), UpperCase(E.Message)) <> 0 then
           showmessage('Campo preenchido com valor não válido. Proceda correção.')
   else
      If Pos(UpperCase('is not a valid time'), UpperCase(E.Message)) <> 0 then
           showmessage('Hora inválida, proceda a correção.')
   else
      showmessage('Ocorreu o seguinte erro: '+UpperCase(E.Message));
end;

 

procedure TMainform.PF_bt_novoClick(Sender: TObject);
var
 ver_pag: string;
begin

  ver_pag := SelecaoTexto('Pesquisa Pessoa Fisica - Detalhes','<',100,WebBrowser1); //verifica se se está no form pessoa fisica
  if ver_pag = 'Pesquisa Pessoa Fisica - Detalhes' then
  begin
    DataModule1.Tb_PessoaFisica.close;
    DataModule1.Tb_PessoaFisica.Open;
    DataModule1.Tb_PessoaFisica.Append;
  end
  else
   ShowMessage('Selecione a aba Pessoa Física');
end;

procedure TMainform.FormClose(Sender: TObject; var Action: TCloseAction);
begin

if DataModule1.Tb_PessoaFisica.State in [dsinsert, dsedit] then
   begin
    ShowMessage('Cancele ou Salve o Cadastro de Pessoa Física');
    Action:= caNone;
    exit;
   end;

end;

procedure TMainform.PF_bt_novo_voltarClick(Sender: TObject);
var
  ver_pag: string;
begin

ver_pag := SelecaoTexto('Pesquisa Pessoa Fisica - Detalhes','<',100,WebBrowser1); //verifica se se está no form pessoa fisica
  if ver_pag = 'Pesquisa Pessoa Fisica - Detalhes' then
  WebBrowser1.GoBack
  else
  begin
     ShowMessage('Selecione a aba Pessoa Física');
     exit;
  end;

  DataModule1.Tb_PessoaFisica.close;
  DataModule1.Tb_PessoaFisica.Open;
  DataModule1.Tb_PessoaFisica.Append;

end;

procedure TMainform.WebBrowser1TitleChange(Sender: TObject;
  const Text: WideString);
begin
{Colocar o nome da página + ' dados que te interessar}

MainForm.Caption:=text + ' - CAPTURA DE DADOS PESSOA FISICA';

end;

procedure TMainform.Timer1Timer(Sender: TObject);
var
DateTime : TDateTime;
str : string;
begin
DateTime := Time;
str := TimeToStr(DateTime);
StatusBar1.Panels[2].Text := str;
end;

procedure TMainform.Delay(MSec: Cardinal);
var
  Start: Cardinal;
begin
  Start := GetTickCount;
  repeat
    Application.ProcessMessages;
  until (GetTickCount - Start) >= MSec;
end;

procedure TMainform.FormResize(Sender: TObject);
var
  r: TRect;
const
  SB_GETRECT = WM_USER + 10;
begin
// Definindo onde ficará a progressbar, neste caso será
//Na barra de Status, no painel 1
  Statusbar1.Perform(SB_GETRECT, 1, Integer(@R));
  ProgressBar1.Parent := Statusbar1;
  ProgressBar1.SetBounds(r.Left, r.Top,
  r.Right - r.Left - 5, r.Bottom - r.Top);
end;

procedure TMainform.WebBrowser1ProgressChange(Sender: TObject; Progress,
  ProgressMax: Integer);
begin
{Ele faz um rotina para saber se o valor Maximo do
Progressbar é maior que 1 e o valor minimo tambem
se for, então ele faz a rotina}
If (Progress>=1) and (ProgressMax>1)
then
 begin
//Ele tira uma valor percentual para colocar
//no Progressbar
  ProgressBar1.Position := Round((Progress * 100)
Div ProgressMax);
 ProgressBar1.Visible := True;
end
else
begin
  ProgressBar1.Position := 1;
  ProgressBar1.Visible := False;
end;
end;

procedure TMainform.imgSalvaImagem(sArq: String);
var
    ViewObject: IViewObject;
    sourceDrawRect: TRect;
    imgImagem: TImage;

{ chamar a função
imgSalvaImagem(´C:\teste.bmp´);
}
begin
    if webBrowser1.Document <> nil then
    try
      imgImagem := TImage.Create(Self);
      imgImagem.Width := WebBrowser1.Width;
      imgImagem.Height := WebBrowser1.Height;

      webBrowser1.Document.QueryInterface(IViewObject, ViewObject);
      if ViewObject <> nil then
      try
        sourceDrawRect := Rect(0, 0, imgImagem.Width, imgImagem.Height);
        ViewObject.Draw(DVASPECT_CONTENT, 1, nil, nil, Self.Handle,
        imgImagem.Canvas.Handle, @sourceDrawRect, nil, nil, 0);
      finally
        ViewObject._Release;
      end;
      imgImagem.Picture.Bitmap.SaveToFile(sArq);
    except
    end;
  end;

procedure TMainform.BitBtn1Click(Sender: TObject);
var
IDoc1: IHTMLDocument2;
Web: ShDocVW.IWebBrowser2;
i : integer;
ver_pag : string;
document: IHTMLDocument2;
tempo,contador: integer;

begin
contador := 0;

for i:=0 TO Memo1.Lines.Count -1 do
begin
    Edit1.Text := Memo1.Lines.Strings[i];

 

   Webbrowser1.Navigate('http:\\10.128.0.29\dados.htm');

 // aguarda até a página ser carregada
    while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;

 

    Webbrowser1.Document.QueryInterface(IHTMLDocument2, iDoc1);
    Web := WebBrowser1.ControlInterface;
    FillInGMXForms(Web, iDoc1, Webbrowser1.Document, Edit1.Text);
    delay(2000);
    while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;

 

//botão de pesquisa

    WebBrowser1.Navigate('javascript:enviarForm()');
//    WebBrowser1.Navigate('http:\\10.128.0.29\resultado.htm');

    while Webbrowser1.ReadyState <> READYSTATE_COMPLETE do Application.ProcessMessages;

 

    ver_pag := SelecaoTexto('Error','<',100,WebBrowser1); //verifica se esta na pagina de erro

    if ver_pag <> 'Error' then
    begin
      delay(3000);
      PF_bt_novo.Click;
      PF_bt_capturar.Click;
      delay(1000);
      PF_bt_salvar.Click;
      delay(3000);
      inc(contador);
      edtContador.Text := inttostr(contador);
    end;
   end;

for i:= 1 to 10 do
begin
Beep;
Delay(9000);
end;
end;

function ExecuteScript(doc: IHTMLDocument2; script: string; language: string): Boolean;
var
  win: IHTMLWindow2;
  Olelanguage: Olevariant;
begin
  if doc <> nil then
  begin
    try
      win := doc.parentWindow;
      if win <> nil then
      begin
        try
          Olelanguage := language;
          win.ExecScript(script, Olelanguage);
        finally
          win := nil;
      end;
  end;
  finally
    doc := nil;
  end;
end;
end;

procedure TMainform.FillInGMXForms(WB: ShDocVW.IWebbrowser2; IDoc1: IHTMLDocument2;Document: Variant; P_CNPJ : string);
const
  IEFields: array[1..2] of string = ('INPUT', 'text');

var
  IEFieldsCounter: Integer;
  m: Integer;
  ovElements: OleVariant;
  elemento: integer;

begin
  if Pos('Pessoa Fisica', Document.Title) <> 0 then
  while WB.ReadyState <> READYSTATE_COMPLETE do
    Application.ProcessMessages;

  if rbCPF.Checked then elemento := 0
  else
    if rbTitulo.Checked then elemento := 1
    else
      if rbNome.Checked then elemento := 3;

  // contar os elementos e interagir por suas formas
  IEFieldsCounter := 0;
  for m := 0 to Document.forms.Length - 1 do
  begin
    ovElements := Document.forms.Item(m).elements;

  // interagir por elemento
  try
  // preencher os campos
    if (ovElements.item(elemento).tagName = IEFields[1]) and (ovElements.item(elemento).type = IEFields[2]) then
    begin
      ovElements.item(elemento).Value := P_CNPJ;
      Inc(IEFieldsCounter);
    end;
  except
  // falha...
   end;
  end;

// se o campo estiver preenchido.
 if IEFieldsCounter = 3 then ExecuteScript(iDoc1,'','JavaScript');
end;

procedure TMainform.btnConsultarBaseClick(Sender: TObject);
begin
  Memo1.PasteFromClipboard;
end;

procedure TMainform.Button1Click(Sender: TObject);
begin
Memo1.Clear;
edtContador.Clear;
Edit1.Clear;
end;

end.

 

 

________

unit DM;

interface

uses
  SysUtils, Classes, DB, ADODB, DBTables;

type
  TDataModule1 = class(TDataModule)
    ADOConnection1: TADOConnection;
    Tb_PessoaFisica: TADOTable;
    DS_Pessoa_Fisica: TDataSource;
    Tb_PessoaFisicapf_id: TAutoIncField;
    Tb_PessoaFisicacpf: TStringField;
    Tb_PessoaFisicanome_pf: TStringField;
    Tb_PessoaFisicadata_nasc: TStringField;
    Tb_PessoaFisicanome_mae: TStringField;
    Tb_PessoaFisicatitulo_eleitor: TStringField;
    Tb_PessoaFisicasexo: TStringField;
    Tb_PessoaFisicaano_obito: TStringField;
    Tb_PessoaFisicaunid_admin: TStringField;
    Tb_PessoaFisicasituacao: TStringField;
    Tb_PessoaFisicaend_pf: TStringField;
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  DataModule1: TDataModule1;

implementation

{$R *.dfm}

end.

[Secaio]

oi Jaqueline,

 

em qual a linha o erro acontece???

 

o procedimento é a TMainform.BitBtn1Click(Sender: TObject)  que dispara ele certo?

 

qdo acontece o erro, em qual linha o compilador pára? 

 

outra coisa, tu tentou usar o Build (Shift + F9) e rodar a aplicação do exe, para ver se ocorre o mesmo erro???

 

 

2010/11/10 Jaqueline Fernandes <dhe...@gmail.com>

--
Secaio´s Corporation

[Jaqueline Fernandes]

sim..procedure TMainform.BitBtn1Click é ela que dispara...
o problema é que o compilador não dá erro....
Simples... depois de algum tempo rodando... o programa perde os botões e nda mais funciona...
tenho que religar a máquina.


obrigada

[Secaio]

mas vc tentou deixar a aplicação rodando com o F9 pelo Delphi???  até acontecer o erro?

 

outra coisa, acontece em todas as maquinas isso? ou vc testou em uma só ??

2010/11/10 Jaqueline Fernandes <dhe...@gmail.com>

--
Secaio´s Corporation

[Felipe Dal Pizzol]

close
open
append

essa sequencia, se executada muitas vezes, pode realmente dar o problema.

Para teste inclua um botao só pra close/open, sendo que os dados atualizam
algum grid... isso deve gerar erro...

fora tambem que tu estás usando TADOTable... esse cara tem um limite de
tabelas abertas e tabelas que podem ser abertas, mesmo dando-se um close
nelas.

Nao lembro agora exatamente como fazer... mas nao gosto de componentes
*Table... me permitem algumas coisas, mas tem muitas outras por tras, que
podem causar problemas.....

Assim que lembrar, ou conseguir falar com o Diego Rosa, te passo...

[Wecsley Fey]

Jaqueline,

Analisei um pouco por cima teu código e ele realmente está pesado, muito pesado.

Tente manerar com ProcessMessages. Você realmente necessita atualizar a aplicação enquanto o browser trabalha ? Crie classes, trabalhe com procedimentos encapsulados em objetos. Em vários pontos você repete invocação de procedimentos encapsulados em botões com o próprio método Click, dentre outras coisas. Isto torna o processamento complexo e pesado. Seja boazinha com a memória !

Existem outros meios de se trabalhar com formulários web com Delphi através do MSHTML, tanto para extração quanto para envio de dados aos formulários.

Leia este artigo, pode lhe ajudar com a melhoria de performance ao se trabalhar com o WebBrowser: http://www.cryer.co.uk/brian/delphi/twebbrowser/twebbrowser_oleobject.htm

Abraço !

Em 10 de novembro de 2010 17:01, Jaqueline Fernandes <dhe...@gmail.com> escreveu:

--
Wecsley Fey
Analista de Sistemas
Aquasoft Tecnologia da Informação
http://www.aquasoft.com.br

http://www.wecsleyfey.com

http://twitter.com/wecsleyfey

(51) 3022.3188 - Porto Alegre/RS - Brasil
Parceira Embarcadero no RS

Coordenador do DUG-RS - Grupo de Usuários Delphi do Rio Grande do Sul

http://www.dug-rs.org

[Diego Campos Rosa]

Jaqueline, 

Sou o Diego Rosa que o Dalpizzol citou.

Primeiro, gostaria de saber porque vc repete varias vezes o comando 

DataModule1.Tb_PessoaFisica.close;
DataModule1.Tb_PessoaFisica.Open;

Segundo, Você esta usando qual banco de dados?

Como o Dalpizzol citou já passei por um problema parecido. Quando executava um certo numero de OPEN em varias tabelas ou na mesma ocorria esse mesmo erro. cheguei a seguinte solução. Criei um TADOConnection para minhas clases herdadas do TADOTable e outro TADOConnection para meus objetos TADOTable. Como o TADOConnection das classes carrega muitas tabelas em memória, quando terminava de usar as classes faço TADOConnection.Connected := False e so ativo novamente quando vou usar as classes novamente. Isso acabou resolvendo o meu problema.

Meu ambiente é ADO + Access.

Minha sugestão para você é executar apenas um Open na Criação do Form e um Close ao  destruir o Form.

at+

Atenciosamente,

Diego Campos Rosa
Analista de Sistemas
Aquasoft / parceira Embarcadero no Rio Grande do Sul
www.aquasoft.com.br 

My profiles:

Signature powered by WiseStamp 

[Jaqueline Fernandes]

Entendi... a visão de vocês...
 Os erros que cometi, foram erros de iniciante... vou refazer meu código... e deixar o mais limpo possível....

vou seguir as dicas que postaram, as que entendi, é claro.. e vou estudar mais.... para melhorar o código.

o que eu tiver dúvida falo com vc?

Ps: Eu uso o MySql, ele fica num servidor dedicado. Estou usando Windows Server 2008, mas vms migrar para o Linux na proxima semana.

obrigada pessoal

[Felipe Dal Pizzol]

Se pudermos ajudar, ajudamos... senao, bebemos! :D

Boa sorte e bom trabalho Jaqueline!

Nas dúvidas sempre podemos nos ajudar!

[Jaqueline Fernandes]

blz....
minha primeira dúvida sobre :

•   DataModule1.Tb_PessoaFisica.close;
•   DataModule1.Tb_PessoaFisica.Open;

eu achava que tinha que abri e fechar a tabela para atualiza os dados.

xau

[Secaio]

DataModule1.Tb_PessoaFisica.refresh      deve surtir o mesmo efeito... mas vou te dar um conselho:

 

pq vc não substitui esses componentes???  componentes Table costumam dar dor de cabeça, eu até usava os da aba BDE, esses funcionavam bem... mas fora esses tivo problemas com todos q usei!

 

hoje em dia uso Query pra tudo, insert, update, delete.... faço tudo via SQL com uma query, nunca mais tive problemas.... nem de chave primaria, onde varios usuarios usam o mesmo cadastro ao mesmo tempo, caso típico para se incomodar com table...

 

te passo um exemplo se precisar....

 

 

 

2010/11/10 Jaqueline Fernandes <dhe...@gmail.com>

--
Secaio´s Corporation

[Diego Campos Rosa]

Segue um exemplo para estudo : http://www.marcocantu.com/code/md5/ADOEMPL.htm

[Diego Campos Rosa]

Segue mais material para estudo:

 

Minha indicação:

http://www.dicasdelphi.com.br/dica-turbo-delphi-e-dbexpress-com-mysql/

Indicação do Secaio citou.
http://imasters.com.br/artigo/2205/mysql/mysql_x_bde_x_dbexpress/

[Jaqueline Fernandes]

Vlw mesmo pelas dicas...
 A opção da ADOTable foi simplismente praticidade, por não ter muita prática, fiz a escolha elementar rsss...
 Esse é o meu primeiro programa com uma finalidade definida, e por isso tem um carater didático. Realmente estou aprendendo muito.

obrigada

[Wecsley Fey]

Jaqueline,

Para um primeiro programa, estás indo muito bem ! ;) Avalie e adote todas as boas práticas possíveis, com certeza terás muito sucesso.

Abraço !

Wecsley Fey
Analista de Sistemas
Aquasoft Tecnologia da Informação
http://www.aquasoft.com.br

http://www.wecsleyfey.com

http://twitter.com/wecsleyfey

(51) 3022.3188 - Porto Alegre/RS - Brasil
Parceira Embarcadero no RS

Coordenador do DUG-RS - Grupo de Usuários Delphi do Rio Grande do Sul

http://www.dug-rs.org

[Jaqueline Fernandes]

Fiz algumas alterações, ouve uma diminuição do consumo da memoria. No entanto, o erro persiste. Se eu entendi bem, as colocações de vocês, devo subistituir o componente TTable que uso, por um componente TQuery?

obrigada

[Secaio]

Oi jaqueline, boa noite!

 

Assim, existem inumeras formas de se fazer isso... table, stored procedures, client dataset, query, etc... etc...

na minha opinião, componentes Ttable são os q mais tendem a te dar dor de cabeça.

Eu fiz um teste com uma Query looong time ago, justamente num dia em q uma table estava me tirando prá loco... e o negocio funcionou legal, ficou melhor doke o esperado, pois eu tinha tb um problema de chave primaria de um cadastro, onde 3 usuarios o utilizavam "simultaneamente" em rede para resolver. resolvi as duas coisas ao mesmo tempo!

Já utilizei tb storedProcedure, mas nunca gostei mto delas por causa da manutenção, q nesses casos tinha que ser feita no servidor e na aplicação...

Com a query seguro essa parte da manutenção toda na aplicação.

 

ah, o script gerei no firebird, no mysql o integer deve ser int se nao me engano... ageite de acordo com teu SGDB

 

CREATE TABLE TESTE (
    COD      INTEGER NOT NULL,
    DESCR    VARCHAR(50),
    DATA  DATE
);

 

ALTER TABLE TURMA ADD CONSTRAINT PK_TURMA PRIMARY KEY (COD);

no delphi, use um componente Query qualquer, q se conecte ao teu banco de dados (caso precise de ajuda nisso diga, vou te passar aqui os passos de como usar a query somente, ok??? )

 

atribua o sql para uma variavel do tipo String ou monte o sql no componente mesmo....

 

TMP : String;

 

//INSERT

TMP:=

'INSERT INTO TESTE (COD, DESCR, DATA) VALUES ((SELECT coalesce (MAX(COD)+1,1) FROM TESTE), :DESCR, :DATA)'
Query.close;

Query.sql.clear;

Query.sql.add(TMP);

Query.ParamByName('DESCR').Value:= 'TESTE NA TABELA TESTE';
Query.ParamByName('DATA').Value:= '2010.11.15';
Query.ExecSQL;

//UPDATE

TMP:= 'update teste t   set t.cod = :newcod, t.descr = :descr, t.data = :dt  where t.cod = :oldcod'

Query.close;

Query.sql.clear;

Query.sql.add(TMP);

Query.ParamByName('newcod').Value:= AKI VAI O NOVO CODIGO, CASO QUEIRA ALTERAR O CODIGO ATUAL;
Query.ParamByName('DESCR').Value:=   DESCRICAO;
Query.ParamByName('DT').Value:= nova data;
Query.ParamByName('oldcod').Value:=  ESSE É O CODIGO ATUAL DO REGISTRO;

Query.ExecSQL;

 

//DELETE

 

case Application.MessageBox('Excluir?','Atenção',MB_YESNO or MB_APPLMODAL or MB_ICONINFORMATION) of
     mrYes : begin

                 TMP:= 'delete from turma t where t.cod = :cod'

                 Query.close;

                 Query.sql.clear;

                 Query.sql.add(TMP);

                 Query.ParamByName('cod').Value := NUMERO A SER EXCLUÍDO;
                 Query.ExecSQL;

                 end;
 end;

 

olha, eu axo q é mais ou menos por aí...  volto a te dizer que existem mtasss formas de fazer a mesma coisa, logo, existem mtos outros meios de se fazer isso que vc precisa, eu to te passando uma delas, hehehe que uso e aprovo, é meio trabalhoso e tal, mas como sou acostumado com java e php onde tudo eh meio no braço mesmo eu prefiro fazer dessa forma, e te garanto que funciona e que tu provavelmente nao irão te dar dor de cabeça mais tarde...

 

att

 

Romeu.

 

 

 

 

2010/11/15 Jaqueline Fernandes <dhe...@gmail.com>

--
Secaio´s Corporation