Solved

Delphi: Listview and Thread

Posted on 2014-01-27
28
1,614 Views
Last Modified: 2014-01-28
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!
0
Comment
Question by:Júlio
  • 14
  • 11
  • 3
28 Comments
 
LVL 30

Assisted Solution

by:Marco Gasi
Marco Gasi earned 167 total points
ID: 39812441
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
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812473
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
 

Author Comment

by:Júlio
ID: 39812597
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
 

Author Comment

by:Júlio
ID: 39812605
Marco, with you unit i got Access Violation too.
0
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812606
Details?
0
 

Author Comment

by:Júlio
ID: 39812614
"Access violation at address 52D279F4 in module 'mshtml.dll'. Read of address 00000180"
0
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812629
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
 

Author Comment

by:Júlio
ID: 39812666
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
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812667
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
 

Author Comment

by:Júlio
ID: 39812671
Link_Download is a global variable and i fill it in form1's event "onCreate".
0
 

Author Comment

by:Júlio
ID: 39812676
Your new code do not add any item to ListView, but statusbar is working.
0
 

Author Comment

by:Júlio
ID: 39812694
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
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812708
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
 

Author Comment

by:Júlio
ID: 39812710
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
What Should I Do With This Threat Intelligence?

Are you wondering if you actually need threat intelligence? The answer is yes. We explain the basics for creating useful threat intelligence.

 

Author Comment

by:Júlio
ID: 39812711
0
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812733
So the 'a' value is wrong? And is it the only wrong value?
0
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812754
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
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39812851
I suppose that didn't solve the problem, uh?
0
 

Author Comment

by:Júlio
ID: 39813557
Apologies, I will now attempt, I had to give an output. Women ..
0
 

Author Comment

by:Júlio
ID: 39813561
Just Caption, A, B and E is correct.
0
 

Author Comment

by:Júlio
ID: 39813563
But the table have 50 rows, with this code, add 1789 rows. Crazy!
0
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39814173
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
 
LVL 36

Assisted Solution

by:Geert Gruwez
Geert Gruwez earned 333 total points
ID: 39814290
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
 
LVL 30

Expert Comment

by:Marco Gasi
ID: 39814315
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
 
LVL 36

Expert Comment

by:Geert Gruwez
ID: 39814418
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
 
LVL 36

Accepted Solution

by:
Geert Gruwez earned 333 total points
ID: 39814767
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
 

Author Closing Comment

by:Júlio
ID: 39814885
Ty all!
You are the best!
0
 

Author Comment

by:Júlio
ID: 39814915
I learned a lot from past information! Thank you very much!
0

Featured Post

How to run any project with ease

Manage projects of all sizes how you want. Great for personal to-do lists, project milestones, team priorities and launch plans.
- Combine task lists, docs, spreadsheets, and chat in one
- View and edit from mobile/offline
- Cut down on emails

Join & Write a Comment

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
Introduction The parallel port is a very commonly known port, it was widely used to connect a printer to the PC, if you look at the back of your computer, for those who don't have newer computers, there will be a port with 25 pins and a small print…
Illustrator's Shape Builder tool will let you combine shapes visually and interactively. This video shows the Mac version, but the tool works the same way in Windows. To follow along with this video, you can draw your own shapes or download the file…
This tutorial demonstrates a quick way of adding group price to multiple Magento products.

758 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

20 Experts available now in Live!

Get 1:1 Help Now