powered by simpleCommunicator - 2.0.61     © 2026 Programmizd 02
Целевая тема:
Создать новую тему:
Автор:
Закрыть
Цитировать
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Lazarus: передача blob, как параметра, внутрь и наружу TThread
14 сообщений из 39, страница 2 из 2
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39509624
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
чччД,

во, спасибо. Завтра, когда моск включится, посмотрю твой код. Очень интересная реализация.

зы. Вариант с временным файлом у меня давно реализован. Хочу уйти от него, т.к. могут быть потенциальные проблемы с правами на запись и проч.проч.
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511787
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Хм, вообщем, попробовал идею чччД. Получилось примерно так:
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
95.
96.
97.
98.
99.
100.
101.
102.
103.
104.
105.
106.
107.
108.
109.
110.
111.
112.
113.
114.
115.
116.
117.
118.
119.
120.
121.
122.
123.
124.
125.
126.
127.
128.
129.
130.
131.
132.
133.
134.
135.
136.
137.
138.
139.
140.
141.
142.
143.
144.
145.
146.
147.
148.
149.
150.
151.
const
  {uses windows for WIN or LMessages for LINUX}
  WM_ADDSTREAMPARAM_MSG = WM_USER + $101;
  WM_CONTAINERCLEAR_MSG = WM_USER + $102;


type

  TStreamRec = packed record
    ContainerType: Integer;
    ByteArray: array of Byte;
  end;

  { TMyThread }

  TMyThread = class(TThread)
  private
    FArrStreamRec: array of TStreamRec;
  protected
    procedure Execute; override;
  public
    FIsTermThread: Boolean;
    constructor Create (CreateSuspended: boolean; ArrStreamRec: array of TStreamRec);
  end;

  { TForm1 }

  TForm1 = class(TForm)
//<skiped>
  private
    FMyThread: TMyThread;
  public
    procedure WM_AddStreamParam_Msg (var Msg: TLMessage); message WM_ADDSTREAMPARAM_MSG;
    procedure WM_ContainerClear_Msg (var Msg: TLMessage); message WM_CONTAINERCLEAR_MSG;
  end; 

procedure TForm1.BtnThreadClick(Sender: TObject);
var
  msM //поток для Memo
  //, dms
  , msP: TMemoryStream; //поток для Picture

  MyStreamArr: array of TStreamRec;
begin
  if Assigned(FMyThread) then Exit;

  msM:= TMemoryStream.Create;//для строк
  //dms:= TMemoryStream.Create;
  msP:= TMemoryStream.Create;//для картинки
  try
    //    ===== MemoSrc ====
    MemoSrc.Lines.SaveToStream(msM);
    msM.Position:= soFromBeginning;

    SetLength(MyStreamArr, 2);//размер array of TStreamRec
    SetLength(MyStreamArr[0].ByteArray,msM.Size);//определяем размер массива байтов поля array of TStreamRec
    msM.Read(MyStreamArr[0].ByteArray[0],msM.Size);//читаем содержимое потока в массив поля записи
    MyStreamArr[0].ContainerType:= 0;//тип контейнера Memo

    //    ===== MemoSrc ====
    ImgSrc.Picture.SaveToStream(msP);
    msP.Position:= 0;

    SetLength(MyStreamArr[1].ByteArray, msP.Size);
    msP.Read(MyStreamArr[1].ByteArray[0],msP.Size);
    MyStreamArr[1].ContainerType:= 1;

    //создаем поток с параметрами и ждем результаты
    FMyThread:= TMyThread.Create(True,MyStreamArr);

    try
      while not FMyThread.FIsTermThread do
      begin
        Application.ProcessMessages;
        Sleep(500);
      end;
    finally
      FreeAndNil(FMyThread);
    end;

    //вот так все копируется в новый контейнер корректно
    //dms.Write(MyStreamArr[0].ByteArray[0],Length(MyStreamArr[0].ByteArray));
    //dms.Position:= soFromBeginning;
    //ImgDest.Picture.LoadFromStream(dms);
  finally
    FreeAndNil(msP);
    //FreeAndNil(dms);
    FreeAndNil(msM);
  end;
