Delphi: Listview and Thread

I want to populate a listview with thread.
What is wrong with my thread?

Thread Unit (69~?):

unit unit_download;

interface

uses
  System.Classes, idHttp,Dialogs, StdCtrls, SysUtils, Windows, ComCtrls, MSHTML, Variants, ActiveX;

type
  TDownloadList = class(TThread)
  private
    CHttp : TidHttp;
    CStatus : TStatusBar;
    CListView : TListView;
   procedure Baixar;
  protected
    procedure Execute; override;
  public
   constructor Criar(http : tidhttp; statusbar : tStatusBar; listview: Tlistview);
   end;

implementation


uses
 unit_principal;

{ TDownloadList }

procedure TDownloadList.Baixar;
Var
 Pagina : IHTMLDocument2;
 itens  : IHTMLElement;
 Valores: OleVariant;
 List   : TListItem;
 Buffer : String;
 I, X   : Integer;
 Caption, a, b, c : String;
begin
CoInitialize(nil);
CListview.Clear;
CStatus.Panels[0].Text := 'Updating...';
CHttp.request.useragent := 'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; WOW64; Trident/5.0; MAAU)';
  Try
   Buffer := Chttp.Get(Link_download);
    except
    On E : Exception do
     Begin
       ShowMessage('Error: ' + e.message);
       CStatus.Panels[0].Text := 'Erro:' + e.Message;
       Exit;
     End;
   End;
CStatus.Panels[0].Text := 'Finish.';
Pagina := coHTMLDocument.Create as IHTMLDocument2;
Valores := VarArrayCreate([0,0], VarVariant);
Valores[0] := Buffer;
Pagina.write(PSafeArray(TVarData(Valores).VArray));
Pagina.close;
X := Pagina.all.length;
CStatus.Panels[0].Text := 'Creating list...';
CListView.Items.BeginUpdate;
Try
for I := 0 to X -1 do
 Begin
  itens := Pagina.all.item(I, varEmpty) as IHTMLElement;
  Try
   caption := '';
   a := '';
   b := '';
   c := '';
    if (itens.tagName = 'A') and (Pos('mbi-viewban-', Itens.getAttribute('HREF', VarEmpty)) > 0) and (Itens.title = '') then
     Caption := itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-red') and (itens.title = 'Even Balance Violation')  Then
     a := Itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-green') then
     b := itens.innerText;
    if (itens.tagName = 'A') and (Pos('http://www.pbbans.com/msi-server-', Itens.getAttribute('HREF', VarEmpty)) > 0) Then
     c := Itens.innerText;
    List := CListView.Items.Add;
    List.Caption := Caption;
    List.SubItems.Add(a);
    List.SubItems.Add(b);
    List.SubItems.Add(c);
   Except
    on E: Exception do
     Begin
       ShowMessage('Error: ' + e.message);
     End;
   End;
    End;
except
 On E : Exception do
  Begin
   ShowMessage('Error: ' + e.message);
   Exit;
  End;
End;
CListView.Items.EndUpdate;
CStatus.Panels[0].Text := 'List OK. ' + IntToStr(CListView.Items.Count);
CoUninitialize;
end;

constructor TDownloadList.Criar(http: tidhttp; statusbar : tstatusbar; listview : TListView);
begin
inherited Create(False);
FreeOnTerminate := True;
Chttp := http;
Cstatus := statusbar;
CListview := Listview;
end;

procedure TDownloadList.Execute;
begin
If not (Terminated) Then
 begin
  baixar;
 end;
end;

end.

Open in new window


Form1 I call it:

begin
if IsOnline then
Begin
Download := TDownloadList.Criar(idhttp1, statusbar1, Listview1);
End
Else
StatusBar1.Panels[0].Text := 'Connect first..';
end;

Open in new window


Ty!
JúlioAsked:
Who is Participating?

[Webinar] Streamline your web hosting managementRegister Today

x
 
Geert GruwezConnect With a Mentor Oracle dbaCommented:
the sample with separating thread background loading and visual items:

