clubreseau

Someone can help me ? 

How I can insert some subcategory Item in Category CRÉÉ on that code ?

var
  Mi, Mx, My: TMenuItem;
  tblIDParent, tblIDCat : integer;
  tblName  :string;

begin

  tbl.SQL.Text:='SELECT c.id_category, c.id_parent, c.level_depth, cl.name FROM category AS c LEFT JOIN category_lang AS cl ON c.id_category = cl.id_category WHERE c.id_parent >= 2 ORDER BY c.id_category';

  tbl.open;
  tbl.First;

  while not tbl.eof do

  begin

  tblIDCat    := tbl.Fields[0].AsInteger;
  tblIDParent := tbl.Fields[1].AsInteger;
  tblName     := tbl.Fields[3].AsString;

    if tbl.Fields[1].AsString = '2' then

    begin
      Mi := TMenuItem.create(popupmenu1);
      Mi.Caption := tblName;
      Mi.Tag     := tblIDCat;
      popupmenu1.Items.add(Mi);

    end;

    if tbl.Fields[2].AsString = '3' then

      for var i := 0 to Popupmenu1.items.count - 1 do

        if Popupmenu1.items[i] is TMenuItem then

          if TMenuItem(Popupmenu1.items[i]).tag = tblIDParent then

          begin
            MI := TMenuItem.create(TMenuItem(Popupmenu1.items[i]));
            MI.Caption := tblName;
            MI.Tag := tblIDCat;
            TMenuItem(Popupmenu1.items[i]).Add(mi);

            Mx := TMenuItem.create(TMenuItem(Popupmenu1.items[i]));
            Mx.Caption := 'AJOUTER';
            Mx.Tag     := tblIDCat;
            Mx.OnClick := ONCLIK_ADD;
            Mi.Add(mx);

            Mx := TMenuItem.create(TMenuItem(Popupmenu1.items[i]));
            Mx.Caption := 'CRÉE';
            Mx.Tag     := tblIDCat;
            Mx.OnClick := ONCLIK_CREATE;
            Mi.Add(mx);

          end;

    tbl.next;

  end;

4 hours ago, Lajos Juhász said:

The hotkey doesn't have to be the first character. A better solution is to set the AutoHotkeys property of the popup menu to maManual. If that's not possible you can use the StripHotkey function from Vcl.Menus to remove the &.

I fix it, than with AutoHotkeys property of the popup menu to maManual,

Now my only problem, I want to add submenu to category DEL  

do you now how ?

4 hours ago, Lajos Juhász said:

The hotkey doesn't have to be the first character. A better solution is to set the AutoHotkeys property of the popup menu to maManual. If that's not possible you can use the StripHotkey function from Vcl.Menus to remove the &.

I fix it, than with AutoHotkeys property of the popup menu to maManual,

Now my only problem, I want to add submenu to category DEL  

do you now how ?

4 hours ago, Stano said:

Use the function Copy()

I fix it, than with AutoHotkeys property of the popup menu to maManual,

Now my only problem, I want to add submenu to category DEL  

do you now how ?

12 hours ago, Adam said:

Not the most elegant solution - but it will at least get you started:

 

var
  Mi: TMenuItem;
  Mx: TMenuItem;
begin
  tbl.open;
  tbl.First;
  while not tbl.eof do
  begin
    if tblIDParent.value = 2 then
    begin
      Mi := TMenuItem.create(MainMenu1);
      Mi.Caption := tblName.value;
      Mi.Tag := tblID.value;
      MainMenu1.Items.add(Mi);

    end;
    if tblIDParent.value = 3 then
      for var i := 0 to MainMenu1.items.count - 1 do
        if MainMenu1.items[i] is TMenuItem then
          if TMenuItem(MainMenu1.items[i]).tag = tblIDParent.value then
          begin
            MI := TMenuItem.create(TMenuItem(MainMenu1.items[i]));
            MI.Caption := tblName.value;
            MI.Tag := tblID.value;
            TMenuItem(MainMenu1.items[i]).Add(mi);


            Mx := TMenuItem.create(TMenuItem(MainMenu1.items[i]));
            Mx.Caption := 'ADD';
            Mx.Tag := tblID.value;
            Mi.Add(mx);

            Mx := TMenuItem.create(TMenuItem(MainMenu1.items[i]));
            Mx.Caption := 'DEL';
            Mx.Tag := tblID.value;
            Mi.Add(mx);
          end;
    tbl.next;
  end;
