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

Вниз

Передача структуры параметром в поток   Найти похожие ветки 

← →
Павел Черный   (2013-11-13 14:06) [0]

Есть структура, которую нужно передать параметром в поток (и работать с ней).
В виду того, что структура не совсем простая, возникает ошибка по причине неправильной работы с памятью.
Пока не могу самостоятельно понять, как же такую структуру передать. Спасибо.



type
 TDocData = packed record
   Zk1, Zk2, Zk3, Zk4, Zk5, Zk6 : ShortString;
   //есть и другие
 end;

 TDocDataArray = array [0..0] of TDocData;

 TDoc = record
   Count : Integer;
   Datas : ^TDocDataArray;
 end;
 PDoc = ^TDoc;

var
 Form1: TForm1;

implementation

uses Math;

{$R *.dfm}

function Potok(Param:PDoc):DWord;
 var I:Integer;
 Str:String;
begin
 for  I:=0 to Param^.Count-1 do
 begin
   Str:=Param^.Datas[I].Zk1;
   Str:=Param^.Datas[I].Zk2;
   //...
 end;
 Dispose(Param);//думаю, нужно иначе
 Result:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var ThreadID:DWord;
 A: array of TDocData;
 Doc:PDoc;
 I:Integer;
begin
 Randomize;
 SetLength(A,RandomRange(2,7));
 for I:=Low(A) to High(A) do
 begin
   A[I].Zk1 := "hello";
   A[I].Zk2 := "hello";
   A[I].Zk3 := "hello";
   A[I].Zk4 := "hello";
   A[I].Zk5 := "hello";
   A[I].Zk6 := "hello";
 end;
 New(Doc);
 Doc^.Count:=Length(A);
 Doc^.Datas:=@A[0];
 BeginThread(nil,0,@Potok,nil,0,ThreadID);
end;


---

← →
MBo ©   (2013-11-13 14:24) [1]

а где параметр передаётся в поточную функцию?

---

← →
Павел Черный   (2013-11-13 14:36) [2]

function Potok(Param:PDoc):DWord;

---

← →
MBo ©   (2013-11-13 14:47) [3]

Это он там принимается.
А чтобы что-нибудь принять, надо это что-то передать.

---

← →
Павел Черный   (2013-11-13 14:49) [4]

А понял.
Это в спешке писал.
Там, конечно так:
BeginThread(nil,0,@Potok,Doc,0,ThreadID);

---

← →
MBo ©   (2013-11-13 14:53) [5]

ОК. Тогда следующее - динамический массив локальный, и освобождается в конце процедуры

---

← →
Павел Черный   (2013-11-13 14:57) [6]

Ага, понял. Т.е. с потоком все в порядке и единственная проблема — это разрушение массива, после того как поток начал работать.

Но пока не понял что делать. Ждать ожидания завершения потока (WaitForSingleObject)? Хотелось бы, от этого независить. Т.е. разрушать его в конце потока.

---

← →
MBo ©   (2013-11-13 15:05) [7]

Не всё в порядке со смешиванием разных парадигм работы с динамической памятью - автоматические типы (динмассив) и контролируемые вручную (new/dispose).

И лучше описать реальную задачу.

---

← →
Павел Черный   (2013-11-13 15:14) [8]

Так это и есть реальная задача.
Нужны подробности? Поток работает с Word — открывает шаблон, ищет закладки, вставляет данные. Перед запуском потока данные получаю из БД.

---

← →
Павел Черный   (2013-11-13 15:19) [9]

Можно и без динамического массива. Но как тогда указать структуре размер массива?

New(Doc);
SetLength(Doc^.Datas,5);
...
Doc^.Datas[I].Zk1:="hello";


---

← →
MBo ©   (2013-11-13 15:19) [10]

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

---

← →
Павел Черный   (2013-11-13 15:37) [11]

Лень код переписывать.
А что, других вариантов нет?

---

← →
Ega23 ©   (2013-11-13 16:02) [12]

> Лень код переписывать.

Было бы что переписывать...


> А что, других вариантов нет?


А как?

---

← →
Павел Черный   (2013-11-13 16:02) [13]

При таком варианте работает. Но не знаю, как правильно освободить память в потоке:


function Potok(Param:PDoc):DWord;
 var I:Integer;
 Str:String;
begin
 for I:=0 to Param^.Count-1 do
 begin
   Str:=Param^.Datas[I].Zk1;
   Str:=Param^.Datas[I].Zk2;
   //...
 end;
 //Dispose(Param^.Datas);
 Dispose(Param);
 Result:=0;
end;

var ThreadID:DWord;
 A: array of TDocData;
 Doc:PDoc;
 I:Integer;
begin
 Randomize;
 SetLength(A,RandomRange(2,7));
 for I:=Low(A) to High(A) do
 begin
   A[I].Zk1 := "hello";
   A[I].Zk2 := "hello";
   A[I].Zk3 := "hello";
   A[I].Zk4 := "hello";
   A[I].Zk5 := "hello";
   A[I].Zk6 := "hello";
 end;
 New(Doc);
 GetMem(Doc^.Datas, SizeOf(TDocData)*Length(A));
 Doc^.Hwnd :=Form1.Handle;
 Doc^.Count:=Length(A);
 Doc^.Datas:=@A[0];
 BeginThread(nil,0,@Potok,Doc,0,ThreadID);


Чем такой вариант плох? Утечкой памяти?

---