unit uMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, StdCtrls, ExtCtrls, unit_Download, IdBaseComponent,
  IdComponent, IdTCPConnection, IdTCPClient, IdHTTP, IdCookieManager,
  MSHTML, ActiveX;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    Panel1: TPanel;
    Button1: TButton;
    pbInfo: TProgressBar;
    pnlInfo: TPanel;
    memErrors: TMemo;
    procedure Button1Click(Sender: TObject);
  private
     procedure Finished (Sender: TObject; Url, UrlData: string);
     procedure Progress (Sender: TObject; StatusId: TStatusId; Msg: string = ''; Progress: Integer = 0);
    procedure ProcessUrlData(UrlData: string);
  public
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
begin
  Download('http://www.pbbans.com/mbi-view-latest50-unofficial-bf4-lfb44.html', Finished, Progress);
end;

procedure TForm1.ProcessUrlData(UrlData: string);
var
 Pagina : IHTMLDocument2;
 Valores: OleVariant;
 I, J, ignoreCount: Integer;
 CListView: TListView;
 items  : IHTMLElement;
 children: IHtmlElementCollection;
 cols: array[1..8] of string;
 List   : TListItem;
 colId: Integer;
begin
  Pagina := coHTMLDocument.Create as IHTMLDocument2;
  Valores := VarArrayCreate([0,0], VarVariant);
  Valores[0] := UrlData;
  Pagina.write(PSafeArray(TVarData(Valores).VArray));
  Pagina.close;
  ignoreCount := 0;
  colId := 0;
  CListView := ListView1;
  CListView.Items.BeginUpdate;
  try
    items := Pagina.all.item('pbx-content', varEmpty) as IHTMLElement;
    children := items.all as IHTMLElementCollection;
    for I := 0 to children.length -1 do
    begin
      items := children.item(I, varEmpty) as IHTMLElement;
      try
        if items.parentElement.className = 'pbb-table-gradient' then
        begin
          // ignore first 2 lines
          inc(ignoreCount);
          if ignoreCount > 3 then
          begin
            if items.tagName = 'TD' then
            begin
              Inc(colId);
              if colId > 8 then colId := 1;
              case colId of
                1..7: cols[colId] := items.innerText;
                8: if cols[1] <> '' then
                begin
                  cols[8] := items.innerText;
                  List := CListView.Items.Add;
                  List.Caption := cols[1];
                  for J := 2 to 8 do
                    List.SubItems.Add(cols[J]);
                end;
              end;
            end;
          end;
        end;

      except
        on E: Exception do
          memErrors.Lines.Add('Error: ' + e.message);
      end;
    end;
  finally
    CListView.Items.EndUpdate;
  end;
end;


procedure TForm1.Finished(Sender: TObject; Url, UrlData: string);
begin
  pnlInfo.Caption := 'Finished loading "' + Url + '"';
  pbInfo.Position := 100;
  pbInfo.Update;
  ProcessUrlData(UrlData);
end;

procedure TForm1.Progress(Sender: TObject; StatusId: TStatusId; Msg: string; Progress: Integer);
begin
  case statusId of
    siStatus:
    begin
      pbInfo.Position := Progress;
      pnlInfo.Caption := Msg;
      pbInfo.Update;
      pnlInfo.Update;
    end;
    siError:
    begin
      memErrors.Lines.Add(Msg);
      memErrors.Update;
    end;
  end;
end;

end.

Open in new window


and the thread code:
unit unit_download;

interface

uses
  Classes, idHttp, idComponent, IdCookieManager, SysUtils, Windows;

type
  TUrlCallbackFinished = procedure (Sender: TObject; Url, UrlData: string) of object;

  TStatusId = (siStatus, siError);
  TStatusCallback = procedure (Sender: TObject; StatusId: TStatusId; Msg: string = ''; Progress: Integer = 0) of object;

procedure Download(Url: string; CallbackFinished: TUrlCallbackFinished; CallbackProgress: TStatusCallback);

implementation

