как можно создать такой класс?

← →
начинающий2 (2011-01-18 14:52) [0]

Как класс который создает поток на WinAPI
hThread:=BeginThread(Nil,0,Addr(ThreadProc),NewClass,CREATE_SUSPENDED,ConslThrId);
и в качестве параметра указывает себя, чтобы процедура потока WinApi ThreadProc затем по указателю обращалась к данным этого класса?

Заранее скажу класс TThread не планируется использовать, так же не используется модуль Classes, только windows.

← →
Игорь Шевченко © (2011-01-18 15:06) [1]

RTFS: Classes.TThread

← →
DiamondShark © (2011-01-18 15:08) [2]

> Заранее скажу класс TThread не планируется использовать,
> так же не используется модуль Classes, только windows.

*пожимая плечами*
Скопипасти класс TThread (исходники-то есть) и выкини всё, что требует ссылок на Classes.

*с ленинским прищуром*
А может вы, батенька, ещё и SysUtils, не планируете использовать?

← →
han_malign (2011-01-18 15:38) [3]

- нечестный, но работающий метод(хак):
type TNewClass = class(TOldClass) function ThreadProc: DWORD; stdcall; function start: boolean; hThread: Thandle; end; function TNewClass.ThreadProc: DWORD; begin //self is implicit parameter of ThreadProc passed over stack(because stdcall) ... end; function TNewClass.start: boolean; begin hThread:=BeginThread(Nil,0,Addr(TNewClass.ThreadProc),self,CREATE_SUSPENDED,ConslThrId); Result:= hThread <> 0; end;
- честный:
function ThreadProc(lpParameter: pointer): DWORD; stdcall; begin Result:= TNewClass(lpParameter).ThreadProc; end;

← →
начинающий2 (2011-01-18 15:57) [4]

> han_malign (18.01.11 15:38) [3]

почему "- нечестный"?

Кстати при TNewClass.Free созданный поток все равно работает если есть ему что делать.
Я так полагаю что и деструктор то же нужно делать чтобы прибить запущенный поток? А hThread нужно в десрукторе через CloseHandle закрывать или это делается само?

← →
начинающий2 (2011-01-19 00:02) [5]

> han_malign (18.01.11 15:38) [3]

Неработающий метод.
Доступа к данным класса то нету из самого потока т.е. function ThreadProc и function TNewClass.ThreadProc

← →
Servy © (2011-01-19 04:03) [6]

> Доступа к данным класса то нету из самого потока

Куда это он делся то?

← →
начинающий2 (2011-01-19 20:36) [7]

> han_malign (18.01.11 15:38) [3]

> Servy © (19.01.11 04:03) [6]

Да вот туда куда то и девается. Непонятно куда девается.
Вот модуль в котором все проблемы.
В потоке читается ID и отправляется отладчику
Что получает отладчик вместо 111 Thr := TNewClass.Create(111);
00000050 98.58939362 [3932] 2088810288 <- это говорит о том, что поток работает, но параметр ID не читается или не инициализирован. Но при трассировке через F7 я то вижу, что в классе параметр инициализирован как 111.

Unit NewClass; interface Uses Windows, SysUtils, dialogs; type TNewClass = class(TObject) hThread: Thandle; FID : Integer; ThrID : DWORD; function ThreadProc: DWORD; stdcall; function start: boolean; function Resume: Boolean; Constructor Create(ClassID: DWORD); reintroduce; Procedure SetID(Value: Integer); Property ID: Integer Read FID Write SetID; end; implementation Constructor TNewClass.Create(ClassID: DWORD); begin inherited Create; ID := ClassID; end; function TNewClass.ThreadProc: DWORD; var i: WORD; begin //self is implicit parameter of ThreadProc passed over stack(because stdcall) ShowMessage(IntToStr(ID)); for i:=1 to 100 do begin OutputDebugStringA(PChar(IntToStr(ID))); Sleep(100); end; end; function TNewClass.Resume: Boolean; begin ResumeThread(hThread); end; procedure TNewClass.SetID(Value: Integer); begin FID:=Value; end; Function ThreadProc(lpParameter: Pointer); stdcall; begin Result:=TNewClass(lpParameter).ThreadProc; end; function TNewClass.start: boolean; begin hThread:=BeginThread(Nil,0,Addr(TNewClass.ThreadProc),self,CREATE_SUSPENDED,ThrI d); Result:= hThread <> 0; Resume; end;