end;

 

Work perfect thank you

How I can create subcategory to category DEL ?

Work perfect thank you

only 1 problem on my onclick 

STR_PCAPTION := TMenuItem((Sender as TMenuItem).parent).caption;

showmessage(STR_PCAPTION);

all my category and subcategory start by &andthename ? 

How I can get the original name without &

and how I can create subcategory to category DEL ?

Hi,

I use TedgeBrowser and I want when I go to this page https://login.aliexpress.com/  that write my email and password automatically

someone can explain or show me a part of code how to do it.

thank you

I use delphi 10.4

I create a button and inside I add

WebBrowser1.Navigate('https://www.aliexpress.com/');

to make it simple and test it. and I got a many javascript error 

how i can fix this. 

thank you

ror 

13 hours ago, FPiette said:

Why can't you use my example and do the reverse. It is trivial! Maybe a little bit more programming learning is required and also some effort to correctly specify a problem. We could have avoided all this if the question was asked clearly from the beginning

 

function ExtractDomain(const URL : String) : String;
var
    I, J : Integer;
begin
    I := Pos('://', URL);
    if I <= 0 then
        I := 1
    else
        Inc(I, 3);
    J := Pos('/', URL, I);
    if J <= 0 then begin
        Result := Copy(URL, I, MAXINT);
        Exit;
    end;
    Result := Copy(URL, I, J - I);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    Index   : Integer;
    Dict    : TDictionary<String, Integer>;
    URL     : String;
    Domain  : String;
    Value   : Integer;
    UrlFile : TStreamReader;
begin
    Dict  := TDictionary<String, Integer>.Create(10000);
    try
        ListBox1.Items.BeginUpdate;
        try
            // Load the dictionary with url.txt file
            UrlFile := TStreamReader.Create('url.txt');
            try
                while not UrlFile.EndOfStream do begin
                    URL := Trim(UrlFile.ReadLine);
                    if URL = '' then
                        continue;
                    Domain := ExtractDomain(UpperCase(URL));
                    if Dict.TryGetValue(Domain, Value) then
                        // Domain already found, ignore it
                        continue;
                    // Domain not seen before, add to dictionary
                    Dict.Add(Domain, 0);
                end;
            finally
                FreeAndNil(UrlFile);
            end;

            // Now filter the ListBox to remove duplicate and items wich
            // are already in the dictionary (because they come from url.txt)
            for Index := ListBox1.Items.Count - 1 downto 0 do begin
                URL := Trim(ListBox1.Items[Index]);
                if URL = '' then begin
                    ListBox1.Items.Delete(Index);
                    continue;
                end;
                Domain := ExtractDomain(UpperCase(URL));
                if Dict.TryGetValue(Domain, Value) then begin
                    // Domain already found, delete from ListBox
                    ListBox1.Items.Delete(Index);
                    continue;
                end;
                // Domain not seen before, add to dictionary and don't remove
                Dict.Add(Domain, 0);
            end;
        finally
            ListBox1.Items.EndUpdate;
        end;
    finally
        FreeAndNil(Dict);
    end;
end;

 

You rock !

last question what is the commande to delete line in url.txt ?

11 hours ago, FPiette said:

Here is code to add all URL from url.txt except those already existing in the ListBox and avoiding all duplicates.

 

function ExtractDomain(const URL : String) : String;
var
    I, J : Integer;
begin
    I := Pos('://', URL);
    if I <= 0 then
        I := 1
    else
        Inc(I, 3);
    J := Pos('/', URL, I);
    if J <= 0 then begin
        Result := Copy(URL, I, MAXINT);
        Exit;
    end;
    Result := Copy(URL, I, J - I);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    Index   : Integer;
    Dict    : TDictionary<String, Integer>;
    URL     : String;
    Domain  : String;
    Value   : Integer;
    UrlFile : TStreamReader;