type
  TDownloadList = class(TThread)
  private
    fHttp : TidHttp;
    fCookieManager: TIdCookieManager;
    fUrl: string;
    fUrlData: string;
    fCallbackFinished: TUrlCallbackFinished;
    fCallbackStatus: TStatusCallback;
    fStatusMsg: string;
    fStatusId: TStatusId;
    fStatusProgress: Integer;
    fProgressMax: Int64;
    procedure Download;
    procedure FinishedSync;
    procedure InfoSync;
    procedure Info(StatusId: TStatusId; Msg: string; Progress: Integer = 0);
    procedure WorkProgress(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    procedure WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
  protected
    procedure Execute; override;
  public
    constructor Create(aUrl: string; aCallbackFinished: TUrlCallbackFinished; aCallbackStatus: TStatusCallback);
  end;

{ TDownloadList }

constructor TDownloadList.Create(aUrl: string; aCallbackFinished: TUrlCallbackFinished; aCallbackStatus: TStatusCallback);
begin
  inherited Create(False);
  FreeOnTerminate := True;
  fUrl := aUrl;
  fCallbackFinished := aCallbackFinished;
  fCallbackStatus := aCallbackStatus;
end;

procedure TDownloadList.Execute;
begin
  Download;
  Synchronize(FinishedSync);
end;

procedure TDownloadList.FinishedSync;
begin
  if Assigned(fCallbackFinished) then
    fCallbackFinished(Self, fUrl, fUrlData);
end;

procedure TDownloadList.Info(StatusId: TStatusId; Msg: string; Progress: Integer = 0);
begin
  fStatusId := StatusId;
  fStatusMsg := Msg;
  fStatusProgress := Progress;
  Synchronize(InfoSync);
end;

procedure TDownloadList.InfoSync;
begin
  if Assigned(fCallbackStatus) then
    fCallbackStatus(Self, fStatusId, fStatusMsg, fStatusProgress);
end;

procedure TDownloadList.Download;
begin
  Info(siStatus, 'Downloading');
  fProgressMax := 0;
  fUrlData := '';

  fCookieManager := TIdCookieManager.Create(nil);
  fHttp := TIdHTTP.Create(nil);
  try
    fHttp.OnWork := WorkProgress;
    fHttp.OnWorkBegin := WorkBegin;
    fHttp.OnWorkEnd := WorkEnd;
    //fHttp.request.useragent := 'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; WOW64; Trident/5.0; MAAU)';
    fHttp.request.useragent := 'Mozilla/5.0 (Windows NT 6.1; rv:26.0) Gecko/20100101 Firefox/26.0';
    // fHttp.ProxyParams.BasicAuthentication := True;
    // fHttp.ProxyParams.ProxyPassword := 'YourPassword';
    // fHttp.ProxyParams.ProxyUsername := 'YourUser';
    // fHttp.ProxyParams.ProxyPort := 8080;
    // fHttp.ProxyParams.ProxyServer := 'YourProxyServerIp';

    fHttp.AllowCookies := True;
    fHttp.CookieManager := fCookieManager;
    try
      fUrlData := fHttp.Get(fUrl);
    except
      on F: EIdHTTPProtocolException do
        Info(siError, F.ErrorMessage);
      on E : Exception do
        Info(siError, E.Message);
    end;
    Info(siStatus, 'Finished', 100);
  finally
    fHttp.Free;
    fCookieManager.Free;
  end;
end;

procedure TDownloadList.WorkProgress(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
var Percent: Integer;
begin
  Percent := 10; // Mark a little progress
  if fProgressMax > 0 then
    Percent := Trunc(AWorkCount / fProgressMax * 100);
  Info(siStatus, Format('Downloading... %d bytes', [AWorkCount]), Percent);
end;

procedure TDownloadList.WorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
begin
  fProgressMax := AWorkCountMax;
  WorkProgress(ASender, AWorkMode, 0);
end;

procedure TDownloadList.WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
  Info(siStatus, 'Downloading... Finished', 100);
end;

procedure Download(Url: string; CallbackFinished: TUrlCallbackFinished; CallbackProgress: TStatusCallback);
begin
  TDownLoadList.Create(Url, CallbackFinished, CallbackProgress);
end;

end.

Open in new window


and here's a screenshot of the form:screenshot
0
 
Marco GasiConnect With a Mentor FreelancerCommented:
You have to use Symchronize() and a method to populate the list. Declare the array of values you get to fill the list as a private variable:

type
  TDownloadList = class(TThread)
  private
    CHttp : TidHttp;
    CStatus : TStatusBar;
    CListView : TListView;
    Pagina : IHTMLDocument2;
    itens  : IHTMLElement;
    Valores: OleVariant;

Then move the code which fills the list ina specific procedure you can call FillList
In the Baixar method leave the code to get the html page with all data which will go to fill the variables you need to fill the list and then call

Synchronize(FillList);

within Baixar method.

And the list will be filled.
0
 
Marco GasiFreelancerCommented:
You can try this untested code:

unit unit_download;

interface

uses
  System.Classes, idHttp,Dialogs, StdCtrls, SysUtils, Windows, ComCtrls, MSHTML, Variants, ActiveX;

type
  TDownloadList = class(TThread)
  private
    CHttp : TidHttp;
    CStatus : TStatusBar;
    CListView : TListView;
     Pagina : IHTMLDocument2;
   procedure Baixar;
   procedure FillList;
  protected
    procedure Execute; override;
  public
   constructor Criar(http : tidhttp; statusbar : tStatusBar; listview: Tlistview);
   end;

implementation


uses
 unit_principal;

{ TDownloadList }

procedure TDownloadList.Baixar;
Var
 Valores: OleVariant;
 Buffer : String;
begin
CoInitialize(nil);
CListview.Clear;
CStatus.Panels[0].Text := 'Updating...';
CHttp.request.useragent := 'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; WOW64; Trident/5.0; MAAU)';
  Try
   Buffer := Chttp.Get(Link_download);
    except
    On E : Exception do
     Begin
       ShowMessage('Error: ' + e.message);
       CStatus.Panels[0].Text := 'Erro:' + e.Message;
       Exit;
     End;
   End;
CStatus.Panels[0].Text := 'Finish.';
Pagina := coHTMLDocument.Create as IHTMLDocument2;
Valores := VarArrayCreate([0,0], VarVariant);
Valores[0] := Buffer;
Pagina.write(PSafeArray(TVarData(Valores).VArray));
Pagina.close;
Synchronize(FillList);
end;

constructor TDownloadList.Criar(http: tidhttp; statusbar : tstatusbar; listview : TListView);
begin
inherited Create(False);
FreeOnTerminate := True;
Chttp := http;
Cstatus := statusbar;
CListview := Listview;
end;

procedure TDownloadList.Execute;
begin
If not (Terminated) Then
 begin
  baixar;
 end;
end;

procedure TDownloadList.FillList;
var
 I, X   : Integer;
 Caption, a, b, c : String;
 List   : TListItem;
 itens  : IHTMLElement;
begin
X := Pagina.all.length;
CStatus.Panels[0].Text := 'Creating list...';
CListView.Items.BeginUpdate;
Try
for I := 0 to X -1 do
 Begin
  itens := Pagina.all.item(I, varEmpty) as IHTMLElement;
  Try
   caption := '';
   a := '';
   b := '';
   c := '';
    if (itens.tagName = 'A') and (Pos('mbi-viewban-', Itens.getAttribute('HREF', VarEmpty)) > 0) and (Itens.title = '') then
     Caption := itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-red') and (itens.title = 'Even Balance Violation')  Then
     a := Itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-green') then
     b := itens.innerText;
    if (itens.tagName = 'A') and (Pos('http://www.pbbans.com/msi-server-', Itens.getAttribute('HREF', VarEmpty)) > 0) Then
     c := Itens.innerText;
    List := CListView.Items.Add;
    List.Caption := Caption;
    List.SubItems.Add(a);
    List.SubItems.Add(b);
    List.SubItems.Add(c);
   Except
    on E: Exception do
     Begin
       ShowMessage('Error: ' + e.message);
     End;
   End;
    End;
except
 On E : Exception do
  Begin
   ShowMessage('Error: ' + e.message);
   Exit;
  End;
End;
CListView.Items.EndUpdate;
CStatus.Panels[0].Text := 'List OK. ' + IntToStr(CListView.Items.Count);
CoUninitialize;
end;

end.

Open in new window

0
Free Tool: IP Lookup

Get more info about an IP address or domain name, such as organization, abuse contacts and geolocation.

One of a set of tools we are providing to everyone as a way of saying thank you for being a part of the community.

 
JúlioAuthor Commented:
Access violation:

unit unit_download;

interface

uses
  System.Classes, idHttp,Dialogs, StdCtrls, SysUtils, Windows, ComCtrls, MSHTML, Variants, ActiveX;

type
  TDownloadList = class(TThread)
  private
    CHttp     : TidHttp;
    CStatus   : TStatusBar;
    CListView : TListView;
    Pagina    : IHTMLDocument2;
    itens     : IHTMLElement;
    Valores   : OleVariant;
    X         : Integer;
   procedure Baixar;
   procedure FillList;
  protected
    procedure Execute; override;
  public
   constructor Criar(http : tidhttp; statusbar : tStatusBar; listview: Tlistview);
   end;

implementation


uses
 unit_principal;

{ TDownloadList }

procedure TDownloadList.Baixar;
Var
 Buffer                 : String;
begin
CoInitialize(nil);
CStatus.Panels[0].Text := 'Updating...';
CHttp.request.useragent := 'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; WOW64; Trident/5.0; MAAU)';
  Try
   Buffer := Chttp.Get(Link_download);
    except
    On E : Exception do
     Begin
       ShowMessage('Error: ' + e.message);
       CStatus.Panels[0].Text := 'Erro:' + e.Message;
       Exit;
     End;
   End;
CStatus.Panels[0].Text := 'Finish.';
Pagina := coHTMLDocument.Create as IHTMLDocument2;
Valores := VarArrayCreate([0,0], VarVariant);
Valores[0] := Buffer;
Pagina.write(PSafeArray(TVarData(Valores).VArray));
Pagina.close;
X := Pagina.all.length;
CStatus.Panels[0].Text := 'Creating list...';

Synchronize(FillList);

CoUninitialize;
end;

constructor TDownloadList.Criar(http: tidhttp; statusbar : tstatusbar; listview : TListView);
begin
inherited Create(False);
FreeOnTerminate := True;
Chttp := http;
Cstatus := statusbar;
CListview := Listview;
end;

procedure TDownloadList.Execute;
begin
If not (Terminated) Then
 begin
  baixar;
 end;
end;

procedure TDownloadList.FillList;
Var
 List                   : TListItem;
 I                      : Integer;
 Caption, a, b, c, d, e : String;
begin
CListview.Clear;
CListView.Items.BeginUpdate;
Try
for I := 0 to X -1 do
 Begin
  itens := Pagina.all.item(I, varEmpty) as IHTMLElement;
  Try
    if (itens.tagName = 'A') and (Pos('mbi-viewban-', Itens.getAttribute('HREF', VarEmpty)) > 0) and (Itens.title = '') then
     Caption := itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-red') and (itens.title = 'Even Balance Violation')  Then
     a := Itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
     b := Itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
     c := Itens.innerText;
    if (itens.tagName = 'SPAN') and (itens.className = 'text-green') then
     d := itens.innerText;
    if (itens.tagName = 'A') and (Pos('http://www.pbbans.com/msi-server-', Itens.getAttribute('HREF', VarEmpty)) > 0) Then
     e := Itens.innerText;
    List := CListView.Items.Add;
    List.Caption := Caption;
    List.SubItems.Add(a);
    List.SubItems.Add(b);
    List.SubItems.Add(c);
    List.SubItems.Add(d);
    List.SubItems.Add(e);
   Except
    on E: Exception do
     Begin
       ShowMessage('Error: ' + e.message);
     End;
   End;
 CStatus.Panels[0].Text := 'List OK. ' + IntToStr(CListView.Items.Count);
 End;
Except
 on E: Exception do
  Begin
   ShowMessage('Error: ' + e.Message);
  End;
End;
end;
end.

Open in new window

0
 
JúlioAuthor Commented:
Marco, with you unit i got Access Violation too.
0
 
Marco GasiFreelancerCommented:
Details?
0
 
JúlioAuthor Commented:
"Access violation at address 52D279F4 in module 'mshtml.dll'. Read of address 00000180"
0
 
Marco GasiFreelancerCommented:
Fantastic! Debugging threads is a nightmare :)

Please try to comment out the synchronize call so we can understand if the problem is in the first half of code (Baixar) or in the second one (FillList) I think it is in the second one but the access violation in mshtml seems indicate there is something related to the getting value from html page, uh?
0
 
JúlioAuthor Commented:
yes the problem is with the "FillList". But i think the variable "buffer" is empty because i try a "showmessage(buffer);" and i got a access violation too.
0
 
Marco GasiFreelancerCommented:
Okay, I tried to fix your last snippet. Keep in mind you can't use ShowMessage() from within a thread, nor you can update directly any element of the main window: you always must use Sinchronize for both status.panel and list view:

unit unit_download;

interface

uses
  System.Classes, idHttp,Dialogs, StdCtrls, SysUtils, Windows, ComCtrls, MSHTML, Variants, ActiveX;

type
  TDownloadList = class(TThread)
  private
    CHttp     : TidHttp;
    CStatus   : TStatusBar;
    CListView : TListView;
    Pagina    : IHTMLDocument2;
    itens     : IHTMLElement;
    Valores   : OleVariant;
    X         : Integer;
    Msg       : string;
   Caption, a, b, c, d, e : String;
   procedure Baixar;
   procedure FillList;
   procedure UpdateStatus;
  protected
    procedure Execute; override;
  public
   constructor Criar(http : tidhttp; statusbar : tStatusBar; listview: Tlistview);
   end;

implementation


uses
 unit_principal;

{ TDownloadList }

procedure TDownloadList.Baixar;
Var
 Buffer                 : String;
 I                      : Integer;
begin
CoInitialize(nil);
Msg := 'Updating...';
Synchronize(UpdateStatus);
CHttp.request.useragent := 'Mozilla/5.0 (compatible; MSIE 9.0; Windows NT 6.1; WOW64; Trident/5.0; MAAU)';
  Try
   Buffer := Chttp.Get(Link_download);
    except
    On E : Exception do
     Begin
       ShowMessage('Error: ' + e.message);
       CStatus.Panels[0].Text := 'Erro:' + e.Message;
       Exit;
     End;
   End;
  Msg := 'Finish.';
  Synchronize(UpdateStatus);
  Pagina := coHTMLDocument.Create as IHTMLDocument2;
  Valores := VarArrayCreate([0,0], VarVariant);
  Valores[0] := Buffer;
  Pagina.write(PSafeArray(TVarData(Valores).VArray));
  Pagina.close;
  X := Pagina.all.length;
  Msg := 'Creating list...';
  Synchronize(UpdateStatus);

  CListview.Clear;
  CListView.Items.BeginUpdate;
  Try
    for I := 0 to X -1 do
     Begin
      itens := Pagina.all.item(I, varEmpty) as IHTMLElement;
      Try
        if (itens.tagName = 'A') and (Pos('mbi-viewban-', Itens.getAttribute('HREF', VarEmpty)) > 0) and (Itens.title = '') then
         Caption := itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red') and (itens.title = 'Even Balance Violation')  Then
         a := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
         b := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
         c := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-green') then
         d := itens.innerText;
        if (itens.tagName = 'A') and (Pos('http://www.pbbans.com/msi-server-', Itens.getAttribute('HREF', VarEmpty)) > 0) Then
         e := Itens.innerText;
        Synchronize(FillList);
      except
        on E: Exception do
        begin
          Msg := 'Error: ' + e.message;
          Synchronize(UpdateStatus);
        end;
      End;

     end;
  except
    on E: Exception do
    begin
      Msg := 'Error: ' + e.message;
      Synchronize(UpdateStatus);
    end;
  End;

  CoUninitialize;
end;

constructor TDownloadList.Criar(http: tidhttp; statusbar : tstatusbar; listview : TListView);
begin
inherited Create(False);
FreeOnTerminate := True;
Chttp := http;
Cstatus := statusbar;
CListview := Listview;
end;

procedure TDownloadList.Execute;
begin
If not (Terminated) Then
 begin
  baixar;
 end;
end;

procedure TDownloadList.FillList;
Var
 List                   : TListItem;
begin
    List := CListView.Items.Add;
    List.Caption := Caption;
    List.SubItems.Add(a);
    List.SubItems.Add(b);
    List.SubItems.Add(c);
    List.SubItems.Add(d);
    List.SubItems.Add(e);

    Msg :=  'List OK. ' + IntToStr(CListView.Items.Count);
    Synchronize(UpdateStatus);
end;

procedure TDownloadList.UpdateStatus;
begin
  CStatus.Panels[0].Text := Msg;
end;

end.

Open in new window

0
 
JúlioAuthor Commented:
Link_Download is a global variable and i fill it in form1's event "onCreate".
0
 
JúlioAuthor Commented:
Your new code do not add any item to ListView, but statusbar is working.
0
 
JúlioAuthor Commented:
Form1 unit:

unit unit_principal;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.ComCtrls, Vcl.Menus, Vcl.ExtCtrls,
  Vcl.AppEvnts, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdHTTP, commctrl, Vcl.StdCtrls, wininet, IdCookieManager;


type
  TForm1 = class(TForm)
    MainMenu1: TMainMenu;
    Lists1: TMenuItem;
    BF4Last501: TMenuItem;
    PBDownload1: TMenuItem;
    Downloadlast1: TMenuItem;
    N1: TMenuItem;
    VisitSite1: TMenuItem;
    ListView1: TListView;
    StatusBar1: TStatusBar;
    About1: TMenuItem;
    Update1: TMenuItem;
    ools1: TMenuItem;
    PlayerAlert1: TMenuItem;
    Configuration1: TMenuItem;
    TrayIcon1: TTrayIcon;
    ApplicationEvents1: TApplicationEvents;
    PopupMenu1: TPopupMenu;
    Open1: TMenuItem;
    UpdateCurrentList1: TMenuItem;
    N2: TMenuItem;
    Close1: TMenuItem;
    IdHTTP1: TIdHTTP;
    ProgressBar1: TProgressBar;
    procedure ApplicationEvents1Minimize(Sender: TObject);
    procedure Open1Click(Sender: TObject);
    procedure Close1Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
    procedure BF4Last501Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
    procedure TrayIcon1Click(Sender: TObject);
    procedure IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCountMax: Int64);
    procedure IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
      AWorkCount: Int64);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

  type
  THackControl = class(TControl);

