Sashar333

procedure bar.Execute; var net:TNetHTTPClient; tm:string; begin soed:=1; mm:=TStringList.Create; mmc:=TStringList.Create; mml:=TStringList.Create; net:=tnethttpclient.Create(nil); mm.LoadFromStream(net.Get('https://www.gector-spb.ru/catalog/').ContentStream,TEncoding.UTF8); pbmax:=mm.Count; soed:=2; while (mm.Count<>0) do begin if pos('class="catalog"',mm[0])>0 then begin while (mm.Count<>0) do begin if pos('div class="header"',mm[0])>0 then begin mm.Delete(0); s:=mm[0]; delete(s,1,pos('>',s)); s:=copy(s,0,pos('<',s)-1); mmc.Add(s); mml.Add('---'); while (mm.Count<>0)and(pos('</table>',mm[0])=0) do begin if pos('tr class="cell item',mm[0])>0 then begin Form1.pb.Value:=100-(round(mm.Count*100/pbmax)); mm.Delete(0); s:=mm[0]; delete(s,1,pos('a name=',s)); delete(s,1,pos('>',s)); s:=copy(s,1,pos('</a>',s)-1); if s=' ' then begin mm.Delete(0); s:=mm[0]; delete(s,1,pos('</a>',s)+3); s:=copy(s,1,pos('</td>',s)-1); end; mml.Add(s); mm.Delete(0); s:=mm[0]; delete(s,1,pos('<strong>',s)+7); s:=copy(s,1,pos('</strong>',s)-1); tm:='остаток: '+s+'тн'; mm.Delete(0); s:=mm[0]; delete(s,1,pos('>',s)); s:=copy(s,1,pos('</td>',s)-1); mml.Add(tm+' цена: '+s+'руб\тн'); end; mm.Delete(0); end; end; mm.Delete(0); end; end; if mm.Count<>0 then mm.Delete(0); end; Synchronize(syn); soed:=0; mm.Free; mmc.Free; mml.Free; terminate; end; procedure bar.syn; var item:TListBoxItem; tm:string; i,i2:integer; begin Form1.ListBox1.BeginUpdate; for I := 0 to mmc.Count-1 do begin tm:=mmc; Form1.ComboBox1.Items.Add(tm); end; i:=0; i2:=-1; while i<(mml.Count-1) do begin Item:=TListBoxItem.Create(Form1.ListBox1); Item.StyleLookup:='listboxitembottomdetail'; Item.Height:=40; if mml='---' then begin i2:=i2+1; i:=i+1; end; item.TagString:=mmc[i2]; Item.TextSettings.WordWrap:=true; Item.Text:=mml; item.ItemData.Detail:=mml[i+1]; Form1.ListBox1.AddObject(item); i:=i+2; end; Form1.ListBox1.EndUpdate; end;

Нашел программиста для написания данного приложения! Всем спасибо! Тему можно закрыть.

Slym, спасибо! загрузка получилась на смартфоне за 1-2 секунды без тормозов!

вот так более менее работает, но все равно подвисает (на сколько я понимаю именно при Item:=TListBoxItem.Create(Form1.ListBox1);) хотя могу ошибаться