begin
    Dict  := TDictionary<String, Integer>.Create(10000);
    try
        ListBox1.Items.BeginUpdate;
        try
            for Index := ListBox1.Items.Count - 1 downto 0 do begin
                URL := Trim(ListBox1.Items[Index]);
                if URL = '' then begin
                    ListBox1.Items.Delete(Index);
                    continue;
                end;
                Domain := ExtractDomain(UpperCase(URL));
                if Dict.TryGetValue(Domain, Value) then begin
                    // Domain already found, delete from ListBox
                    ListBox1.Items.Delete(Index);
                    continue;
                end;
                // Domain not seen before, add to dictionary and don't remove
                Dict.Add(Domain, 0);
            end;
            // Now process url.txt file to add to the ListBox all URL found in
            // it, avoiding to add duplicates
            UrlFile := TStreamReader.Create('url.txt');
            try
                while not UrlFile.EndOfStream do begin
                    URL := Trim(UrlFile.ReadLine);
                    if URL = '' then
                        continue;
                    Domain := ExtractDomain(UpperCase(URL));
                    if Dict.TryGetValue(Domain, Value) then
                        // Domain already found, ignore it
                        continue;
                    // Domain not seen before, add to dictionary
                    Dict.Add(Domain, 0);
                    // and add the URL to the ListBox
                    ListBox1.Items.Add(URL);
                end;
            finally
                FreeAndNil(UrlFile);
            end;
        finally
            ListBox1.Items.EndUpdate;
        end;
    finally
        FreeAndNil(Dict);
    end;
end;

 

its the opposite I would like.. delete url in listbox1.  search in url.txt all duplicated remove in lixtbo1.

in my listbox1 i have already 1000 URL, i dont want to load url from url.txt I want he look in URl.txt if line in litbox1 are in url.txt then delete the line in listbox.

43 minutes ago, FPiette said:

Sorry but for me "welcome.com" is simply the domain part of the URL.

sorry I misspoke then. 

5 hours ago, FPiette said:

I still do see what he call "root domain".

What are the root domains of "www.company.co.uk", "www.ulg.ac.be" and "www.company.com"?

domain = http://welcome.com/hi.html  the root or this domain is welcome.com  remove http:// until / 

2 hours ago, FPiette said:

 

The idea is just the same as above and then read the url file line by line, extract the domain, check the dictionary. If already there, just read next line if not there, add the domain in the dictionary and add the url to the listbox. You should be able to do that easily yourself.

I don't understand what you call "domain root". Give an example.

this is my code and not working

trying to loook into files and delete all duplicated URL in listbox1.

procedure TForm1.DELETEURLClick(Sender: TObject);
var
    Index  : Integer;
    Dict   : TDictionary<String, Integer>;
    URL    : String;
    Domain : String;
    Value  : Integer;
    sl : TStringList;
    ix : Integer;
begin
    sl := TStringList.Create;
    Dict  := TDictionary<String, Integer>.Create(100000);
     try
        ListBox1.Items.BeginUpdate;
        try
            for Index := ListBox1.Items.Count - 1 downto 0 do begin
                URL := ListBox1.Items[Index];
                sl.LoadFromFile('C:\Users\myname\Documents\Url.txt');
                ix := sl.IndexOf(URL);

                if URL = '' then begin
                    ListBox1.Items.Delete(Index);
                    continue;
                end;

                Domain := ExtractDomain(Trim(UpperCase(ix.ToString)));
                if Dict.TryGetValue(Domain, Value) then begin
                    // Domain already found, delete from ListBox
                    ListBox1.Items.Delete(Index);
                    continue;
                end;
                // Domain not seen before, add to dictionary and don't remove from list
                Dict.Add(Domain, 0);
            end;
        finally
            ListBox1.Items.EndUpdate;
        end;
    finally
        FreeAndNil(Dict);
        sl.Free;
    end;
end;





function ExtractDomain(const URL : String) : String;
var
    I, J : Integer;
begin
    I := Pos('://', URL);
    if I <= 0 then
        I := 1
    else
        Inc(I, 3);
    J := Pos('/', URL, I);
    if J <= 0 then begin
        Result := Copy(URL, I, MAXINT);
        Exit;
    end;
    Result := Copy(URL, I, J - I);
end;

thank you SIR !

16 hours ago, FPiette said:

function ExtractDomain(const URL : String) : String;
var
    I, J : Integer;