var
  Form1         : TForm1;
  Link_Download : string;
  Path_lista    : string;

implementation

uses
 unit_download;

Var
 Download : TDownloadlist;

function IsOnLine: boolean;
var
dwConnectionTypes : DWORD;
begin
dwConnectionTypes :=
INTERNET_CONNECTION_MODEM +
INTERNET_CONNECTION_LAN +
INTERNET_CONNECTION_PROXY;
result := InternetGetConnectedState(@dwConnectionTypes,0);
end;

{$R *.dfm}

procedure TForm1.ApplicationEvents1Minimize(Sender: TObject);
begin
Form1.Hide;
end;

procedure TForm1.BF4Last501Click(Sender: TObject);
begin
if IsOnline then
Begin
Download := TDownloadList.Criar(idhttp1, statusbar1, Listview1);
End
Else
StatusBar1.Panels[0].Text := 'Connect first..';
end;

procedure TForm1.Close1Click(Sender: TObject);
begin
Application.Terminate;
end;

procedure TForm1.FormCreate(Sender: TObject);
var
  PanelRect: TRect;
begin
Link_Download := 'http://www.pbbans.com/mbi-view-latest50-unofficial-bf4-lfb44.html';
Path_lista := ExtractFilePath(Application.ExeName) + 'list.html';