procedure bar.Execute; var net:TNetHTTPClient; begin soed:=1; mm:=tmemo.Create(nil); net:=tnethttpclient.Create(nil); mm.Lines.LoadFromStream(net.Get('https://www.gector-spb.ru/catalog/').ContentStream,TEncoding.UTF8); pbmax:=mm.Lines.Count; soed:=2; while (mm.Lines.Count<>0) do begin if pos('class="catalog"',mm.Lines[0])>0 then begin while (mm.Lines.Count<>0) do begin if pos('div class="header"',mm.Lines[0])>0 then begin mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('>',s)); s:=copy(s,0,pos('<',s)-1); tgs:=s; Synchronize(syn); end; mm.Lines.Delete(0); end; end; if mm.Lines.Count<>0 then mm.Lines.Delete(0); end; soed:=0; terminate; end; procedure bar.syn; var item:TListBoxItem; begin Form1.ComboBox1.Items.Add(s); Form1.ComboBox1.ListItems[0].TextSettings.FontColor := TAlphaColorRec.White; while (mm.Lines.Count<>0)and(pos('</table>',mm.Lines[0])=0) do begin if pos('tr class="cell item',mm.Lines[0])>0 then begin Form1.pb.Value:=100-(round(mm.Lines.Count*100/pbmax)); Form1.ListBox1.BeginUpdate; Item:=TListBoxItem.Create(Form1.ListBox1); Item.StyleLookup:='listboxitembottomdetail'; Item.Height:=40; item.TagString:=tgs; Item.TextSettings.WordWrap:=true; mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('a name=',s)); delete(s,1,pos('>',s)); s:=copy(s,1,pos('</a>',s)-1); if s=' ' then begin mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('</a>',s)+3); s:=copy(s,1,pos('</td>',s)-1); end; Item.Text:=s; mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('<strong>',s)+7); s:=copy(s,1,pos('</strong>',s)-1); item.ItemData.Detail:='остаток: '+s+'тн'; mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('>',s)); s:=copy(s,1,pos('</td>',s)-1); item.ItemData.Detail:=item.ItemData.Detail+' цена: '+s+'руб\тн'; Form1.ListBox1.AddObject(item); Form1.ListBox1.EndUpdate; end; mm.Lines.Delete(0); end; end;

Slym, так вроде создание визуальных компонентов в потоке не есть хорошо..?

Tumaso, если добавляю items в Listbox в главном потоке то приложение зависает на время, пока большой список создается. По другому никак?

Евгений Корепов, согласен, но такой подход не подходит мне.

