Главная страница
    Top.Mail.Ru    Яндекс.Метрика
Форум: "Основная";
Текущий архив: 2003.07.17;
Скачать: [xml.tar.bz2];

Вниз

GroupBox.Visible - AV?   Найти похожие ветки 

 
Makhanev A.S.   (2003-07-03 23:06) [0]

Есть ли "подводный камень" в GroupBox.Visible?
Определённые манипуляции вызывают AV при закрытии приложения.


 
Романов Р.В.   (2003-07-03 23:31) [1]

Скорее всего камень в другом месте


 
Makhanev A.S.   (2003-07-04 00:34) [2]

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


 
Makhanev A.S.   (2003-07-04 01:20) [3]

Возможно, тут есть утечки, вот исходник.
Назначение - поток, реализующий рекурсивный поиск по каталогам, с возможностью быстрого выхода:

unit SrchThrd;

interface

uses
Classes, SysUtils, Masks, Forms;

type
TSearchThread = class(TThread)
private
procedure SearchInDirThrd(Masks: TStrings; Dir: string; Subdir: Boolean;
var List: TStrings; ReturnExpandedFileNames: Boolean = True);
protected
procedure Execute; override;
procedure SearchAndAdd;
end;

implementation

uses
Globals, MainForm, Utils;
{ TSearchThread }

procedure TSearchThread.Execute;
begin
FreeOnTerminate := True;
Synchronize(SearchAndAdd);
end;