THackControl(ProgressBar1).SetParent(StatusBar1);
SendMessage(StatusBar1.Handle, SB_GETRECT, 1, Integer(@PanelRect));
with PanelRect do
 ProgressBar1.SetBounds(Left, Top, Right - Left, Bottom - Top);
end;

procedure TForm1.FormShow(Sender: TObject);
begin
Form1.Width := 651;
Form1.Height := 358;
end;

procedure TForm1.IdHTTP1Work(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCount: Int64);
begin
progressbar1.Position := AworkCount;
Statusbar1.Repaint;
Progressbar1.Repaint;
end;

procedure TForm1.IdHTTP1WorkBegin(ASender: TObject; AWorkMode: TWorkMode;
  AWorkCountMax: Int64);
begin
Progressbar1.Position := 0;
progressbar1.Max := aworkcountmax;
end;

procedure TForm1.IdHTTP1WorkEnd(ASender: TObject; AWorkMode: TWorkMode);
begin
TrayIcon1.ShowBalloonHint;
end;

procedure TForm1.Open1Click(Sender: TObject);
begin
Form1.Show;
end;

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
Form1.Show;
Form1.BringToFront;
end;

end.

Open in new window

0
 
Marco GasiFreelancerCommented:
Are you totally sure that items to add to the list are correctly filled. I mean:

        if (itens.tagName = 'A') and (Pos('mbi-viewban-', Itens.getAttribute('HREF', VarEmpty)) > 0) and (Itens.title = '') then
         Caption := itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red') and (itens.title = 'Even Balance Violation')  Then
         a := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
         b := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
         c := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-green') then
         d := itens.innerText;
        if (itens.tagName = 'A') and (Pos('http://www.pbbans.com/msi-server-', Itens.getAttribute('HREF', VarEmpty)) > 0) Then
         e := Itens.innerText;

