VPF::Threads - Форум программистов

Barovskiy

Дата 16.1.2006, 17:24 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 15.1.2006

Репутация: нет
Всего: нет

Пожалуйста, кто по умнее меня приведите прример по моему примеру....
плиззззззззз.......
совсем уже башню сносит smile

как сделать поток нормальным способом а не через ... как у меня ...
и чтоб можно было задавать определенное количество потоков .....
хотябы внутри программы ...
от и до если можно .... самые главные определяющие места .....
Пожалуйста...

В аналогичных примерах я поглядел, но так и не понял как все этоприменить к моему примеру smile

Демо

Дата 16.1.2006, 17:24 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

Barovskiy

Т.е., судя по коду, ты хочешь просто получить имя компьютера из DNS, неважно, включен он или нет?

--------------------

Barovskiy

Дата 16.1.2006, 17:35 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 15.1.2006

Репутация: нет
Всего: нет

Цитата(Демо @ 16.1.2006, 17:24

)

Barovskiy

Т.е., судя по коду, ты хочешь просто получить имя компьютера из DNS, неважно, включен он или нет?

что-то типа того, но включен он илинет этоне важно, ответ просто пустой....

Alexeis

Дата 16.1.2006, 17:40 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Код



простой пример работы с потоками

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls;

type
  TMainForm = class(TForm)
    Button1: TButton;
    ListBox1: TListBox;
    procedure Button1Click(Sender: TObject);
  private
    procedure ThreadsDone(Sender: TObject);
  end;

  TFooThread = class(TThread)
  protected
    procedure Execute; override;
  end;

var
  MainForm: TMainForm;

implementation

{$R *.DFM}

const
  MaxSize = 128;

var
  NextNumber: Integer = 0;
  DoneFlags: Integer = 0;
  GlobalArray: array[1..MaxSize] of Integer;

function GetNextNumber: Integer;
begin
  Result := NextNumber; // return global var
  Inc(NextNumber); // inc global var
end;

procedure TFooThread.Execute; //здесь главное действо
var
  i: Integer;
begin
  OnTerminate := MainForm.ThreadsDone;
  for i := 1 to MaxSize do
  begin
    GlobalArray[i] := GetNextNumber; // set array element
    Sleep(5); // let thread intertwine
  end;
end;

procedure TMainForm.ThreadsDone(Sender: TObject);
var
  i: Integer;
begin
  Inc(DoneFlags);
  if DoneFlags = 2 then // make sure both threads finished
    for i := 1 to MaxSize do
      { fill listbox with array contents }
      Listbox1.Items.Add(IntToStr(GlobalArray[i]));
end;

procedure TMainForm.Button1Click(Sender: TObject);
begin
  TFooThread.Create(False); // create threads
  TFooThread.Create(False);
end;

end.

--------------------

Vit вечная память.

Обсуждение действий администрации форума производятся только в этом форуме

гениальность идеи состоит в том, что ее невозможно придумать

Barovskiy

Дата 16.1.2006, 17:49 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 15.1.2006

Репутация: нет
Всего: нет

alexeis1

Танкс за пример!!!!
Я сейчас заного попробую....
свои действия мне вставлять сюда ???

Код


procedure TFooThread.Execute; //здесь главное действо
var
  i: Integer;
begin
  OnTerminate := MainForm.ThreadsDone;
  for i := 1 to MaxSize do
  begin
{
    ВОТ Здесь???????? 


  }
  GlobalArray[i] := GetNextNumber; // set array element
    Sleep(5); // let thread intertwine
  end;
end;

а как настчет VCL компонентов??? итли мне сделать принадлежность каждого компонента????

Albinos_x

Дата 16.1.2006, 17:58 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

Цитата(Barovskiy @ 16.1.2006, 17:49

)

свои действия мне вставлять сюда ???

да...

Цитата(Barovskiy @ 16.1.2006, 17:49

)

а как настчет VCL компонентов??? итли мне сделать принадлежность каждого компонента????

через синхронизацию работать с ними...

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Barovskiy

Дата 16.1.2006, 18:09 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 15.1.2006

Репутация: нет
Всего: нет