end;    

procedure TForm1.WM_ContainerClear_Msg(var Msg: TLMessage);
begin
  case Msg.wParam of
    0: begin
      MemoDest.Clear;
      Label1.Caption:= 'грузим Memo';
    end;
    1: begin
      ImgDest.Picture.Clear;
      Label1.Caption:= 'грузим картинку';
    end;
  end;
end;

constructor TMyThread.Create(CreateSuspended: boolean;
  ArrStreamRec: array of TStreamRec);
var
  i: Integer;
begin
  inherited Create(CreateSuspended);
  Priority:= tpLower;
  FreeOnTerminate:= False;
  FIsTermThread:= False;

  if Length(ArrStreamRec) > 0 then
    begin
      SetLength(FArrStreamRec,Length(ArrStreamRec));

      for i := Low(ArrStreamRec) to High(ArrStreamRec) do
        begin
          FArrStreamRec[i].ContainerType:= ArrStreamRec[i].ContainerType;
          SetLength(FArrStreamRec[i].ByteArray,Length(ArrStreamRec[i].ByteArray));//надо ли определять размер?
          FArrStreamRec[i].ByteArray:= ArrStreamRec[i].ByteArray;
        end;
    end;

  if CreateSuspended then Start;
end; 

procedure TForm1.WM_AddStreamParam_Msg(var Msg: TLMessage);
var
  ARec: TStreamRec;
  ms: TMemoryStream;
begin

  ARec:= TStreamRec(Pointer(Msg.lParam)^);

  ms:= TMemoryStream.Create;
  try
    ms.Write(ARec.ByteArray[0],Length(ARec.ByteArray));
    ms.Position:= soFromBeginning;

    case Msg.wParam of
      0: MemoDest.Lines.LoadFromStream(ms);
      1: ImgDest.Picture.LoadFromStream(ms);
    end;
  finally
    FreeAndNil(ms);
  end;
end;                                             



Чую, где-то косяк при передаче парамметров в WM_AddStreamParam_Msg. В Memo отображается "????", картинка пустая.

ЧЯДНТ?

зы. архив приложил
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511803
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Док,

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

то есть,

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
var
  ContentType: Integer;
//для текста
  ContentType := 0;
Stream.Write (ContentType, SizeOf(ContentType));
Memo1.Lines.SaveToStream(Stream);

//для картинки
 ContentType := 1;
  Stream.Write (ContentType, SizeOf(ContentType));  
  Image1.Picture.SaveToStream(Stream);



К чему все эти сообщения и прочий геморрой ?
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511820
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schiК чему все эти сообщения и прочий геморрой ?
тут дело в постановке задачи. Скажем так, в данном случае, мне нужно передать массив байтов (или указатель на TMemoryStream, все равно его экземпляр будет жить до окончания жизни доп.потока) в доп.поток и вернуть его обратно. Т.о. образом я смогу, когда надо, передать blob в доп.поток (скажем, при записи в таблицу), а когда надо - передать blob в основной поток (например, при чтении из БД).

зы. если ты смотрел сорцы приложенного архива, там есть вариант прямого копирования из контейнера в контейнер.
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511834
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокschiК чему все эти сообщения и прочий геморрой ?
тут дело в постановке задачи. Скажем так, в данном случае, мне нужно передать массив байтов (или указатель на TMemoryStream, все равно его экземпляр будет жить до окончания жизни доп.потока) в доп.поток и вернуть его обратно. Т.о. образом я смогу, когда надо, передать blob в доп.поток (скажем, при записи в таблицу), а когда надо - передать blob в основной поток (например, при чтении из БД).

зы. если ты смотрел сорцы приложенного архива, там есть вариант прямого копирования из контейнера в контейнер.