if theese conditions are false all items Caption, a,b ,c and so on will be blank...
You could try to add an else in order to have value not empty:

        if (itens.tagName = 'A') and (Pos('mbi-viewban-', Itens.getAttribute('HREF', VarEmpty)) > 0) and (Itens.title = '') then
         Caption := itens.innerText
else
       Caption := 'Caption not found';
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red') and (itens.title = 'Even Balance Violation')  Then
         a := Itens.innerText
else
         a := 'a not found';

and so on.

Can you give it a try?
0
 
JúlioAuthor Commented:
I fix it:

procedure TDownloadList.FillList;
Var
 List                   : TListItem;
begin
CListView.Items.BeginUpdate;
    List := CListView.Items.Add;
    List.Caption := Caption;
    List.SubItems.Add(a);
    List.SubItems.Add(b);
    List.SubItems.Add(c);
    List.SubItems.Add(d);
    List.SubItems.Add(e);

    Msg :=  'List OK. ' + IntToStr(CListView.Items.Count);
    Synchronize(UpdateStatus);
  CListView.Items.EndUpdate;
end;

Open in new window


But look the result:

result
0
 
JúlioAuthor Commented:
0
 
Marco GasiFreelancerCommented:
So the 'a' value is wrong? And is it the only wrong value?
0
 
