Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Компоненты Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 10.02.2013, 22:22   #1
voverrr
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 62
По умолчанию Как сделать динамическое последовательное создание окон

Здравствуйте.
есть таблица(sg1), в ячейках у неё содержатся веб-адреса.
всего в таблице 30 строк, 1 столбец, а ссылок бывает разное количество. иногда не бывает вовсе. Ссылки помещаются в таблицу перед этим куском кода.
Необходимо создать окно с браузером, в котором откроется ссылка из первой строки таблицы, повисит 1 минуту, закроется. Затем откроется следующее окно, со ссылкой из второй строки, повисит 1 минуту и закроется ну и так далее.
Код:

procedure fmclose(Sender: TObject);
........
   //////////////////////////////////////////////////
		//  проверяем таблицу на наличие ссылок и     ///
		/// создаём окно, в котором открывается ссылка////
		//////////////////////////////////////////////////

							for F:=0 to 29 do

						begin
							if (sg1.cells[0,F]<>'') then
										 //проверяем: если текст в строке не пустой, то запускаем

							begin
										 url:=sg1.cells[0,F];     // назначем текст из строки в качестве ссылки
										 fm:=TForm.Create(nil);    //создаём дмнамическую форму
										 with fm do
								begin
											 BorderIcons:=[biSystemMenu];
											 Caption:= idmessage1.Subject;
											 left:=100+(F*100);
											 top:=100;
											 Height:=400;
											 Width:=400;
											 ShowWindow(fm.Handle, SW_SHOW);
								end;
										 wb:= TWebBrowser.Create(fm);       // создаём на этой форме динамический веббраузер
										 fm.InsertControl(wb);
										 with (wb) do
								begin
											 ParentWindow := fm.Handle;
											 Width := fm.Width;
											 Height := fm.Height;
											 Silent:=True;
											 Navigate(url);
											 ShowWindow(wb.Handle, SW_SHOW);
								 end;


												tm := TTimer.Create(fm);    //создаём таймер
										 with (tm) do
								begin                                //и работает он как-то неправильно.
											 Name := 'TM' + IntToStr(F);
											 Interval := 60000;
											 OnTimer:=fmclose;
											 Enabled := True;
								end;


							end;
						end;

procedure tform1.fmclose; //закрываем окно по истечении таймера
begin
	fm.free;
	fm.Close;
end;
окна создаёт, браузеры создаёт, но вот когда дело доходит до таймера, оно открывает сразу пять окошек(например, в таблице пять ссылок), и они висят 1 минуту все сразу, а не по очереди.
Sleep не подходит, потому что он останавливает всю программу на 60 секунд, и в браузерах в это время ничего не грузится.
Окна нужно открывать одно после закрытия другого. а не все сразу.

Последний раз редактировалось Stilet; 10.02.2013 в 23:05.
voverrr вне форума Ответить с цитированием
Старый 13.02.2013, 21:20   #2
Sergio_O
Пользователь
 
Регистрация: 03.11.2010
Сообщений: 15
По умолчанию

Переделай в динамике и под TWebBrowser

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, cefvcl, ceflib;