procedure TSearchThread.SearchAndAdd;
var
Path: string;
begin
if Assigned(MFiles) then
FreeAndNil(MFiles);
MFiles := TStringList.Create;
{MFiles"ll be released later}
Path := frmMain.stvExplorer.Path;
SearchInDirThrd(GetCheckedExtNames, Path,
RecurseSubDirectories, MFiles);
end;

procedure TSearchThread.SearchInDirThrd(Masks: TStrings; Dir: string; Subdir: Boolean;
var List: TStrings; ReturnExpandedFileNames: Boolean = True);
var
r: Int64;
SearchRec: TSearchRec;
i: Byte;
begin
if Dir = "" then Exit;
if Dir[Length(Dir)] <> "\" then Dir := Dir + "\";
{$I-}
ChDir(Dir);
{$I+}
if IOResult <> 0 then Exit;
r := FindFirst("*.*", faAnyFile, SearchRec);
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
Application.ProcessMessages;
while (r = 0) and (not Terminated) do
begin
for i := 0 to Masks.Count-1 do
if MatchesMask(SearchRec.Name, Masks[i]) then
if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then
begin
if ReturnExpandedFileNames then
List.Add(ExpandFileName(SearchRec.Name))
else
List.Add(SearchRec.Name);
Application.ProcessMessages;
{--}
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
frmMain.ShowStatusBarHint(Format("%s: %d files found...",
[Dir, MFiles.Count]));
end;
if (SearchRec.Attr and faDirectory) = faDirectory then
if SubDir then
begin
if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then
begin
{--}
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
Application.ProcessMessages;
SearchInDirThrd(Masks, ExpandFileName(SearchRec.Name), SubDir, List);
ChDir(Dir);
end;
end;
r := FindNext(SearchRec);
{--}
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
Application.ProcessMessages;
end;
SysUtils.FindClose(SearchRec);
end;

Вкладки {--} сделаны для проверки завершения потока - т.е. быстрый выход.


 
Романов Р.В.   (2003-07-04 06:54) [4]

Зачем нужен отдельный поток если все операции поиска выполняются в контексте основного потока?


 
Makhanev A.S.   (2003-07-04 12:10) [5]


> Романов Р.В. © (04.07.03 06:54)

Прошу прощения, но что-то я Вас недопонял: это у меня они в контексте основного выполняются - или это вообще принято делать в контексте основного потока??


 
SVM (Perm)   (2003-07-04 12:15) [6]

Synchronize выполняется в контексте основного потока.


 
Makhanev A.S.   (2003-07-04 12:21) [7]


> SVM (Perm) (04.07.03 12:15)

Что-то я совсем не пойму...
Вроде в разных книжках про потоки читл..хм..

> Synchronize выполняется в контексте основного потока

можете пояснить, как код в TThread.Execute может выполняться "в контексте основного потока"???

P.S: эффект от потока достигается нужный, проблемка-то (ПРОБЛЕМИЩЕ!) вот, только в неуловимом AV при закрытии программы...

Выходит, что толку от Synchronize в моём случае нет?


 
Makhanev A.S.   (2003-07-04 12:43) [8]

Действительно, опыты показали, что толку от Synchronize нет.
Как же ш так получается?


 
SVM (Perm)   (2003-07-04 12:54) [9]

Внутри Synchronize происходит переключение потоков (точнее говоря, создается очередь процедур, которые выполняется в контексте основного потока). Все есть в исходниках.
Syncronize в общем случае нужно вызывать, когда идет обращение к визуальным компонентам.


 
Makhanev A.S.   (2003-07-04 12:58) [10]


> SVM (Perm) (04.07.03 12:54)

Это мне понятно, в SearchAndAdd идёт это обращение, просто я его для краткости вырезал.


 
SVM (Perm)   (2003-07-04 13:03) [11]

Ну раз понятно - в чем проблема?
1. Synchronize в Execute - не нужно.
2. Все обращения к ShowStatusBarHint - через Synchronize.
3. Application.ProcessMessages - убрать.


 
Makhanev A.S.   (2003-07-04 15:00) [12]

2All:
Огромное спасибо, подумал, переосмыслил, более-менее разобрался.

Тейксейра и Пачеко тоже не помешали. Жаль, в их книге не очень много про потоки.
Можете дать линк, или посоветовать книгу, где бы в большом объёме описывались потоки и были бы приличные примеры.
Хочется, так сказать, в достаточной степени "утрамбовать" знания...


 
Makhanev A.S.   (2003-07-04 16:12) [13]

Теперь более редко, но AV всё равно иногда вылетает:(
Без потока - не вылетает.
Обновил модуль потока:


unit SrchThrd;

interface

uses
Classes, SysUtils, Masks, Forms;

type
TSearchThread = class(TThread)
private
Path: string;
CurrentDir: string;
procedure SearchInDirThrd(Masks: TStrings; Dir: string; Subdir: Boolean;
var List: TStrings; ReturnExpandedFileNames: Boolean = True);
procedure LoadData;
procedure ShowStatusBarHintThrd;
protected
procedure Execute; override;
procedure SearchAndAdd;
public
constructor Create(Suspended: Boolean; const APath: string);
end;

implementation

uses
Globals, MainForm, Utils;
{ TSearchThread }

constructor TSearchThread.Create(Suspended: Boolean; const APath: string);
begin
inherited Create(Suspended);
Path := APath;
end;

procedure TSearchThread.Execute;
begin
FreeOnTerminate := True;
SearchAndAdd;
end;

procedure TSearchThread.LoadData;
begin
if MFiles.Count > 0 then
begin
frmMain.ShowStatusBarHint("Adding found files to table...");
frmMain.LoadDataToTables(MFiles);
frmMain.ShowStatusBarHint(Format("%s: %d files found", [Path, MFiles.Count]));
end;
end;

procedure TSearchThread.SearchAndAdd;
begin
if Assigned(MFiles) then
FreeAndNil(MFiles);
MFiles := TStringList.Create;
{MFiles"ll be released later}
SearchInDirThrd(GetCheckedExtNames, Path,
RecurseSubDirectories, MFiles);
if Terminated then Exit;
Synchronize(LoadData);
end;

procedure TSearchThread.SearchInDirThrd(Masks: TStrings; Dir: string; Subdir: Boolean;
var List: TStrings; ReturnExpandedFileNames: Boolean = True);
var
r: Int64;
SearchRec: TSearchRec;
i: Byte;
begin
if Dir = "" then Exit;
if Dir[Length(Dir)] <> "\" then Dir := Dir + "\";
{$I-}
ChDir(Dir);
{$I+}
if IOResult <> 0 then Exit;
CurrentDir := Dir;
// TODO 3 -cFileSearch: bug in case "dir1\dir2" without any files in "dir1"
r := FindFirst("*.*", faAnyFile, SearchRec);
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
while (r = 0) and (not Terminated) do
begin
for i := 0 to Masks.Count-1 do
if MatchesMask(SearchRec.Name, Masks[i]) then
if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then
begin
if ReturnExpandedFileNames then
List.Add(ExpandFileName(SearchRec.Name))
else
List.Add(SearchRec.Name);
{--}
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
Synchronize(ShowStatusBarHintThrd);
end;
if (SearchRec.Attr and faDirectory) = faDirectory then
if SubDir then
begin
if (SearchRec.Name <> ".") and (SearchRec.Name <> "..") then
begin
{--}
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
SearchInDirThrd(Masks, ExpandFileName(SearchRec.Name), SubDir, List);
ChDir(Dir);
end;
end;
r := FindNext(SearchRec);
{--}
if Terminated then
begin
SysUtils.FindClose(SearchRec);
Exit;
end;
end;
SysUtils.FindClose(SearchRec);
end;

procedure TSearchThread.ShowStatusBarHintThrd;
begin
frmMain.ShowStatusBarHint(Format("%s: %d files found...",
[CurrentDir, MFiles.Count]));
end;

end.

Создание потока при ShellTreeView.OnChange:

procedure TfrmMain.stvExplorerChange(Sender: TObject; Node: TTreeNode);
begin
pnlSelected.Caption := " " + stvExplorer.Path;
ShowStatusBarHint("");
if not Activated then Exit;
if Assigned(SearchThread) then
begin
SearchThread.Terminate;
end;
SearchThread := TSearchThread.Create(False, stvExplorer.Path);
end;

На всякий случай для Assigned:

procedure TfrmMain.FormCreate(Sender: TObject);
begin
SearchThread := nil;
...
end;

Освобождаю при выходе:

procedure TfrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
if Assigned(SearchThread) then
SearchThread.Terminate;
end;




 
Makhanev A.S.   (2003-07-05 01:20) [14]

Может, есть какие-либо мысли?



Страницы: 1 вся ветка

Форум: "Основная";
Текущий архив: 2003.07.17;
Скачать: [xml.tar.bz2];

Наверх





Память: 0.5 MB
Время: 0.009 c
1-55585
Вопрос
2003-07-01 17:53
2003.07.17
Как можно получить данные POST посланые через TCppWebBrouser


14-55725
Dmitriy O.
2003-07-02 13:43
2003.07.17
Как в Delphi снять сразу все точки прерывания как в VBA.


3-55425
Relaxxx
2003-06-24 10:24
2003.07.17
Как выделить ВСЕ строки в DBGrid


1-55508
Flint
2003-07-04 12:28
2003.07.17
TDateTime conversion


1-55635
r900
2003-07-02 11:48
2003.07.17
Как вставить компонент DateTimePicker в ячейку таблицы StringGrid





Afrikaans Albanian Arabic Armenian Azerbaijani Basque Belarusian Bulgarian Catalan Chinese (Simplified) Chinese (Traditional) Croatian Czech Danish Dutch English Estonian Filipino Finnish French
Galician Georgian German Greek Haitian Creole Hebrew Hindi Hungarian Icelandic Indonesian Irish Italian Japanese Korean Latvian Lithuanian Macedonian Malay Maltese Norwegian
Persian Polish Portuguese Romanian Russian Serbian Slovak Slovenian Spanish Swahili Swedish Thai Turkish Ukrainian Urdu Vietnamese Welsh Yiddish Bengali Bosnian
Cebuano Esperanto Gujarati Hausa Hmong Igbo Javanese Kannada Khmer Lao Latin Maori Marathi Mongolian Nepali Punjabi Somali Tamil Telugu Yoruba
Zulu
Английский Французский Немецкий Итальянский Португальский Русский Испанский