Marco GasiFreelancerCommented:
Try to modify this:

    for I := 0 to X -1 do
     Begin
      itens := Pagina.all.item(I, varEmpty) as IHTMLElement;
      Try
        if (itens.tagName = 'A') and (Pos('mbi-viewban-', Itens.getAttribute('HREF', VarEmpty)) > 0) and (Itens.title = '') then
         Caption := itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red') and (itens.title = 'Even Balance Violation')  Then
         a := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
         b := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-red')  Then
         c := Itens.innerText;
        if (itens.tagName = 'SPAN') and (itens.className = 'text-green') then
         d := itens.innerText;
        if (itens.tagName = 'A') and (Pos('http://www.pbbans.com/msi-server-', Itens.getAttribute('HREF', VarEmpty)) > 0) Then
         e := Itens.innerText;
      except
        on E: Exception do
        begin
          Msg := 'Error: ' + e.message;
          Synchronize(UpdateStatus);
        end;
      End;
      Synchronize(FillList);
    end;

Open in new window


moving  Synchronize(FillList); after the first try..except block
0
 
Marco GasiFreelancerCommented:
I suppose that didn't solve the problem, uh?
0
 
JúlioAuthor Commented:
Apologies, I will now attempt, I had to give an output. Women ..
0
 
JúlioAuthor Commented:
Just Caption, A, B and E is correct.
0
 
