» Вопросы по Delphi (до версии 2009) - часть 5

SerBUser
Спасибо - пригодится обязательно!

Привествую. Хочу спросить про потоки, а именно как корректно завершать поток, созданный через BeginThread. До запуска потока диспетчер задач показывает примерно 100 дескрипторов, а после - примерно в два раза больше. С чем это может быть связано.

Код функции:


Код: function ThreadCallback(LpParameter: Pointer): DWORD; stdcall;
begin

SetThreadPriority(hThread, THREAD_PRIORITY_BELOW_NORMAL);

MessageBox(0, nil, nil, MB_OK);

Result := 0; // Set up a 0 return value
EndThread(0); // End the thread

end;

Подскажите.
Имеется ClientDataSet в режиме кэширования. Если пользователь отказывается от изменений при закрытии формы, то пишу действие:
ClientDataSet.Cancel;
ClientDataSet.CancelUpdates;
При этом данные сбрасываются, но файл пересохраняется.
Как избавится от пересохранения файла?

Maks150988

А зачем использовать именно BeginThread/EndThread? Это, в общем-то, внутренние функции RTL, не особо предназначенные для непосредственного использования. Как по мне - то лучше пользоваться либо классом TThread, либо чистым WinAPI.

...А почему хэндлы "текут"... Ну, во-первых, CloseHandle(hThread) не остановит и не уничтожит поток - поток будет выполняться, пока сам не закончиться (пока не выйдет из основной функции потока). А основная функция потока в случае использования BeginThread/EndThread - это некий ассемблерный ThreadWrapper внутри System.pas, который Вашу ThreadCallback вызывает уже сам. И когда и как он должен закончиться - надо смотреть в отладчике. А во-вторых - точно, что функция потока содержит только такой код и больше ничего? Если трассировать в отладчике, то в каждой из этих точек (как в основном потоке, так и в дочернем):

1. hThread := BeginThread(nil, 0, @ThreadCallback, nil, 0, ThreadID)

2. CloseHandle(hThread)

3. сразу после CloseHandle(hThread)

4. SetThreadPriority(hThread, THREAD_PRIORITY_BELOW_NORMAL);

5. EndThread(0)

6. сразу после EndThread(0) (если код функции именно такой, как показан - то точка должна быть на end;)

- сколько будет занято хэндлов?

Aleksandr N
Попробуйте перед отменой установить ClientDataSet.FileName := '';

Odysseos
Да тут начитаешься форумов, я вообще запутался как надо. Одни советуют мол BeginThread лучше использовать чем CreateThread, якобы инициализирует свои обработчики исключений или типа того, вообще муть какая-то. Смотрел на забугорных форумах что "гуру" предлагали, там вообще код типа CloseHandle(BeginThread(***)), мне вообще показался такой код странноватым.

Я с отладчиком не дружу, но видать надо было в меню Run->Add breakpoint->Source breakpoint на ту строку на которой код. Результат получился такой.

1.99
2.100
3.100
4.99
5.211
6.207

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

Хотя может и мой косяк. Вместо MessageBox там тестово.


Код: hTimer := SetTimer(hDwn, 0, 1000, nil);

//

GetTextFileFromServerW(AServerInfo[IndexUpdate].szLink, szBuf);
if (szBuf <> '') then MessageBox(0, @szBuf[1], nil, MB_OK);

//

if (hTimer <> 0) then
KillTimer(hDwn, hTimer);

Maks150988


Цитата:

код типа CloseHandle(BeginThread(***)), мне вообще показался такой код странноватым

Строго говоря - Ваш код с промежуточной переменной по сути ничем не отличается от такой записи, всё то же самое - в обоих случаях мы просто говорим ОС, что нам этим потоком управлять не хочется, и ОС должна управлять им сама (а управлять она будет одним способом - принудительно "прибьёт" поток при завершении приложения - причём, не дожидаясь окончания выполнения им своей процедуры, в произвольном месте). Именно для того, чтоб можно было как-то управлять жизнью потока, у объектов класса TThread есть свойство Terminating.



Цитата:

...
4.99 (SetThreadPriority(hThread, THREAD_PRIORITY_BELOW_NORMAL);)
5.211 (EndThread(0))
...

Отсюда видно, что прирост хэндлов происходит не из-за собственно _создания_ потока, а из-за неких действий внутри процедуры потока - после которых хэндлы не освобождаются.