← →
Leonid Troyanovsky © (2011-01-19 22:34) [8]

> начинающий2 (19.01.11 20:36) [7]

Отметил несгибаемость:

> так же не используется модуль Classes

> Uses Windows, SysUtils, dialogs;

> function TNewClass.Resume: Boolean;

Тоже понравилась.
Как и

> hThread:=BeginThread(Nil,0,Addr(TNewClass.ThreadProc),self,
> CREATE_SUSPENDED,ThrI d);
> Result:= hThread <> 0;
> Resume;

Уважаемый, ты б почитал хоть чего-ни-ть про потоки.
stdcall.

--
Regards, LVT.

← →
DVM © (2011-01-19 22:39) [9]

> нечестный, но работающий метод(хак):

Нету нормального способа сделать метод класса функцией, которую можно было бы передать в WinAPI. Есть различные выкрутасы, которые даже могут быть работоспособны, пока не наткнутся на DEP, который прибьет сразу такое приложение. Если бы такая возможность была, то скажем TService и прочие классы, где это надо были бы организованы по другому.

← →
DVM © (2011-01-19 22:46) [10]

> начинающий2

не уверен что все ниже верно, неохота вникать, но как то так:
unit Threads; interface uses Windows; //////////////////////////////////////////////////////////////////////////////// // TThread //////////////////////////////////////////////////////////////////////////////// type TThreadMethod = procedure of object; TThreadPriority = (tpIdle, tpLowest, tpLower, tpNormal, tpHigher, tpHighest, tpTimeCritical); const Priorities: array [TThreadPriority] of Integer = (THREAD_PRIORITY_IDLE, THREAD_PRIORITY_LOWEST, THREAD_PRIORITY_BELOW_NORMAL, THREAD_PRIORITY_NORMAL, THREAD_PRIORITY_ABOVE_NORMAL, THREAD_PRIORITY_HIGHEST, THREAD_PRIORITY_TIME_CRITICAL); type TThread = class private FHandle: THandle; FThreadID: THandle; FTerminated: Boolean; FSuspended: Boolean; FFreeOnTerminate: Boolean; FFinished: Boolean; FReturnValue: DWORD; function GetPriority: TThreadPriority; procedure SetPriority(Value: TThreadPriority); procedure SetSuspended(Value: Boolean); protected procedure Execute; virtual; abstract; property ReturnValue: DWORD read FReturnValue write FReturnValue; property Terminated: Boolean read FTerminated; public constructor Create(CreateSuspended: Boolean); destructor Destroy; override; procedure Resume; procedure Suspend; procedure Terminate; procedure WaitFor; property FreeOnTerminate: Boolean read FFreeOnTerminate write FFreeOnTerminate; property Handle: THandle read FHandle; property Priority: TThreadPriority read GetPriority write SetPriority; property Suspended: Boolean read FSuspended write SetSuspended; property ThreadID: THandle read FThreadID; end; implementation //////////////////////////////////////////////////////////////////////////////// // TThread //////////////////////////////////////////////////////////////////////////////// function ThreadProc(Thread: TThread): DWORD; var FreeThread: Boolean; begin Thread.Execute; FreeThread := Thread.FFreeOnTerminate; Result := Thread.FReturnValue; Thread.FFinished := True; if FreeThread then Thread.Free; EndThread(Result); end; //------------------------------------------------------------------------------ constructor TThread.Create(CreateSuspended: Boolean); var Flags: DWORD; begin inherited Create; FSuspended := CreateSuspended; Flags := 0; if CreateSuspended then Flags := CREATE_SUSPENDED; FHandle := BeginThread(nil, 0, @ThreadProc, Pointer(Self), Flags, FThreadID); end; //------------------------------------------------------------------------------ destructor TThread.Destroy; begin if FHandle <> 0 then CloseHandle(FHandle); inherited Destroy; end; //------------------------------------------------------------------------------ function TThread.GetPriority: TThreadPriority; var P: Integer; I: TThreadPriority; begin P := GetThreadPriority(FHandle); Result := tpNormal; for I := Low(TThreadPriority) to High(TThreadPriority) do if Priorities[I] = P then Result := I; end; //------------------------------------------------------------------------------ procedure TThread.SetPriority(Value: TThreadPriority); begin SetThreadPriority(FHandle, Priorities[Value]); end; //------------------------------------------------------------------------------ procedure TThread.SetSuspended(Value: Boolean); begin if Value <> FSuspended then if Value then Suspend else Resume; end; //------------------------------------------------------------------------------ procedure TThread.Suspend; begin FSuspended := True; SuspendThread(FHandle); end; //------------------------------------------------------------------------------ procedure TThread.Resume; begin if ResumeThread(FHandle) = 1 then FSuspended := False; end; //------------------------------------------------------------------------------ procedure TThread.Terminate; begin FTerminated := True; end; //------------------------------------------------------------------------------ procedure TThread.WaitFor; begin WaitForSingleObject(FHandle, INFINITE); end; //------------------------------------------------------------------------------ end.

