Цикл внутри цикла. дождаться ответа.

Shouldercannon · 24.07.2015

Доброго времени суток!
Есть три ссылки и две учётные записи. Сама задача:
В цикле берём данные первого аккаунта и далее во вложенном цикле идём по ссылкам:
Пока мы идём по ссылка цикл по аккаунтам "остановлен"
1. загружаем стартовую страницу
2. дожидаемся загрузки, вводим регистрационные данные, авторизуемся
3. загружаем страницу магазина
4. дожидаемся загрузки, нажимаем кнопку
5. загружаем страницу выхода
6. дожидаемся загрузки и переходим к следующему аккаунту
Получилась вот такая жесть

Код:

unit frm_Main;
...
type
  TAccounts = Record
	Login: String;
	Password: String;
  end;
 
 
 
 
type
  TURLs = Record
	URL: String;
  end;
 
 
 
 
var
  FormMain: TFormMain;
  HTMLSource: String;
  ITimerGetTimeInterval, IMas: Integer;
  LoadComplete: Boolean;
  Accounts: Array[0..1] of TAccounts;
  URLs: Array[0..2] of TURLs;
 
 
 
 
implementation
 
 
 
 
{$R *.dfm}
...
procedure TFormMain.FormCreate(Sender: TObject);
begin
  Accounts[0].Login := 'login1';
  Accounts[0].Password := 'pass1';
  Accounts[1].Login := 'login2';
  Accounts[1].Password := 'pass2';
 
 
 
 
  URLs[0].URL := 'http://localhost';
  URLs[1].URL := 'http://localhost/account/market';
  URLs[2].URL := 'http://localhost/account/exit';
end;
 
 
 
 
procedure TFormMain.PBBGetSilverClick(Sender: TObject);
var
  I, I2: Integer;
  Flags: OleVariant;
begin
  I := 0;
  IMas := I;
 
 
 
 
  LoadComplete := True;
 
 
 
 
  while I <> Length(Accounts) do
  begin
	I2 := 0;
 
 
 
 
	while I2 <> Length(URLs) do
	begin
	  if LoadComplete then
	  begin
		LoadComplete := False;
		// Загружаем страницу
		WebBrowser1.Navigate(URLs[I2].URL);
		Application.ProcessMessages;
		Inc(I2);
	  end
	  else Application.ProcessMessages;
	end;
 
 
 
 
	Application.ProcessMessages;
	Inc(I);
	IMas := I;
  end;
end;
 
 
 
 
procedure TFormMain.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
var
  I, I2: Integer;
  Form: OleVariant;
begin
  if URL = WebBrowser1.LocationURL then
  begin
	// Исходный код страницы
	HTMLSource := WB_GetHTMLCode(WebBrowser1);
	// Заполняем поля на главной странице и авторизовываемся
	if Pos('Welcome', HTMLSource) > 0 then
	begin
	  for I := 0 to WebBrowser1.OleObject.Document.Forms.Length - 1 do
	  begin
		Form := WebBrowser1.OleObject.Document.Forms.Item(I).elements;
 
 
 
 
		for I2 := 0 to Form.Length - 1 do
		begin
		  if Form.Item(I2).name = 'log_email' then Form.Item(I2).value := Accounts[IMas].Login
		  else if Form.Item(I2).name = 'pass' then Form.Item(I2).value := Accounts[IMas].Password;
		end;
		// Авторизация
		for I2 := 0 to Form.Length - 1 do
		begin
		  if ((Form.Item(I2).type = 'submit') and (Form.Item(I2).value = 'Войти')) then
		  begin
			Form.Item(I2).Click;
		  end;
		end;
	  end;
	end;
	// Заходим на склад и продаём
	if Pos('Магазин', HTMLSource) > 0 then
	begin
	  for I := 0 to WebBrowser1.OleObject.Document.Forms.Length - 1 do
	  begin
		Form := WebBrowser1.OleObject.Document.Forms.Item(I).elements;
 
 
 
 
		for I2 := 0 to Form.Length - 1 do
		begin
		  if ((Form.Item(I2).type = 'submit') and (Form.Item(I2).name = 'sell')) then
		  begin
			Form.Item(I2).Click;
		  end;
		end;
	  end;
	end;
 
 
 
 
	LoadComplete := True;
  end;
end;

Всё бы может ничего, только вот WebBrowser1DocumentComplete под конец уходит в бесконечный цикл + каким-то образом при Accounts[IMas].Login, где IMas = 2 выдирается первая запись из массива с ссылками. IMas - это переменная, которая держит число, с которым мы обращаемся к массиву с аккаунтами, максимум может быть = 1.

rrrFer · 25.07.2015

Сформулируй нормально проблему. На русском языке, цитата ниже мне не понятна. Что за "ссылка цикл"?

Пока мы идём по ссылка цикл по аккаунтам "остановлен"

Откуда берется "цикл по аккаунтам", если "в цикле ты берешь только данные первого аккаунта"?
Цикл не может быть "остановлен". Остановлен может быть поток, например, но я никаких потоков в твоем коде не заметил. У тебя тут всего один поток, поэтому до тех пор пока первая итерация цикла не завершится - вторая не начнет выполняться. Независимо от задачи, которую ты решаешь.

Если нужна более конкретная помощь - описывай нормально проблему.