JúlioAuthor Commented:
But the table have 50 rows, with this code, add 1789 rows. Crazy!
0
 
Marco GasiFreelancerCommented:
Hi. Women, women... we can't live with nor without them :)

Now the problem seems not to be the code to update the ListView but the code wich processes the data retrivied rom the external site...

Later I'll try to test it, rebuilding a form like yours.

Cheers
0
 
Geert GruwezConnect With a Mentor Oracle dbaCommented:
this mixed approach won't get you anywhere

the laws of nature for threads:
1: loading data in memory can be done in threads
2: visual items are always drawn by the main thread
3: don't mix the above

i wrote some articles on threading, like adding threads to a slow frontend
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/A_6613-Adding-threads-for-loading-data-in-background-to-a-delphi-application.html

first analyze what is slow, and what can be done in background
> don't look at any frontend components for this
what i'd define as background:
thread tasks:
  load the website into the html and wait for it to finish

when the thread is finished:
  load the data from the (in-memory) html

don't mix showmessage in the thread
if you want to break out errors or status messages use a callback event:
http://www.experts-exchange.com/Programming/Languages/Pascal/Delphi/A_239-Displaying-progress-in-the-main-form-from-a-thread-in-Delphi.html

i'd use one callback event for both
i'll work out a sample
0
 
Marco GasiFreelancerCommented:
Please, can you attach an archive with unit_principal pas and dfm? I'm trying to test but I get an 'Argument out of range' error and I think there is something I'm missing with the TListView setup...
0
 
Geert GruwezOracle dbaCommented:
just something i see which potentially causes problems with form reuse

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
Form1.Show;
Form1.BringToFront;
end;

Open in new window


don't use Form1 for the instance name, use self instead ... or leave it out

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
  Show;
  BringToFront;
end;

Open in new window


with self:
procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
  Self.Show;
  Self.BringToFront;
end;

Open in new window

0
 
JúlioAuthor Commented:
Ty all!
You are the best!
0
 
JúlioAuthor Commented:
I learned a lot from past information! Thank you very much!
0
All Courses

From novice to tech pro — start learning today.