← →
Leonid Troyanovsky © (2011-01-19 22:47) [11]

> DVM © (19.01.11 22:39) [9]

> Нету нормального способа сделать метод класса функцией

М.б. оно и не совсем нормально, но MakeObjectInstance делает
примерно такое.
Сейчас главное - на стеке код не размещать :)

--
Regards, LVT.

← →
Leonid Troyanovsky © (2011-01-19 22:52) [12]

> DVM © (19.01.11 22:46) [10]

> не уверен что все ниже верно, неохота вникать, но как то
> так:

Нет охоты вникать, но ОРД оно не спасет, IMHO.

--
Regards, LVT.

← →
DVM © (2011-01-19 23:04) [13]

> Leonid Troyanovsky © (19.01.11 22:52) [12]

> оно не спасет

Да вроде нормально там, стандартный подход использован, по мотивам Classes.Tthread

Работать должно вроде.

← →
Leonid Troyanovsky © (2011-01-19 23:09) [14]

> DVM © (19.01.11 23:04) [13]

> Работать должно вроде

В умелых руках и стеклянный член пригодится.

--
Regards, LVT.

← →
начинающий2 (2011-01-19 23:30) [15]

> Leonid Troyanovsky © (19.01.11 22:47) [11]

Почему на стеке не размещать? Раньше можно было а сейчас нельзя?

> Leonid Troyanovsky © (19.01.11 22:34) [8]

Не в этом соль была. Это же не рабочий код, я просто экспериментировал, да это так было сделано лижбы запускался поток.

← →
DVM © (2011-01-19 23:32) [16]

> начинающий2 (19.01.11 23:30) [15]

> Раньше можно было а сейчас нельзя?

Раньше DEP не было.

← →
Leonid Troyanovsky © (2011-01-19 23:39) [17]

> начинающий2 (19.01.11 23:30) [15]

> Почему на стеке не размещать? Раньше можно было а сейчас
> нельзя?

Т.е., таки размещаем? Ну, и как? Любопытно.

>
> да это так было сделано лижбы запускался поток.

Дык, а что ж прочитано? Резюм в студию.

--
Regards, LVT.

← →
начинающий2 (2011-01-20 00:04) [18]

> Leonid Troyanovsky © (19.01.11 23:39) [17]

> Дык, а что ж прочитано? Резюм в студию.

чего то совсем не понял вас... чего нужно то?

вы бы сперва обратили бы внимание на на это > "начинающий2"

← →
Leonid Troyanovsky © (2011-01-20 07:19) [19]

> начинающий2 (20.01.11 00:04) [18]

> чего то совсем не понял вас... чего нужно то?

Книжку почитать.

--
Regards, LVT.

← →
начинающий2 (2011-01-20 08:22) [20]

Удалено модератором

← →
Anatoly Podgoretsky © (2011-01-20 09:03) [21]

> начинающий2 (20.01.2011 08:22:20) [20]

Сходи ко мне на сайт и хоть обкачайся этими книжками.