Shouldercannon · 25.07.2015

Схематично это выглядит так

rrrFer · 26.07.2015

Теперь к проблеме:

Всё бы может ничего, только вот WebBrowser1DocumentComplete под конец уходит в бесконечный цикл + каким-то образом при Accounts[IMas].Login, где IMas = 2 выдирается первая запись из массива с ссылками. IMas - это переменная, которая держит число, с которым мы обращаемся к массиву с аккаунтами, максимум может быть = 1.

Ты умеешь пользоваться отладчиком? - посмотри по шагам что происходит в программе и почему она так работает.

Я бы для начала вообще убрал переменную IMas, т.к. ее значение во всех использованиях совпадает со значением переменной I.

Ну а так, не важно почему там "выдирается первая запись", важно, что при Imas=2 внешний цикл должен завершиться, надо просто взять отладчик и посмотреть почему это не происходит. Т.е. вот на эту строчку:

while I <> Length(Accounts) do

Посмотреть при этом чему равен Length(Accounts).

Shouldercannon · 26.07.2015

Код:

Length(Accounts)

Всё время равен 2
Программа зацикливается в этом месте

Код:

procedure TFormMain.WebBrowser1DocumentComplete(ASender: TObject;
const pDisp: IDispatch; const URL: OleVariant);

По хорошему в этой процедуре только фиксировать полную загрузку страницы и ничего не делать.
Так стало лучше

Код:

procedure TFormMain.FormCreate(Sender: TObject);
begin
  Accounts[0].Login := 'login1';
  Accounts[0].Password := 'pass1';
  Accounts[1].Login := 'login2';
  Accounts[1].Password := 'pass2';
 
 
 
 
  URLs[0].URL := 'http://localhost'; // Разминочная
  URLs[1].URL := 'http://localhost'; // Главная
  URLs[2].URL := 'http://localhost/account/market'; // Магазин
  URLs[3].URL := 'http://localhost/account/exit'; // Выход
end;
 
 
 
 
procedure TFormMain.PBBGetSilverClick(Sender: TObject);
var
  I, I2, I3, I4: Integer;
  Form, Flags: OleVariant;
begin
  I := 0;
  Flags := 4; // Не загружать страницу из кэша
 
 
 
 
  LoadComplete := True;
 
 
 
 
  while I <> Length(Accounts) do
  begin
	I2 := 0;
 
 
 
 
	while I2 <> Length(URLs) do
	begin
	  if LoadComplete then
	  begin
		LoadComplete := False;
		// Загружаем страницу
		WebBrowser1.Navigate(URLs[I2].URL, Flags);
		// Исходный код страницы
		HTMLSource := WB_GetHTMLCode(WebBrowser1);
		// Заполняем поля на главной странице и авторизовываемся
		if Pos('Welcome', HTMLSource) > 0 then
		begin
		  // Заполнение полей
		  for I3 := 0 to WebBrowser1.OleObject.Document.Forms.Length - 1 do
		  begin
			Form := WebBrowser1.OleObject.Document.Forms.Item(I3).elements;
 
 
 
 
			for I4 := 0 to Form.Length - 1 do
			begin
			  if Form.Item(I4).name = 'log_email' then Form.Item(I4).value := Accounts[I].Login
			  else if Form.Item(I4).name = 'pass' then Form.Item(I4).value := Accounts[I].Password;
			end;
		  end;
		  // Авторизация
		  for I3 := 0 to WebBrowser1.OleObject.Document.Forms.Length - 1 do
		  begin
			Form := WebBrowser1.OleObject.Document.Forms.Item(I3).elements;
 
 
 
 
			for I4 := 0 to Form.Length - 1 do
			begin
			  if ((Form.Item(I4).type = 'submit') and (Form.Item(I4).value = 'Войти')) then Form.Item(I4).Click;
			end;
		  end;
		end;
		// Заходим на склад и продаём
		if Pos('Магазин', HTMLSource) > 0 then
		begin
		  for I3 := 0 to WebBrowser1.OleObject.Document.Forms.Length - 1 do
		  begin
			Form := WebBrowser1.OleObject.Document.Forms.Item(I3).elements;
 
 
 
 
			for I4 := 0 to Form.Length - 1 do
			begin
			  if ((Form.Item(I4).type = 'submit') and (Form.Item(I4).name = 'sell')) then Form.Item(I4).Click;
			end;
		  end;
		end;
 
 
 
 
		Sleep(2000);
		Application.ProcessMessages;
		Inc(I2);
	  end
	  else Application.ProcessMessages;
	end;
 
 
 
 
	Application.ProcessMessages;
	Inc(I);
  end;
end;
 
 
 
 
procedure TFormMain.WebBrowser1DocumentComplete(ASender: TObject;
  const pDisp: IDispatch; const URL: OleVariant);
begin
  if URL = WebBrowser1.LocationURL then LoadComplete := True;
end;

rrrFer · 26.07.2015

Так проблема решилась?

Shouldercannon · 26.07.2015

На данный момент да

Все сервисы Codeby

Поиск

Поиск

Цикл внутри цикла. дождаться ответа.

Shouldercannon

rrrFer

Shouldercannon

Вложения

rrrFer

Shouldercannon

rrrFer

Shouldercannon