Смотрел, но не разбирался. Относительно потоков и прочих массивов - у всех потоков в процессе память общая, указатели можно передавать туда и сюда. Для blob'в хорошо подходят Stream-ы потому что их уже поддерживают blob-поля.
Вот честно не понимаю, в чем проблема, с передачей разного рода объектов между потоками (да и между процессами тоже) имею дело давно, поэтому возможно чего-то у тебя не понимаю :)
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511844
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schiВот честно не понимаю, в чем проблема
Хорошо, покажи (хотя бы схематично), как ты передаешь блобы из главного в доп. поток (если пишешь в базу) или из доп.потока в основной поток (если читаешь). Я с этим вопросом только начал разбираться, не совсем вкурил
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511847
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
хех, голова садовая, забыл Execute доп.потока показать
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
{ TMyThread }

procedure TMyThread.Execute;
var
  msg: TLMessage;
begin
  msg.wParam:= FArrStreamRec[0].ContainerType;
  SendMessage(Form1.Handle,WM_CONTAINERCLEAR_MSG,msg.wParam,0);//чистим контейнер (это memo)
  SendMessage(Form1.Handle,WM_ADDSTREAMPARAM_MSG,0,DWORD(@FArrStreamRec[0]));
  Sleep(2000);

  msg.wParam:= FArrStreamRec[1].ContainerType;
  SendMessage(Form1.Handle,WM_CONTAINERCLEAR_MSG,msg.wParam,0);//чистим контейнер (это Picture)
  SendMessage(Form1.Handle,WM_ADDSTREAMPARAM_MSG,0,DWORD(@FArrStreamRec[1]));
  Sleep(2000);

  FIsTermThread:= True;
end;


schi,
глянь, плз, корректно ли я передаю параметры в основной поток и корректно ли там их принимаю
Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
procedure TForm1.WM_AddStreamParam_Msg(var Msg: TLMessage);
var
  ARec: TStreamRec;
  ms: TMemoryStream;
begin

  ARec:= TStreamRec(Pointer(Msg.lParam)^);

  ms:= TMemoryStream.Create;
  try
    ms.Write(ARec.ByteArray[0],Length(ARec.ByteArray));
    ms.Position:= soFromBeginning;

    case Msg.wParam of
      0: MemoDest.Lines.LoadFromStream(ms);
      1: ImgDest.Picture.LoadFromStream(ms);
    end;
  finally
    FreeAndNil(ms);
  end;
end; 

...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511857
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
ДокschiВот честно не понимаю, в чем проблема
Хорошо, покажи (хотя бы схематично), как ты передаешь блобы из главного в доп. поток (если пишешь в базу) или из доп.потока в основной поток (если читаешь). Я с этим вопросом только начал разбираться, не совсем вкурил

Работа с базой:
20743953

между потоками передается указатель на некий контекст (AContext в коде), это запись, одно из полей которой - указатель на Stream.

Разумеется, я опустил синхронизацию, но полагаю, что это азы.

Докглянь, плз, корректно ли я передаю параметры в основной поток и корректно ли там их принимаю


На мой беглый взгляд корректно, но почему бы тебе не сделать логирование и самому посмотреть ?
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511869
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
Док,

Набросал пример на скорую руку, работающий:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
12.
13.
14.
15.
16.
17.
18.
19.
20.
21.
22.
23.
24.
25.
26.
27.
28.
29.
30.
31.
32.
33.
34.
35.
36.
37.
38.
39.
40.
41.
42.
43.
44.
45.
46.
47.
48.
49.
50.
51.
52.
53.
54.
55.
56.
57.
58.
59.
60.
61.
62.
63.
64.
65.
66.
67.
68.
69.
70.
71.
72.
73.
74.
75.
76.
77.
78.
79.
80.
81.
82.
83.
84.
85.
86.
87.
88.
89.
90.
91.
92.
93.
94.
unit main;

interface

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

const
  UM_BEGIN = WM_USER + 1;
  UM_INCOMINGSTREAM = WM_USER;

type
  TProducerThread = class(TThread)
  protected
    procedure Execute; override;
  end;

  TForm1 = class(TForm)
    Memo1: TMemo;
    procedure FormShow(Sender: TObject);
  private
    procedure UMBegin (var Message: TMessage); message UM_BEGIN;
    procedure UMIncomingStream (var Message: TMessage); message UM_INCOMINGSTREAM;
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