← →
начинающий2 (2011-01-20 09:30) [22]

> Anatoly Podgoretsky © (20.01.11 09:03) [21]
> > начинающий2 (20.01.2011 08:22:20) [20]
>
> Сходи ко мне на сайт и хоть обкачайся этими книжками.

какой древностью тянет..
А когда вы последний раз обновляли или чего-нибудь новенького добавляли?
Я там нашел инфу про такие штуки, что уже просто нет никакого морального права их использовать где-нибудь. В мире все так изменилось. Но все равно многое интересного.

← →
KSergey © (2011-01-20 09:49) [23]

> начинающий2 (20.01.11 09:30) [22]
> какой древностью тянет..

Так это не журнал "хакер"
Эти книги не тухнут.

← →
Anatoly Podgoretsky © (2011-01-20 10:08) [24]

> начинающий2 (20.01.2011 09:30:22) [22]

Наше дело предложить, ваше отказаться.

← →
Игорь Шевченко © (2011-01-20 10:27) [25]

начинающий2 (20.01.11 09:30) [22]

lamer vulgaris

← →
начинающий2 (2011-01-20 10:48) [26]

> KSergey © (20.01.11 09:49) [23]

> Так это не журнал "хакер"
> Эти книги не тухнут.

А при чем здесь этот быдло журнал. Он же просто отстойный слив кто его вообще читает? Не, нет, нет, вспомнил кто его читает - наш админ, ну так он же полный ... и вообще просто улетевший.

> Anatoly Podgoretsky © (20.01.11 10:08) [24]

Нашёл все-таки нужную книЖечку "Многопоточность - как это делается в Дельфи. Мартин Харви
хоть и дата размещения 18.08.2010 но в самой книге указан год издания Перевод: © Борис Новгородов, Новосибирск, 2002 г. С
Ох как долго же она шла ;-)

← →
DiamondShark © (2011-01-20 11:08) [27]

> пока не наткнутся на DEP

Щито?

← →
DiamondShark © (2011-01-20 11:11) [28]

> А когда вы последний раз обновляли или чего-нибудь новенького
> добавляли?

Напомни, когда Win32 последний раз обновился, в плане управления потоками?

← →
начинающий2 (2011-01-20 11:23) [29]

> DiamondShark © (20.01.11 11:11) [28]

> Напомни, когда Win32 последний раз обновился, в плане управления
> потоками?

С выходом новой windows, а вы все еще на старой?
У мну так:
win7 64bit,
6Gb SDRAM DDR-III 1333Mz,
HDD 1T(512Gbx2 Read) speed 200mb/s
Sli NVida 2xGTX-470 - два мощный физик-акселератора

Ну разве не круто?

> начинающий2 (20.01.11 11:23) [29]

Крутотой перед девочками тряси, хотя у слона всё равно длиннее.

Я про Win32 API спрашивал. Как ты думаешь, в части управления потоками, когда и насколько сильно он обновлялся?

> начинающий2 (20.01.11 11:23) [29]
Хочу по пунктам - чиво там изменилось со времён ХР?

> DiamondShark © (20.01.11 11:08) [27]
>
> > пока не наткнутся на DEP
>
> Щито?