Albinos_x

Цитата(Albinos_x @ 16.1.2006, 17:58

)

свои действия мне вставлять сюда ???

да...

Поставил... не работает .... запускается, начинается проверка и все.... smile

В лог записано Allready connect

буду пробовать .... может получится.... ((((

Albinos_x

Дата 16.1.2006, 18:16 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

Цитата(Barovskiy @ 16.1.2006, 18:09

)

Поставил... не работает .... запускается, начинается проверка и все....
В лог записано Allready connect

буду пробовать .... может получится.... ((((

у тебя практически все действия с компанентами... так что надо вызывать твои процедуры через метод Synchronize(...);

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

Alexeis

Дата 16.1.2006, 18:22 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Действия лучше вставлять чуть ниже после первого end;

а вот синхронизация

Код


unit Unit2;

interface

uses
  Classes;

type
  TMyThread = class(TThread) //Новый класс
  private
    answer: Integer;
  protected
    procedure ShowResult;
    procedure Execute; override;
  end;

implementation

uses
  SysUtils, Unit1;

//Процедура для вывода информации из потока
procedure TMyThread.ShowResult;
begin
  Form1.Edit1.Text := IntToStr(answer);
end;

//Длинная процедура
procedure TMyThread.Execute;
var
  i: Integer;
begin
  for i := 1 to 10000 do
  begin
    answer := answer + 1;
    Synchronize(ShowResult);
  end;
end;

end.

--------------------

Демо

Дата 16.1.2006, 21:00 (ссылка)

(нет голосов)

Загрузка ...

Эксперт

Профиль
Группа: Завсегдатай
Сообщений: 1278
Регистрация: 3.11.2005

Репутация: 30
Всего: 50

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

Модуль с потоком

Код


unit uThrHostNames;

interface

uses
  Windows, Messages, SysUtils,WinSock;

type

  PMsgThr=^TMsgThr;
  TMsgThr=record
    Addr: String;
    HostName: String;
    Handle: THandle;
    ThrHandle: THandle;
    MsgThr: Cardinal;
  end;

procedure AddJob(Addr: String;
      Handle: THandle;
      MsgThr: Cardinal);

implementation


function IPAddrToName(IPAddr : string): string;
var
  SockAddrIn: TSockAddrIn;
  HostEnt: PHostEnt;
  WSAData: TWSAData;
begin
  Result:='';
  if WSAStartup($101, WSAData)<>0 then Exit;
  try
    SockAddrIn.sin_addr.s_addr:= inet_addr(PChar(IPAddr));
    HostEnt:= gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
    if HostEnt <> nil then Result := StrPas(Hostent^.h_name);
  finally
    WSACleanup;
  end;
end;

procedure ThrProc(P: Pointer);
var
  Rec: PMsgThr;
  Result: Integer;
begin
  Rec := P;
  Result := 0;
  try
    try
      Rec^.HostName := IPAddrToName(Rec^.Addr);
    except
      Result := -1;
    end;
    if Rec^.HostName='' then Result := -1;
  finally
    SendMessage(Rec^.Handle,Rec^.MsgThr,Integer(P),Result);
    CloseHandle(Rec^.ThrHandle);
    Dispose(Rec);
  end;
end;

procedure AddJob(Addr: String;
      Handle: THandle;
      MsgThr: Cardinal);
var
  P: PMsgThr;
  ThrId: THandle;
begin
  New(P);
  P^.Addr := Addr;
  P^.HostName := '';
  P^.Handle := Handle;
  P^.MsgThr := MsgThr;
  P^.ThrHandle := BeginThread(nil,0,@ThrProc,P,0,ThrId);
end;


end.

Пример использования

Код


unit ufMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection,
  IdTCPClient, IdHTTP,Winsock;

type

  TForm1 = class(TForm)
    Button1: TButton;
    IdHTTP1: TIdHTTP;
    Memo1: TMemo;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure OnMsg(var Msg: TMEssage);
  end;

var
  Form1: TForm1;
  MsgThr: Cardinal;

implementation

uses uThrHostNames;

{$R *.dfm}

procedure TForm1.Button1Click(Sender: TObject);
var
  i: Integer;
begin
  for i := 1 to 255 do
  begin
    Addjob('194.87.63.'+IntToStr(i),Handle,MsgThr);
  end;
end;

procedure TForm1.OnMsg(var Msg: TMEssage);
var
  P: PMsgThr;
  s: String;
begin
  if Msg.Msg = MsgThr then
  begin
    s := '';
    P := Pointer(Msg.WParam);
    if Msg.LParam=0
      then s := P^.Addr+'-->'+P^.HostName
      else s := P^.Addr+' - ошибка';
    Memo1.Lines.Add(s);
 end
 else WndProc(Msg);
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
  WindowProc := OnMsg;
end;

initialization
  MsgThr := RegisterWindowMessage(PChar(IntToStr(HInstance)));
end.

Это сообщение отредактировал(а) Демо - 16.1.2006, 21:01

--------------------

Barovskiy

Дата 17.1.2006, 01:20 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 15.1.2006

Репутация: нет
Всего: нет

alexeis1

На твоем примере вродебы как получилось - НО
он прверяет один и тот же адрес два раза, примеру если у меня в локалке 100 адрессов, то он пишет что их 200
а потом один и тотоже проверяет два раза...
а не каждый поток следующий адрес....
Добавлено @ 01:24
и после вырубления проги все равно вылетает ошибка.....

Может вовсе не надо делать эти потоки.. у мен якрыша уже едит ... может хотябы сделать так чтоб прога ошибку не выплевывала.....
Добавлено @ 01:31

Демо

Цитата(Демо @ 16.1.2006, 21:00

)

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

Большое спасибо за пример!!!!!
а можно ли чтонибудь попробовать именно через мой пример???
Просто твой не много не подходит ...
я бы хотел его потом еще приминить в другие примеры
чтоб просто поменять внутренности цикла и прога готова для другово :-)
что скажешь ??? можешь помочь накидать пример , просто с пустым циклом выполнения...

тогда поток будет универсален практически для всего ..... и для использования VCL и для внутреннего создание компонентов....
мне кажется это вариант хороший.... иметь заготовку куда просто можно впихнуть действия

Barovskiy

Дата 17.1.2006, 01:44 (ссылка)

(нет голосов)

Загрузка ...

Шустрый

Профиль
Группа: Участник
Сообщений: 50
Регистрация: 15.1.2006

Репутация: нет
Всего: нет

не для конкретной проверки IP адресов, а вообще, для всего где может понадобиться потоки ...
даже не знаю что можно придумать, - все что угодно,

Что скажите, мастера????

Alexeis

Дата 17.1.2006, 10:12 (ссылка)

(нет голосов)

Загрузка ...

Амеба

Профиль
Группа: Админ
Сообщений: 11743
Регистрация: 12.10.2005
Где: Зеленоград

Репутация: 109
Всего: 459

Barovskiy приведи текст ошибки smile

Добавлено @ 10:13
Может ошибка не в потоке smile

--------------------

Guedda

Дата 17.1.2006, 10:22 (ссылка)

(нет голосов)

Загрузка ...

Подрывник

Профиль
Группа: Завсегдатай
Сообщений: 3137
Регистрация: 27.12.2005
Где: Ростов-на-Дону

Репутация: 14
Всего: 78

Может ты в потоке вызываешь MessageDlg or ShowMessage?
Опиши подробнее ошибку.

--------------------

Ll 2

Albinos_x

Дата 17.1.2006, 10:27 (ссылка)

(нет голосов)

Загрузка ...

Evil Skynet

Профиль
Группа: Комодератор
Сообщений: 3288
Регистрация: 28.5.2004
Где: X-6120400 Y-1 4624650

Репутация: 26
Всего: 108

OnClose
или
OnDestroy
обрабатываешь?

Цитата(alexeis1 @ 17.1.2006, 10:12

)

Может ошибка не в потоке

у меня такое же ощущение... возможно неправильно где-то ещё выделяет память или освобождает...

--------------------

"Кто владеет информацией, тот владеет миром"
Уинстон Черчилль

0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема \| Delphi: Общие вопросы \| Следующая тема »