По поводу же процедуры загрузки... Я, честно говоря, WinInet'ом никогда не пользовался, потому - внятно прокомментировать код не могу; вроде, на поверхностный взгляд ошибок с освобождением ресурсов там нет - однако ж хэндлы действительно расходуются... Могу предположить, что для работы WinInet'а инициализируются некие внутренние структуры (причём - не в самом WinInet.pas, а в нижележащем коде самой ОС), для которых и нужны эти самые хэндлы - и они будут автоматически освобождены при завершении приложения. Проверить это предположение просто - надо создать этот поток два-три раза (скажем, повесить его создание на кнопку, и щёлкать по ней), и проверить количество хэндлов при каждом запуске потоке.


...А зачем там два вложенных блока try ... finally с _пустым_ finally? Такой код, конечно, будет работать без проблем - но смысла не имеет. Чтоб тихо "погасить" возможные exception'ы - надо использовать блоки try ... except.

Odysseos
А ну у меня по нажатии на кнопку и появляется диалоговое окно, а при инициализации этого диалога собственно и стартует этот поток. Количество открытых дескрипторов равняется 200 после первого запуска потока и варьируется вокруг этого числа.
Код можно переделать и под except, но сам код впринципе-то не такой уж и мудренный чтобы исключения обрабатывать еще. А то можно и MessageBox в try except завернуть при желании, только надо ли.
Да, надо будет посмотреть утечку ресурсов от WinInet, что-то подобное попадалось раньше. Сдается мне что как вариант можно и динамическую подрузку библиотеки использовать как с uxtheme.dll поступают.

Maks150988

Это, скорей всего, не утечка - а нормальное штатное поведение. Эти ~100 хэндлов нужны для работы функций WinAPI, описанных в WinInet.pas - просто резервируются они не сразу при запуске приложения, а при первом вызове соотв. функций, и потом корректно "отпускаются" при завершении работы приложения.

Maks150988
Разобрало любопытство. Сделал пример по твоему самому первому сценарию. Результат:
(кол-во хэндлов/кол-во потоков)
1. 58/1
2. 59/2
3. 58/2
4. 58/2
5. 61/2 (вызов MessageBox дает нам прирост кол-ва хэндлов в кол-ве 3 штук, причем стабильно. Вероятно, так устроена эта ф-ция)
6. 58/1
Иногда если долго не нажимать ОК в MessageBox, то на выходе один хэндл остается не освобожденным, в итоге, например, у меня в п.6 получилось бы 59/1. Но откуда у тебя берутся лишние ~100 штук, мне непонятно.
Мне кажется, дело не в работе с отдельной нитью.
Попробуй сделать то же самое в основном потоке. Интересно, как быдет обстоять дело в этом случае с хэндлами...



Добавлено:
И, в принципе, я склонен считать, что Odysseos прав, говоря, что эти хэндлы резирвируются ф-циями API по мере необходимости точно так же как это делает MessageBox. Вот я например, никогда раньше и не догадывался, что MessageBox создает аж 3 хэндла...

Пишу курсовой, помогите плиз найти ошибку. Программа выдает ошибку invalid pointer operation

в прикрепленном файле проект Скачать файл Делфи.zip

psa1974

Ну, с MessageBox-то всё понятно - само окно, кнопка и static text

Добавлено:
jupiter1976

А в какой момент она её выдаёт? Какие параметры вводить-то надо, чтоб ошибку словить?

Цитата:

Попробуйте перед отменой установить ClientDataSet.FileName := '';

По моему не очень хороший метод, хотя может сработать. А ещё мнения есть???

jupiter1976
Во-первых, в динамических массивах, память под которые выделяется ф-цией SetLength, первый элемент массива имеет индекс 0, последний - N-1, где N - колличество элементов массива
Во-вторых, после выделения памяти с использованием SetLength, тебе нет необходимости в месте с переменной типа динамический массив передавать в вспомогательные ф-ции еще и размерность массива - максимальный индекс можно определить как High(MyArray), а размерность массива = High(MyArray)+ 1.
В силу всего сказанного, у тебя везде по тексту идут циклы начиная со второго элемента массива (имеющего индекс 1) и заканчивая несуществующим элементом массива имеющим якобы индекс N (фактически по счету это элемент N+1, под который ты память не распределял!!!), вот тут то и происходит обращение не к твоей памяти, причем компилятор не сразу замечает это...
Как надо (фрагмент):