begin
    I := Pos('://', URL);
    if I <= 0 then
        I := 1
    else
        Inc(I, 3);
    J := Pos('/', URL, I);
    if J <= 0 then begin
        Result := Copy(URL, I, MAXINT);
        Exit;
    end;
    Result := Copy(URL, I, J - I);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
    Index  : Integer;
    Dict   : TDictionary<String, Integer>;
    URL    : String;
    Domain : String;
    Value  : Integer;
begin
    Dict  := TDictionary<String, Integer>.Create(10000);
    try
        ListBox1.Items.BeginUpdate;
        try
            for Index := ListBox1.Items.Count - 1 downto 0 do begin
                URL := ListBox1.Items[Index];
                if URL = '' then begin
                    ListBox1.Items.Delete(Index);
                    continue;
                end;
                Domain := ExtractDomain(Trim(UpperCase(URL)));
                if Dict.TryGetValue(Domain, Value) then begin
                    // Domain already found, delete from ListBox
                    ListBox1.Items.Delete(Index);
                    continue;
                end;
                // Domain not seen before, add to dictionary and don't remove from list
                Dict.Add(Domain, 0);
            end;
        finally
            ListBox1.Items.EndUpdate;
        end;
    finally
        FreeAndNil(Dict);
    end;
end;

This will check for domain by ignoring character casing and ignoring the protocol.
You may adept this to a TStrings easily.

I used a dictionary because you said you have 10K items. A dictionary should be faster than a simple list when there are a lot of items but I have not checked how many items are required so that dictionary is faster than list.

Thank you its work perfectly !

How to convert it, to look at a file called url.txt that contain URL, and delete all duplicate domains in my listbox1 ?

and like your code I want its look only domain root. If domain root are in Url.txt delete the entire URL in listbox1.

Thank you

 I have a listbox with full or URL like

http://test.com/demo.php

https://test.com/demo.php

http://www.test.com/demo.php

if my string have somethink like https://test.com/test/test.php then do not add in listbox1 because test.com are in the listbox1.

maybe the solution is to remove http:// and https:// at the begining until first / and after compare to see.

someone have a solution to delete duplicate domain in my listbox1 ?

17 hours ago, clubreseau said:

I use this to Load 10K of Items from listbox1 to Memo1 and it take 4 minut to see items in memo1 and the APP Freeze.

 

here my code

procedure TForm1.Button1(Sender: TObject);
var
i:integer;
begin
       Memo1.lines.BeginUpdate;
  try

   for i := 0 to ListBox1.Items.Count -1 do

       Memo1.Lines := ListBox1.Items;

      finally

        Memo1.lines.EndUpdate;

      end;
end;

 

the function do not delete all duplicate domain in listbox1 ?

function ExtractDomainName(const Url: string): string;
var
  FirstChar, LastChar, Len: Integer;
begin
  Result := '';
  FirstChar := Pos('://', Url);
  LastChar := Pos('/', Url, FirstChar + 3);
  if FirstChar = 0 then
    FirstChar := 1                  //  means no protocol there, so we adjust for the first char
  else
    FirstChar := FirstChar + 3;     //  to compensate the length of "://"
  if LastChar = 0 then
    LastChar := Length(Url) + 1;    //  adjust for the last char, add 1 for Len calculation
  if FirstChar >= LastChar then
    Exit;                           //  we have broken an empty URL or broken one
  Len := LastChar - FirstChar;
  SetLength(Result, Len);
  Move(Url[FirstChar], Result[1], Len * SizeOf(Char));
end;

Im confused !

then the fastest way is ?

someone tell me to use tstringlist ?

12 hours ago, Kas Ob. said:

What is this ???!!!!!!

You are loading all items 10000 items, and yes it will take 4 minutes.

 

You should either do this 

  Memo1.Lines.BeginUpdate;
  try
    for I := 0 to ListBox1.Items.Count - 1 do
      Memo1.Lines.Add(ListBox1.Items.Strings[I])
  finally
    Memo1.Lines.EndUpdate;
  end;

Or simply this one line, (no looping)

Memo1.Lines := ListBox1.Items;  // no need to BeginUpdate..EndUpdate here 