← →
Ega23 ©   (2013-11-13 16:11) [14]

> Чем такой вариант плох? Утечкой памяти?


А вот нафига мудрить с этими New и Dispose? Ведь есть же стандартные TList или TObjectList, там всё реализовано уже давно.

---

← →
Павел Черный   (2013-11-13 16:30) [15]

2 Ega23 ©   (13.11.13 16:11) [14]

Я не против. Как передать TList или TObjectList потоку? Есть минимальный пример?

---

← →
Ega23 ©   (2013-11-13 16:41) [16]


type

 TDocData = class
 private
   FZk: array [1..6] of string;
   function GetZk(Index: Integer): string;
   procedure SetZk(Index: Integer; const Value: string);
 public
   procedure Assign(Source: TDocData);
   property Zk[Index: Integer]: string read GetZk write SetZk; default;
 end;

 TDocDataList = class (TObjectList)
 private
   function GetItem(Index: Integer): TDocData;
 public
   procedure Assign(Source: TDocDataList);
   function Add(Value: TDocData): Integer; overload;
   function Add: TDocData;
   property Items[Index: Integer]: TDocData read GetItem; default;
 end;

 TMyThread = class (TThread)
 private
   FDataList: TDocDataList;
 protected
   procedure Execute; override;
 public
   constructor Create(aDataList: TDocDataList);
   destructor Destroy; override;
 end;

 TForm6 = class(TForm)
 private
   { Private declarations }
 public
   { Public declarations }
 end;

var
 Form6: TForm6;

implementation

{$R *.dfm}

{ TDocData }

procedure TDocData.Assign(Source: TDocData);
var
 i: Integer;
begin
 for i := 1 to 6 do
   FZk[i] := Source.Zk[i];
end;

function TDocData.GetZk(Index: Integer): string;
begin
 Result := FZk[Index];
end;

procedure TDocData.SetZk(Index: Integer; const Value: string);
begin
 FZk[Index] := Value;
end;

{ TDocDataList }

function TDocDataList.Add(Value: TDocData): Integer;
begin
 Result := inherited Add(Value);
end;

function TDocDataList.Add: TDocData;
begin
 Result := TDocData.Create;
 Add(Result);
end;

procedure TDocDataList.Assign(Source: TDocDataList);
var
 i: Integer;
begin
 Clear;
 for i := 0 to Source.Count - 1 do
   Add.Assign(Source[i]);
end;

function TDocDataList.GetItem(Index: Integer): TDocData;
begin
 Result := TDocData(inherited Items[Index]);
end;

{ TMyThread }

constructor TMyThread.Create(aDataList: TDocDataList);
begin
 inherited Create;
 FDataList := TDocDataList.Create;
 FDataList.Assign(aDataList);
end;

destructor TMyThread.Destroy;
begin
 FDataList.Free;
 inherited;
end;

procedure TMyThread.Execute;
var
 str: string;
 i: Integer;
begin
 for i := 0 to FDataList.Count - 1 do
 begin
   str := FDataList[i].Zk[1];
   str := FDataList[i].Zk[2];
   ///....
 end;
end;



---

← →
Павел Черный   (2013-11-13 16:59) [17]

Спасибо. Так и сделаю.

А еще, я тем временем успел переписать код так:

type
 TDocData = packed record
   Zk1, Zk2, Zk3, Zk4, Zk5, Zk6 : ShortString;
 end;

 TDocDataArray = array [0..0] of TDocData;

 TDoc = record
   Hwnd: THandle;
   Count : Integer;
   Datas : array of TDocData;
 end;
 PDoc = ^TDoc;

function Potok(Param:PDoc):DWord;
 var I:Integer;
 Str:String;
begin
 for I:=0 to Param^.Count-1 do
 begin
   Str:=Param^.Datas[I].Zk1;
   Str:=Param^.Datas[I].Zk2;
   //...
 end;
 Dispose(Param);
 Result:=0;
end;

procedure TForm1.Button1Click(Sender: TObject);
 var ThreadID:DWord;
 Doc:PDoc;
 I:Integer;
begin
 Randomize;
 New(Doc);
 Doc^.Hwnd :=Form1.Handle;
 SetLength(Doc^.Datas, RandomRange(2,7));
 for I:=Low(Doc^.Datas) to High(Doc^.Datas) do
 begin
   Doc^.Datas[I].Zk1 := "hello";
   Doc^.Datas[I].Zk2 := "hello";
   Doc^.Datas[I].Zk3 := "hello";
   Doc^.Datas[I].Zk4 := "hello";
   Doc^.Datas[I].Zk5 := "hello";
   Doc^.Datas[I].Zk6 := "hello";
 end;
 Doc^.Count:=Length(Doc^.Datas);
 CloseHandle(BeginThread(nil,0,@Potok,Doc,0,ThreadID));
end;



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

---

← →
Ega23 ©   (2013-11-13 17:15) [18]

>  Чисто из любопытства, есть нарекания к этому?


Чисто из опыта работы: ты рано или поздно запутаешься во всех этих Doc^, SetLength, New и Dispose.
Оно оправдано, когда оптимизация на низком уровне нужна. Но если не требуется, то имеет смысл не заморачиваться, а использовать готовые решения.

---

← →
Павел Черный   (2013-11-13 17:20) [19]

2 Ega23 ©   (13.11.13 17:15) [18]

Да, согласен.
Спасибо.

---

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

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

Наверх

Память: 0.5 MB
Время: 0.002 c