Код:
procedure pol(var a:Tmas);
var i:integer;
begin
randomize;
for i:=0 to High(a) do
begin
a[i]:=random(100)-50;
{edit4.text:=edit4.text+' '+inttostr(a[i]);
edit5.text:=edit5.text+' '+inttostr(a[i]); }
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
var M:Tmas; i,k:integer;
begin
k:=strtoint(edit1.Text);
setlength(M,k);
// после этой строки кол-во элементов массива массива = High(M)+ 1, а максимальный индекс элемента = High(M)
edit4.Text:='';
pol(M);
for i:=0 to High(M) do
edit4.text:= edit4.text+' '+inttostr(M[i]);
edit2.Text:='';
edit3.Text:='';
puzbIrek(M);
for i:=0 to High(M) do
edit2.Text:=edit2.text+' '+inttostr(M[i]);
end;

psa1974
Odysseos
Да, походу идет резервирование под нужды WinInet. Ну да ладно, главное что при многократном запуске потока дескрипторы как грибы после дождя не растут, сносно вобщем.

Предлагаю решить такую задачку, коль ранее речь зашла про апи (CreateThread заместо BeginThread), значит знаете наверняка и сталкивались, а не толкьо по компонентам лазиете...
http://webdrive.avtograd.ru/Download/Explorer/CHECKEDLISTBOX.zip
Вобщем мне необходимо прикрутить к ListBox всплывающую подсказку. Вроде прикрутил, работает, слава яйцам и гуглкоду как говориться. Но есть одна проблема. вот не могу установить вреям задержки через TTM_SETDELAYTIME, почему-то не работает для такого тултипа (нашел сообщение TTN_SHOW в Wm_Notify, но надо как-то наподобие Sleep туда забабахнуть чтобы все не приостанавливалось в отрисовке, но это самый крайний тупой вариант что я смог придумать). Ну и есть неприятный осадок - когда курсор на окне подсказки, то если щелкнуть левой кнопкой мыши по окну подсказки получим сплэш основного окна - потеря и восстановление фокуса - как следствие моргание. Но что интересно при щелчке правой кнопки мыши для вызова контекстного меню (ну я еще прикрутил туда выделение строки как-будто левой кнопкой жмем) такого не происходит. Как побороть эту напасть, что-то очень непонятное.

Скажите, если у 7z архива другое расширение, то как я смогу однозначно определить, что это именно 7z архив? Достаточно ли для этого только первых двух байтов в файле - "7z"? В смысле, в общем случае, конечно, не достаточно, но что можно применить для уверенности? Сорри, что здесь запостил, но может кто на Дельфи уже это решал.

Maks150988

Тут я пас. Я из WinAPI использую именно ядерные функции, а не оконные. Ну, то есть, оконные, конечно, тоже - но по крайней необходимости, в силу их запутанности и непрозрачности для моей думалки.

Aleksandr N
Чем плох метод?

DmitryKz
Сигнатура 7z (4 байта): 0x37 0x7A 0xBC 0xAF

Maks150988
Не, это сильно напрягаться нада... Масштаб вопроса великоват... Поиграться готовыми окнами через WinAPI - запросто, а вот писать или разгребать уже написанные окна и проги на чистом WinAPI - неа. Задача минимизации размера приложения как бы никогда передо мной не стояла, и я для себя не вижу повода не использовать VCL (ну разве где-то что-то причесать, подточить, подкрутить).

Odysseos
psa1974
Эх... Ну ладно.

volser

Цитата:

Чем плох метод?

До в принципе ни чем, только есть пару мест где данный способ точно не сработает, точнее неприемлем.

Народ помогите пл... по незнанке спрашиваю...
В общем такая задача: Сделать программу тест, т.е. в БД будут храниться вопросы, ответы, правильные ответы... а на дельфине мы пишем прогу которая будет из этого тест формировать, но загвоздка в том, что ответы это формулы. Перечисление и выбор вариантов ответов сделано при помощи checklistbox. Ворос: можно ли как нить в него записывать формулы, т.е. чтобы это выглядело как формула со значками там всякими и т.д. (как в ворде, в редакторе формул). Ну или вообще как это проще организовать... Помогите пл, оч надо

RzIzX

А в каком виде эти формулы в БД хранятся?

RzIzX
Думаю, это поможет Модули для рисования математических формул
Но формулы придется переделать под специальный синтаксис описания формул.

В любом каком нужно будет ... а вообще текст

Добавлено:
data man

Но как я понимаю... для отображения одной формулы надо размещать 1 компонент... НО ) подсчитав их надо 180 шт ...