the difference is this, if you need to process each item then use BeginUpdate..EndUpdate and loop through the items, when you don't need to process then you don't need to loop, means just one line will do it.

 

Here is a demo with 10k lines, you go and time it and what is the difference for yourself.

 

ListBoxMemo.zip

why this freeze the APP and take 1 minut to load 10K of items ?

procedure TForm1.Button1(Sender: TObject);

begin
   Form1.Memo1.Lines := Form2.Listbox1.Items;
end;

On 11/4/2020 at 3:22 AM, Kas Ob. said:

Question 1

Try something like this

function ExtractDomainName(const Url: string): string;
var
  FirstChar, LastChar, Len: Integer;
begin
  Result := '';
  FirstChar := Pos('://', Url);
  LastChar := Pos('/', Url, FirstChar + 3);
  if FirstChar = 0 then
    FirstChar := 1                  //  means no protocol there, so we adjust for the first char
  else
    FirstChar := FirstChar + 3;     //  to compensate the length of "://"
  if LastChar = 0 then
    LastChar := Length(Url) + 1;    //  adjust for the last char, add 1 for Len calculation
  if FirstChar >= LastChar then
    Exit;                           //  we have broken an empty URL or broken one
  Len := LastChar - FirstChar;
  SetLength(Result, Len);
  Move(Url[FirstChar], Result[1], Len * SizeOf(Char));
end;

Question 2

You need to understand the following

TMemo is a control that will issue an invalidate and redraw..., every time you add an item, this behaviour is not strict to TMemo, you can avoid the redraw on every items when you will add many items in a loop by locking it.

  Memo.Lines.BeginUpdate;
  try
    // We loop here and add items
  finally
    Memo.Lines.EndUpdate;
  end;

try..finally is crucial here, because if you locked some control like a Memo or ListBox, then in that loop some exception raised, that will mean EndUpdate is not called and your control is frozen and might cause you whole application to freeze.

I use this to Load 10K of Items from listbox1 to Memo1 and it take 4 minut to see items in memo1 and the APP Freeze.

here my code

procedure TForm1.Button1(Sender: TObject);
var
i:integer;
begin
       Memo1.lines.BeginUpdate;
  try

   for i := 0 to ListBox1.Items.Count -1 do

       Memo1.Lines := ListBox1.Items;

      finally

        Memo1.lines.EndUpdate;

      end;
end;

Hi,

Question 1

I have a listbox with full or URL like

http://test.com/demo.php

https://test.com/demo.php

http://www.test.com/demo.php

if my string have somethink like https://test.com/test/test.php then do not add in listbox1 because test.com are in the listbox1.

maybe the solution is to remove http:// and https:// at the begining until first / and after compare to see.

Question 2

I have a listbox with 3000 URL when I press the button to paste all items from listbox to memo, its feeze and take time.

Someone have the solution for long text for memo.

Thank you, please im visual need a demo of part of code.

37 minutes ago, Kryvich said:

Yes, it's possible. And just in case an user needs to stop the download, I added the corresponding button. Now there are 3 states: dsIdle, dsExecuted and dsStopped.

Downloader.zip

Thank You Kryvich everything are perfect.

The windows not feezing anymore, and the loop are going fast.

Thank you for your time ! 

7 hours ago, Kryvich said:

Hi, @clubreseau

@Remy Lebeau gave you everything you needed to finish the job. But OK, in the attachment to this message is a ready test application based on Remy's code, with the addition of a thread pool. Tested on Delphi CE.

 

Downloader.zip

Your code is Perfect only 1 problem, the windows freeze when the app run, can we fix this ?

Someone respond me this... It freezes the main thread (where UI of your app is running) and thus you may feel it's frozen. Move your task into a worker thread

4 hours ago, clubreseau said:

I have published elsewhere precisely to not ask you too much.

the code freeze the windows sometime, when I have more then 10 url in listbox. that why need no more then 5 per time

13 minutes ago, Remy Lebeau said:

It is generally considered bad practice to ask the same question across multiple forums at the same time. It is rude to the people who decide to help you. If you are getting help somewhere, STAY THERE.

 

I spent the last 3 days of my time helping you, just for you to now throw away everything I had given you and go somewhere else to start over. That is a slap in my face. Thanks for nothing.

I have published elsewhere precisely to not ask you too much.