пример кода: unit Unit1; interface uses System.SysUtils, System.Types, System.UITypes, System.Classes, System.Variants, FMX.Types, FMX.Controls, FMX.Forms, FMX.Graphics, FMX.Dialogs, FMX.Objects, FMX.Layouts, System.ImageList, FMX.ImgList, FMX.Controls.Presentation, FMX.StdCtrls, FMX.TabControl, FMX.Edit, FMX.ScrollBox, FMX.Memo, FMX.Ani, FMX.DateTimeCtrls, FMX.ListBox, FireDAC.Stan.Intf, FireDAC.Comp.BatchMove, FireDAC.Comp.BatchMove.Text, System.Net.URLClient, System.Net.HttpClient, System.Net.HttpClientComponent; type TForm1 = class(TForm) Layout1: TLayout; GridPanelLayout1: TGridPanelLayout; TabControl1: TTabControl; TabItem1: TTabItem; TabItem2: TTabItem; TabItem3: TTabItem; TabItem5: TTabItem; TabItem6: TTabItem; GridPanelLayout2: TGridPanelLayout; ImageList1: TImageList; GridPanelLayout3: TGridPanelLayout; CornerButton2: TCornerButton; CornerButton3: TCornerButton; CornerButton4: TCornerButton; CornerButton5: TCornerButton; CornerButton6: TCornerButton; GridPanelLayout5: TGridPanelLayout; GridPanelLayout6: TGridPanelLayout; CornerButton7: TCornerButton; GridPanelLayout7: TGridPanelLayout; GridPanelLayout8: TGridPanelLayout; Text2: TText; StyleBook1: TStyleBook; CornerButton1: TCornerButton; Text4: TText; GridPanelLayout9: TGridPanelLayout; GridPanelLayout10: TGridPanelLayout; CornerButton8: TCornerButton; CornerButton9: TCornerButton; GridPanelLayout11: TGridPanelLayout; GridPanelLayout12: TGridPanelLayout; Text3: TText; GridPanelLayout15: TGridPanelLayout; GridPanelLayout16: TGridPanelLayout; CornerButton10: TCornerButton; CornerButton11: TCornerButton; GridPanelLayout18: TGridPanelLayout; GridPanelLayout19: TGridPanelLayout; CornerButton12: TCornerButton; CornerButton13: TCornerButton; Memo2: TMemo; DateEdit2: TDateEdit; ComboBox1: TComboBox; Text8: TText; Edit1: TEdit; Glyph1: TGlyph; ImageList2: TImageList; Timer1: TTimer; Text6: TText; ListBox1: TListBox; indi: TAniIndicator; ListBox2: TListBox; procedure CornerButton2Click(Sender: TObject); procedure CornerButton3Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure CornerButton7Click(Sender: TObject); procedure CornerButton5Click(Sender: TObject); procedure CornerButton6Click(Sender: TObject); procedure CornerButton13Click(Sender: TObject); procedure CornerButton1Click(Sender: TObject); procedure CornerButton9Click(Sender: TObject); procedure Edit1Change(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure ComboBox1Change(Sender: TObject); private { Private declarations } public { Public declarations } end; type bar = class(TThread) private { Private declarations } protected procedure Execute; override; end; var Form1: TForm1; cl:bar; proc:byte; ss:TStringStream; implementation {$R *.fmx} {$R *.LgXhdpiPh.fmx ANDROID} {$R *.Windows.fmx MSWINDOWS} procedure TForm1.ComboBox1Change(Sender: TObject); var i: Integer; begin while Listbox2.count>0 do ListBox2.listitems[0].Parent:=ListBox1; for i := 0 to ListBox1.Count-1 do if Listbox1.ListItems[i-ListBox2.Count].TagString=Combobox1.ListItems[Combobox1.ItemIndex].Text then Listbox1.ListItems[i-ListBox2.Count].Parent:=ListBox2; end; procedure TForm1.CornerButton13Click(Sender: TObject); begin if Length(Memo2.Text)>=15 then begin ShowMessage('Ваше сообщение отправлено!'); Memo2.Lines.Clear; TabControl1.TabIndex:=0; end else begin ShowMessage('Сообщение не менне 15 символов.'); Memo2.SetFocus; end; end; procedure TForm1.CornerButton1Click(Sender: TObject); begin if Edit1.Text='' then Begin ShowMessage('Укажите и номер счета и дату !'); Edit1.SetFocus; End else Begin Text4.Text:='Подождите идет загрузка данных ...'; End; end; procedure TForm1.CornerButton2Click(Sender: TObject); begin TabControl1.TabIndex:=1; Edit1.SetFocus; end; procedure TForm1.CornerButton3Click(Sender: TObject); begin TabControl1.TabIndex:=2; end; procedure TForm1.CornerButton5Click(Sender: TObject); begin TabControl1.TabIndex:=3; Memo2.SetFocus; end; procedure TForm1.CornerButton6Click(Sender: TObject); begin TabControl1.TabIndex:=4; end; procedure TForm1.CornerButton7Click(Sender: TObject); begin TabControl1.TabIndex:=0; end; procedure TForm1.Edit1Change(Sender: TObject); begin DateEdit2.SetFocus; end; procedure TForm1.FormCreate(Sender: TObject); begin ListBox1.Visible:=false; TabControl1.TabPosition:=ttabposition.None; TabControl1.TabIndex:=0; Text8.Text:= '+7 (812) 460-90-07'+#13+ '+7 (812) 460-90-08'+#13+ '+7 (812) 460-90-09'+#13+ #13+ 'Офис:'+#13+ #13+ 'Санкт-Петербург, г. Колпино, ул. Загородная, д. 44'+#13+ #13+ 'Производство и склад:'+#13+ #13+ 'Дорога на Петрославянку д. 3'+#13+ #13+ #13+ 'Режим работы: 09:00 - 17:30'+#13+ 'Обед: 13:00 - 13:40'+#13+ #13+ 'Выходные: Суббота, Воскресенье'+#13+ #13+ 'Тел.: 700-6024, 700-3242'; end; procedure TForm1.Timer1Timer(Sender: TObject); begin If (Glyph1.ImageIndex+1)<ImageList2.Count then Glyph1.ImageIndex:=Glyph1.ImageIndex+1 else Glyph1.ImageIndex:=0; end; procedure TForm1.CornerButton9Click(Sender: TObject); begin if not(indi.Visible) then Begin Form1.indi.Visible:=true; Form1.indi.Enabled:=true; Form1.Text6.Text:='Подождите идет загрузка данных, это может занять пару минут.'; Form1.Combobox1.Clear; Form1.Listbox1.Clear; Form1.Listbox2.Clear; cl:=bar.Create(false); end; end; { bar } procedure bar.Execute; var s,tgs:string; item:TListBoxItem; net:TNetHTTPClient; mm:tmemo; begin mm:=tmemo.Create(nil); net:=tnethttpclient.Create(nil); Ss:=TStringStream.Create('', TEncoding.UTF8); net.Get('https://www.gector-spb.ru/catalog/',ss); mm.text:=ss.DataString; while (mm.Lines.Count<>0) do begin if pos('class="catalog"',mm.Lines[0])>0 then begin while (mm.Lines.Count<>0) do begin if pos('div class="header"',mm.Lines[0])>0 then begin mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('>',s)); s:=copy(s,0,pos('<',s)-1); tgs:=s; Form1.ComboBox1.Items.Add(s); while (mm.Lines.Count<>0)and(pos('</table>',mm.Lines[0])=0) do begin if pos('tr class="cell item',mm.Lines[0])>0 then begin Form1.ListBox1.BeginUpdate; Item:=TListBoxItem.Create(Form1.ListBox1); Item.StyleLookup:='listboxitembottomdetail'; Item.Height:=40; item.TagString:=tgs; Item.TextSettings.WordWrap:=true; mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('a name=',s)); delete(s,1,pos('>',s)); s:=copy(s,1,pos('</a>',s)-1); if s=' ' then begin mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('</a>',s)+3); s:=copy(s,1,pos('</td>',s)-1); end; Item.Text:=s; mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('<strong>',s)+7); s:=copy(s,1,pos('</strong>',s)-1); item.ItemData.Detail:='остаток: '+s+'тн'; mm.Lines.Delete(0); s:=mm.Lines[0]; delete(s,1,pos('>',s)); s:=copy(s,1,pos('</td>',s)-1); item.ItemData.Detail:=item.ItemData.Detail+' цена: '+s+'руб\тн'; Form1.ListBox1.AddObject(item); Form1.ListBox1.EndUpdate; end; mm.Lines.Delete(0); end; end; mm.Lines.Delete(0); end; end; if mm.Lines.Count<>0 then mm.Lines.Delete(0); end; ss.Destroy; net.Destroy; mm.Destroy; Form1.indi.Visible:=false; Form1.indi.Enabled:=false; Form1.Text6.Text:='Загрузка данных завершена.'; terminate; Form1.ComboBox1.ItemIndex:=0; cl.Free; end; end.

меню:

Здравствуйте! Прошу принять и расценить заказ на написание приложения для фирмы для всех смартфонов (ANDROID, IOS) Пример в приложении, делал сам, вышло не красиво Для начала две задачи: 1. Загрузка каталога с сайта (примере в приложении работает на WINDOWS, на ANDROID один раз сработало а так зависает) 2. Загрузка статуса заказа (в примере не реализовано) на сайте это выглядит так: Требуется рабочее приложение (без глюков и тормозов) и сам код для моего изучения. 89817514818 Александр (СПб) sashar333@mail.ru Заранее спасибо! ГЕКТОРсчет.7z

ВСЕ ЗАРАБОТАЛО!!!! файлы libcrypto.so и libssl добавил не в тот deployment вариант: рабочий! Всем большое спасибо!

в общем получилось на другом компе подключить телефон и запустить отладку через делфи при прохождении пишет Project1.apk raised excepyion class EidOSSLCoulNotLoadSSLlibrary with message "Could not load SSL library" и останавливается в idSSLOpenSSl тут: constructor TIdSSLContext.Create; begin inherited Create; //an exception here probably means that you are using the wrong version //of the openssl libraries. refer to comments at the top of this file. if not LoadOpenSSLLibrary then begin raise EIdOSSLCouldNotLoadSSLLibrary.Create(RSOSSLCouldNotLoadSSLLibrary); end; fVerifyMode := []; fMode := sslmUnassigned; fSessionId := 1; end; я так понял проблема в файлах libcrypto.so и libssl может есть у кого подсказка где правильные скачать или как их подобрать? спасибо

не ужели нет других вариантов кроме как ломать телефон?

это слишком сложно для меня там проблемы с драйвером, не хочет подключаться телефон разные usb драйвера пробовал ни в какую