type
  TForm1 = class(TForm)
    Chromium1: TChromium;
    Timer1: TTimer;
    procedure FormCreate(Sender: TObject);
    procedure Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser;
      const frame: ICefFrame; httpStatusCode: Integer; out Result: Boolean);
    procedure Timer1Timer(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  Links: TStringList;

implementation

{$R *.dfm}

procedure TForm1.Chromium1LoadEnd(Sender: TObject; const browser: ICefBrowser;
  const frame: ICefFrame; httpStatusCode: Integer; out Result: Boolean);
begin
  //Некоторые страницы вызывают LoadEnd несколько раз, так что перезапускаем таймер
  Timer1.Enabled:= false;
  Timer1.Enabled:= true;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  Links:= TStringList.Create();
  Links.Add('programmersforum.ru');
  Links.Add('ya.ru');
  Links.Add('mail.ru');
  Links.Add('facebook.com');
  Links.Add('nnm-club.ru');
  Chromium1.Browser.MainFrame.LoadUrl(Links.Strings[0]);
  Links.Delete(0);
  Timer1.Interval:= 60000;
  Timer1.Enabled:= true;
end;

procedure TForm1.Timer1Timer(Sender: TObject);
begin
  //Если мы тут значит ПОЛНОСТЬЮ загруженная страница повисела минуту
  if Links.Count <> 0 then
  begin
    Chromium1.Browser.MainFrame.LoadUrl(Links.Strings[0]);
    Links.Delete(0);
  end
  else
    Close;
end;

end.
Sergio_O вне форума Ответить с цитированием
Старый 13.02.2013, 21:24   #3
Sergio_O
Пользователь
 
Регистрация: 03.11.2010
Сообщений: 15
По умолчанию

А нафиг вообще в динамике это делать?
Sergio_O вне форума Ответить с цитированием
Старый 15.02.2013, 19:02   #4
voverrr
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 62
По умолчанию

а вот из-за этой неизвестности, сколько ссылок будет в таблице. Вот и создаю этих окошек ровно столько, сколько нужно, не больше не меньше.
По идее второе окошко может быть и не динамическим, и браузеры создавать можно в нём, но получается, что браузеры всё равно должны быть динамическими.

Спасибо тебе за вариант. Пока эта тема висела, я уже худо-бедно накарябал какой-то вариант, но у тебя оно описано гораздо грациознее, чем я дотумкал.

Вот какая есть проблема ещё. Пока я отлаживаю эту показывалку с динамическими окнами, мне понадобилось откуда-то брать списки адресов, ну, чтобы было чего открывать в этих окошках.
Написал программку для генерации списка адресов,типа
http://sgxcio.com
http://hkoxod.com
http://rkmzpg.com
или
www.shaiyu.com
www.hcoize.com
www.cvlglw.com
генерирует, отправляет на почту. Из почты она вставляет в таблицу и открывает в окошках.
Списки этих сгенерированных адресов состоят из случайного набора букв(я задал длину адреса в шесть букв). Понятно, что какие-то сайты будут недоступны, не в этом суть, главное чтобы браузеры что-то получали в пищу.
Вот в чём проблема. Когда он скачивает в таблицу ссылки из какого-нибудь письма, из спамного, например, то он распознаёт эти адреса и открывает как положено.
А вот когда доходит дело до открывания ссылок вот этих, сгенерированных, он их не распознаёт. Соответственно, определяет письмо, как не содержащее адресов.
распознаю ссылки вот так:

Код:
for i:=0 to sg1.RowCount-1 do        //чистим таблицу перед добавлением в неё нового списка ссылок
					 SG1.Cells[0,i]:='';

							urlstr:=0;
							i := posex('http://', mm.Text);
							while i <> 0 do
					 begin
							j := i+7;
							while not(mm.Text[j] in [#10, #13,' ', '''', '"', '>','<','<','"',' ']) do
							inc(j,1);//тут перечисляем признаки конца домена
							st := copy(mm.Text, i, j-i);
							sg1.Cells[0,urlstr] := st;//в таблицу добавляем
							Inc(urlstr,1);
							i := posex('http://', Mm.Text, i+1);
					 end;
mm - динамическое мемо, в которое я предварительно загружаю тело письма.
sg1-таблица, в которой размещаются ссылки

я думал, что это зависит от ящика - рамблеровский, мейлрушечный - нет, не зависит. письма приходят и туда и туда, в тексте письма эти адреса выделяются синим как ссылки, при переходах по ним какие-то сайты открываются, какие-то не существуют, всё как положено.
А вот когда распознаю их в своей таблице - не распознаются.

Последний раз редактировалось voverrr; 15.02.2013 в 19:39.
voverrr вне форума Ответить с цитированием
Старый 15.02.2013, 19:39   #5
voverrr
Пользователь
 
Регистрация: 25.08.2010
Сообщений: 62
По умолчанию

а сама программка-генерировалка вот:
Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
	Dialogs, OleCtrls, ComObj, ExtCtrls, StdCtrls, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdMessageClient,
  IdSMTPBase, IdSMTP, IdMessage;

type
  Tfrm1 = class(TForm)
    Button1: TButton;
    cbb1: TComboBox;
    cbb2: TComboBox;
    lbl1: TLabel;
    edt1: TEdit;
    idsmtp2: TIdSMTP;
    idmsg1: TIdMessage;
		procedure FormCreate(Sender: TObject);
    procedure Button1Click(Sender: TObject);

	private
    { Private declarations }
  public
    { Public declarations }
  end;

var
	frm1: Tfrm1;
	xl: variant;

implementation

{$R *.dfm}

procedure Tfrm1.Button1Click(Sender: TObject);
 //генерируем строки из случайных символов
var
mmo:Tmemo;
fmo:tform;
F,i,j:integer;
s,url : string;
begin
		for F:=1 to strtoint(edt1.text) do  //сколько писем нужно отправить
 begin
		fmo:=tform.create(nil);
		fmo.width:= 350;
		fmo.height:= 350;
		mmo:=tmemo.create(fmo);
		mmo.ParentWindow := fmo.Handle;
		mmo.Align:=alClient;
		mmo.width:=300;
		mmo.height:=300;
	begin
		for j := 1 to random(30) do       //до 30 адресов генерируется
	 begin
		 s := '';
		 for i:=1 to 6 do        //из скольких букв должен состоять адрес
		 begin
			s := s+chr (random( ord('z') - ord('a') + 1) + ord('a'));
		 end;
		 url:='http://'+s+'.com';     //прикручиваем http//. спереди  и .com сзади
		 mmo.lines.add (url);
		 Randomize;
	 end;
		 fmo.Show;
		/////начинаем отправлять сгенерированные адреса по назначению
		 xl := CreateOleObject('Excel.Application');
		 xl.Workbooks.Open('c:\Program files\hen\post_scaner_data.xls');
		 IdSMTP2.Host:= xl.Sheets[1].Cells[cbb1.ItemIndex+3, 5].text;// порты, логины и пароли берём из экселевского файла
		 IdSMTP2.Username:= xl.Sheets[1].Cells[cbb1.ItemIndex+3, 6].text;
		 IdSMTP2.Password:= xl.Sheets[1].Cells[cbb1.ItemIndex+3, 7].text;
		 IdSMTP2.connect; // соединяемся
		 if  idsmtp2.connected=true  then
	 begin
		 idmsg1.Subject:= 'spisok url'; //текст темы сообщения
		 idmsg1.Recipients.EMailAddresses:= cbb2.Text; //указываем адрес получателя
		 idmsg1.From.Address:= xl.Sheets[1].Cells[cbb1.ItemIndex+3, 10].text; //указываем адрес отправителя
		 idmsg1.Body.Text:= mmo.text; //размещаем текст сообщения
		 idmsg1.From.Name:= 'spamer'; // имя отправителя письма
		 IdSMTP2.Send(idmsg1); // отправляем
		 IdSMTP2.Disconnect; // разъединяем
	 end;
		 xl.quit;
		 xl := Unassigned;
	end;
	 fmo.close;fmo.free;
 end;
 ShowMessage('отправлено');
end;
									 //при создании формы добавляем в выпадающие списки адреса
procedure Tfrm1.FormCreate(Sender: TObject);
var
		i: integer;
begin
				 i:=3;
				 xl := CreateOleObject('Excel.Application');
				 xl.Workbooks.Open('c:\Program files\hen\post_scaner_data.xls');
				 repeat
				 cbb1.items.add(xl.Sheets[1].Cells[i, 10].text);
				 cbb2.items.add(xl.Sheets[1].Cells[i, 10].text);
				 i:=i+1;
				 until xl.Sheets[1].Cells[i, 10].text='';
				 xl.quit;
				 xl := Unassigned;
				 Randomize;
end;



end.
выглядит вот так:

Последний раз редактировалось voverrr; 15.02.2013 в 20:05.
voverrr вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц

Опции темы Поиск в этой теме
Поиск в этой теме:

Расширенный поиск


Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Как сделать UserForm не по верх окон and150382 Microsoft Office Excel 40 16.02.2013 20:40
Динамическое создание окон в Assembler Shamonya Assembler - Ассемблер (FASM, MASM, WASM, NASM, GoASM, Gas, RosAsm, HLA) и не рекомендуем TASM 0 12.04.2012 08:07
Как сделать так, чтобы форма была поверх всех окон? Jupiter Общие вопросы Delphi 9 31.07.2009 17:42
MediaPlayer - как сделать последовательное воспроизведение mp3 файлов (именно mp3) Kashp Компоненты Delphi 13 28.09.2007 08:38
Как динамически добавить Мемо на форму? Динамическое создание компонентов! werser Помощь студентам 1 14.06.2007 00:39