{ TProducerThread }

procedure TProducerThread.Execute;
var
  SR: TSearchRec;
  ErrCode: Integer;
  DataDir: string;
  FS: TFileStream;
  MS: TMemoryStream;
begin
  DataDir := ExtractFilePath(ParamStr(0))+'Data\';
  ErrCode := FindFirst(DataDir+'*.*', faAnyFile, SR);
  while (ErrCode = 0) and not Terminated do
  begin
    if (SR.Attr and faDirectory) = 0 then
    begin
      FS := TFileStream.Create(DataDir + SR.Name, fmOpenRead);
      try
        MS := TMemoryStream.Create;
        try
          MS.SetSize(FS.Size);
          MS.CopyFrom(FS, FS.Size);
          MS.Position := 0;
          SendMessage(Application.MainForm.Handle, UM_INCOMINGSTREAM, 0, LPARAM(MS));
        except
          MS.Free;
          raise;
        end;
      finally
        FS.Free;
      end;
    end;
    ErrCode := FindNext(SR);
  end;
end;

{ TForm1 }

procedure TForm1.FormShow(Sender: TObject);
begin
  PostMessage(Handle, UM_BEGIN, 0, 0);
end;

procedure TForm1.UMBegin(var Message: TMessage);
var
  Thread: TProducerThread;
begin
  Thread := TProducerThread.Create(True);
  Thread.FreeOnTerminate := True;
  Thread.Resume;
end;

procedure TForm1.UMIncomingStream(var Message: TMessage);
begin
  with Message do
    Memo1.Lines.LoadFromStream(TStream(LParam));
  Application.ProcessMessages;
  Sleep(2000);
end;

end.

...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511891
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
С такой добавкой, а то не дописал - некрасиво, что не освобождается входящий стрим:

Код: pascal
1.
2.
3.
4.
5.
6.
7.
8.
9.
10.
11.
procedure TForm1.UMIncomingStream(var Message: TMessage);
var
  S: TStream;
begin
  with Message do
    S := TStream(LParam);
  Memo1.Lines.LoadFromStream(S);
  S.Free;
  Application.ProcessMessages;
  Sleep(2000);
end;
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511936
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schi,

все, спасибо тебе большое - разобрался.

В случае с передачей массивов байтов ошибка была в том, что
Код: pascal
1.
2.
3.
  msg.wParam:= FArrStreamRec[0].ContainerType;
  //<skiped>
  SendMessage(Form1.Handle,WM_ADDSTREAMPARAM_MSG,0,DWORD(@FArrStreamRec[0]));


передавался 0, а не значение msg.wParam

Переделал на твой вариант, тоже все зафурычило, только кода меньше

Еще раз спасибо за познавательный код
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511937
Фотография Док
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
приаттачу проект для идущих следом :)
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39511947
чччД
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
schi,

Код: pascal
1.
2.
          MS.SetSize(FS.Size); // - чтобы что?
          MS.CopyFrom(FS, FS.Size);
...
Рейтинг: 0 / 0
Lazarus: передача blob, как параметра, внутрь и наружу TThread
    #39512032
schi
Скрыть профиль Поместить в игнор-лист Сообщения автора в теме
Участник
чччДschi,

Код: pascal
1.
2.
          MS.SetSize(FS.Size); // - чтобы что?
          MS.CopyFrom(FS, FS.Size);



Чтобы ты желтым выделил
(Привычка у меня осталась при работе с TMemoryStream задавать ему размер)
...
Рейтинг: 0 / 0
14 сообщений из 39, страница 2 из 2
Форумы / Delphi [игнор отключен] [закрыт для гостей] / Lazarus: передача blob, как параметра, внутрь и наружу TThread
Найденые пользователи ...
Разблокировать пользователей ...
Читали форум (0):
Пользователи онлайн (0):
x
x
Закрыть


Просмотр
0 / 0
Close
Debug Console [Select Text]