RzIzX
Посмотрите исходники demo, почитайте комментарии к статье - там уже все обсуждалось.

как сделать такое:
Как сортировать в дочернем Table, если у него уже задано свойство
IndexNames и MasterField
В результате смены индекса в IndexNames меняется значение и в MasterField, например:
IndexNames= Index1;
MasterField=Имя_поля1(Index1)->Имя_поля(родительского Table);Меняем Index1 на Index2:
IndexNames= Index2;
MasterField=Имя_поля2(Index2)->Имя_поля(родительского Table);И в результате в DBGrid’e пусто!
Оно-то может и сартируется правильно, только я этого не вижу.
Как правильно сортировать?
Заранее благодарствую! Query использовать низя

Скажите, как узнать, что программа запущена из-под сеанса, имеющего административные привилегии? Погуглив, мне встретился такой код:
Код: type
PTOKEN_GROUPS = TOKEN_GROUPS^;

function RunningAsAdministrator(): Boolean;
var
SystemSidAuthority: SID_IDENTIFIER_AUTHORITY = SECURITY_NT_AUTHORITY;
psidAdmin: PSID;
ptg: PTOKEN_GROUPS = nil;
htkThread: Integer; { HANDLE }
cbTokenGroups: Longint; { DWORD }
iGroup: Longint; { DWORD }
bAdmin: Boolean;
begin
Result := false;
if not OpenThreadToken(GetCurrentThread(), // get security token
TOKEN_QUERY, FALSE, htkThread) then
if GetLastError() = ERROR_NO_TOKEN then
begin
if not OpenProcessToken(GetCurrentProcess(),
TOKEN_QUERY, htkThread) then
Exit;
end
else
Exit;

if GetTokenInformation(htkThread, // get #of groups
TokenGroups, nil, 0, cbTokenGroups) then
Exit;

if GetLastError() <> ERROR_INSUFFICIENT_BUFFER then
Exit;

ptg := PTOKEN_GROUPS(getmem(cbTokenGroups));
if not Assigned(ptg) then
Exit;

if not GetTokenInformation(htkThread, // get groups
TokenGroups, ptg, cbTokenGroups, cbTokenGroups) then
Exit;

if not AllocateAndInitializeSid(SystemSidAuthority,
2, SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0, psidAdmin) then
Exit;

iGroup := 0;
while iGroup < ptg^.GroupCount do // check administrator group
begin
if EqualSid(ptg^.Groups[iGroup].Sid, psidAdmin) then
begin
Result := TRUE;
break;
end;
Inc(iGroup);
end;
FreeSid(psidAdmin);
end;

DmitryKz
Проверить, имеем ли мы в системе права администратора:

Код:
const
SECURITY_NT_AUTHORITY: TSIDIdentifierAuthority =
(Value: (0, 0, 0, 0, 0, 5));
SECURITY_BUILTIN_DOMAIN_RID = $00000020;
DOMAIN_ALIAS_RID_ADMINS = $00000220;

function IsAdmin: Boolean;
var
hAccessToken: THandle;
ptgGroups: PTokenGroups;
dwInfoBufferSize: DWORD;
psidAdministrators: PSID;
x: Integer;
bSuccess: BOOL;
begin
Result := False;
bSuccess := OpenThreadToken(GetCurrentThread, TOKEN_QUERY, True,
hAccessToken);
if not bSuccess then
begin
if GetLastError = ERROR_NO_TOKEN then
bSuccess := OpenProcessToken(GetCurrentProcess, TOKEN_QUERY,
hAccessToken);
end;
if bSuccess then
begin
GetMem(ptgGroups, 1024);
bSuccess := GetTokenInformation(hAccessToken, TokenGroups,
ptgGroups, 1024, dwInfoBufferSize);
CloseHandle(hAccessToken);
if bSuccess then
begin
AllocateAndInitializeSid(SECURITY_NT_AUTHORITY, 2,
SECURITY_BUILTIN_DOMAIN_RID, DOMAIN_ALIAS_RID_ADMINS,
0, 0, 0, 0, 0, 0, psidAdministrators);
{$R-}
for x := 0 to ptgGroups.GroupCount - 1 do
if EqualSid(psidAdministrators, ptgGroups.Groups[x].Sid) then
begin
Result := True;
Break;
end;
{$R+}
FreeSid(psidAdministrators);
end;
FreeMem(ptgGroups);
end;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if isAdmin then
ShowMessage('Logged in as Administrator');
end;

DmitryKz
На что ругается?