Что не понятно? Многие способы по превращению метода класса в процедуру вызывают возмущение аппарата DEP и прибиение программы мгновенное. (http://ru.wikipedia.org/wiki/Data_Execution_Prevention)

Например такой:

type { .: TMethodToProc :. } TMethodToProc = packed record popEax: Byte; pushSelf: record opcode: Byte; Self: Pointer; end; pushEax: Byte; jump: record opcode: Byte; modRm: Byte; pTarget: ^Pointer; target: Pointer; end; end; { .: MethodToProcedure :. } function MethodToProcedure(self: TObject; methodAddr: Pointer): Pointer; var mtp: ^TMethodToProc absolute Result; begin New(mtp); with mtp^ do begin popEax := $58; pushSelf.opcode := $68; pushSelf.Self := Self; pushEax := $50; jump.opcode := $FF; jump.modRm := $25; jump.pTarget := @jump.target; jump.target := methodAddr; end; end; ... constructor TWindow.Create; begin inherited Create(); ... WndProcPtr := MethodToProcedure(Self, @TWindow.WndProc); ... end;

Особенно это хорошо проявляется в Windows 2003 Server.

← →
han_malign (2011-01-20 17:15) [33]

> DVM ©
> метода класса в процедуру вызывают возмущение аппарата DEP

- при чем тут DEP и стек, в приведенном вами приеме - должно использоваться VirtualAlloc(..., PAGE_EXECUTE_READWRITE), и все приложения написанные с использованием VCL это делают(с оптимизацией в виде микро-менеджера памяти, чтобы на каждое окно 64К не отжирать) - и все прекрасно везде работает, хоть с DEP, хоть с NX...

В указанном мной приеме - используется документированное правило передачи указателя на экземпляр класса в его метод, я просто не проверил как какое соглашение о вызовах использует обертка BeginThread:
type
TThreadFunc = function(Parameter: Pointer): Integer;

- то есть, в данном случае(в отличие от CreateThread) - stdcall нужно убрать и указатель на экземпляр класса, указанный в качестве пользовательского контекста потока, будет спокойно передаваться через EAX в соответствии с соглашением о вызове register и вышеуказанным правилом...

> han_malign (20.01.11 17:15) [33]

> и все приложения написанные с использованием VCL это делают

Не все, в TService + TServiceApplication так не сделано (процедуры ServiceMain и ServiceController не сделаны методами класса). Кстати, интересно по какой причине.

Собственно, я когда то пытался именно данным способом засунуть их внутрь класса (сделал свои классы TService и TServiceApplication), получил предупреждение от DEP и закрытие приложения. Причем оно возникало не всегда, но регулярно даже в ничего не делающих сервисах.

Кстати, в новых версиях Delphi появилась другой вариант, использовать ключевое слово static:
type TMyThread = class private FHandle: THandle; FID: Cardinal; class function ThreadProc(Param: Pointer): DWord; stdcall; static; function Execute: DWord; public constructor Create; destructor Destroy; override; end; { TMyThread } constructor TMyThread.Create; begin IsMultiThread := True; FHandle := CreateThread(nil, 0, @ThreadProc, Self, 0, FID); end; destructor TMyThread.Destroy; begin CloseHandle(FHandle); FHandle := 0; FID := 0; inherited; end; class function TMyThread.ThreadProc(Param: Pointer): DWord; begin Result := TMyThread(Param).Execute; end; function TMyThread.Execute: DWord; begin MessageBox(0, "Hello from thread", "Information", MB_OK or MB_ICONINFORMATION); Result := 0; end;

http://www.gunsmoker.ru/2008/12/static-delphi.html

← →
han_malign (2011-01-20 17:44) [36]

> Кстати, интересно по какой причине.

- надо было интересоваться по какой обоснованной причине это было сделано в TWinControl...
А сделано это потому, что единственный нативный способ связать окно с пользовательским контекстом - это SetWindowLong(,GWL_USERDATA,), а это гипотетически могло быть использовано программистом для своих целей(а скорее всего уже кем то использовалось) - поэтому, видимо после долгого разглядывания GWL_xxx, разработчики VCL и обратили внимание на GWL_WNDPROC...

← →
han_malign (2011-01-20 17:50) [37]

> использовать ключевое слово static

- да на здоровье, это все, включая прием с соглашением о передаче параметров - синтаксический сахар...

> А сделано это потому, что единственный нативный способ связать
> окно с пользовательским контекстом - это SetWindowLong(,
> GWL_USERDATA,),

Вовсе не единственный

> han_malign (20.01.11 17:44) [36]

Здесь то как раз более-менее понятно. И объективная причина есть.

> han_malign (20.01.11 17:50) [37]

> это все, включая прием с соглашением о передаче параметров
> - синтаксический сахар...

Наверное...сахар. Но именно смотрится лучше.

← →
han_malign (2011-01-20 18:18) [40]

> Вовсе не единственный

- хэш(SetProp/GetProp в том числе), отдельный поток(в VCL :))) - не в счет...

как можно создать такой класс? Найти похожие ветки