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

Вниз

В событии 2я процедура начинается раньше чем заканчивается 1я!   Найти похожие ветки 

← →
RoLeX   (2006-10-24 15:43) [0]

Итак, предположим событие Button1Click. Между begin и end расположены две процедуры/функции:
procedure TForm1.Button1Click(Sender: TObject);
begin
procedure1;
procedure2;
end;

Так вот, у меня 2я процедура начинается раньше чем первая! Из-за этого ошибка. 1я процедура относительно продолжительная (делает скриншот экрана и сжимает его, а потом сохраняет файл).

Вот моя ситуация:
procedure GetScreenImage(AWidth, AHeight,AQuality: Integer);
var JPEG: TJPEGImage; bmp, tmpBitmap: TBitmap;
begin
JPEG:=TJPEGImage.Create;
Bmp:=TBitmap.Create;
tmpBitmap:=TBitmap.Create;
try
tmpBitmap.Width := AWidth;
tmpBitmap.Height := AHeight;
bmp.Width:=Screen.Width;
bmp.Height:=Screen.Height;
BitBlt(bmp.Canvas.Handle, 0, 0, Screen.Width, Screen.Height,GetDC(GetDesktopWindow), 0, 0, SRCCopy);
SetStretchBltMode(tmpBitmap.Canvas.Handle, STRETCH_HALFTONE);
StretchBlt(tmpBitmap.Canvas.Handle, 0, 0, AWidth, AHeight,bmp.Canvas.Handle, 0, 0, bmp.Width, bmp.Height, tmpBitmap.Canvas.CopyMode);
bmp.Assign(tmpBitmap);
JPEG.Assign(bmp);
JPEG.CompressionQuality:=AQuality;
jpeg.Compress;
JPEG.SaveToFile(ch+"\screen.jpg");
finally
JPEG.Free;
bmp.Free;
tmpBitmap.Free;
end;
end;

1-я процдура: GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

2-я процдура:
   with TFileStream.Create(ch+"\screen.jpg", fmOpenRead) do
   try
   file_size := Size;
   AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
   read_total := 0;
   while (read_total <> file_size) do
   begin
     read_current := Read(buf, 1024);
     AThread.Connection.WriteBuffer(buf, read_current);
     Inc(read_total, read_current);
   end;
   finally
     Free;
   end;

---

← →
Сергей М. ©   (2006-10-24 16:03) [1]

> 2я процедура начинается раньше чем первая


Врешь ведь)

Сам же написал - сначала procedure1, а уж следом procedure2 ..

---

← →
RoLeX   (2006-10-24 16:07) [2]

Что значит вру, если у меня иногда выскакивает ошибка (когда часто совершаю событие). Причём ошибка из-за того что 1я и 2я процедуры вроде как совершают "одновременный доступ" к файлу ch+"\screen.jpg"

---

← →
Сергей М. ©   (2006-10-24 16:11) [3]

> RoLeX   (24.10.06 16:07) [2]
>
> Что значит вру, если у меня иногда выскакивает ошибка


Железная логика - "если у меня иногда что-то там куда-то там выскакивает, то я прав в утверждении, что 2-я процедура "начинается" раньше 1-ой".

---

← →
Anatoly Podgoretsky ©   (2006-10-24 16:13) [4]

Процедуры выполняются строго последовательно и пока первая не закончит работу, ни о какой второй говорить не приходится. Все остальное фантастика.

---

← →
novill ©   (2006-10-24 16:18) [5]

А что ты там AThread мутишь? Это не тот который TThread?

---

← →
RoLeX   (2006-10-24 16:22) [6]

> novill ©   (24.10.06 16:18) [5]
> А что ты там AThread мутишь? Это не тот который TThread?
>

AThread: TIdPeerThread

(Это из события IdTCPServer1Execute). Хотите сказать что у меня в новом потоке вторая процедура, поэтому такое и получается?

---

← →
novill ©   (2006-10-24 16:27) [7]

не факт, но пока копать больше негде.

---

← →
Сергей М. ©   (2006-10-24 16:35) [8]

> RoLeX   (24.10.06 16:22) [6]
>
>


Откуда у тебя в обработчике некоего события формы взялся AThread ?
Горбатого ты нам тут лепишь) ...

---

← →
Elen ©   (2006-10-24 16:37) [9]

> RoLeX



> иногда выскакивает ошибка

Текст ошибки - ...

> когда часто совершаю событие

Как часто. Может вторая процедура предидущего события еще не закончила работу, как началась первая нового события...

---

← →
RoLeX   (2006-10-24 16:38) [10]

У меня событие на самом деле не Button1Click, а IdTCPServer1Execute. Ну так что?

---

← →
Anatoly Podgoretsky ©   (2006-10-24 16:40) [11]

Опа уже появились потоки, может тогда появятся и критические секции!

---

← →
Сергей М. ©   (2006-10-24 16:43) [12]

> RoLeX   (24.10.06 16:38) [10]



> Ну так что?


Что-что..

Плохой из тебя кибальчиш, вот что) ... раскололся на первом же буржуинском допросе)

Впрочем это уже не важно.

Ты по-прежнему продолжаешь утверждать, что при заведомо последовательном вызове тобой в контексте одного и того же потока процедур №1 и №2 последняя процедура исполняется раньше вызова первой ?

---

← →
RoLeX   (2006-10-24 16:44) [13]

Нет)) Ну так что делать то?

---

← →
Сергей М. ©   (2006-10-24 16:45) [14]

> Нет)


Что "нет" ?

В прятки играть будем или РЕАЛЬНЫЙ код приведешь наконец-то ?

---

← →
novill ©   (2006-10-24 16:47) [15]

> [11] Anatoly Podgoretsky ©   (24.10.06 16:40)
Сдал...

---

← →
Anatoly Podgoretsky ©   (2006-10-24 16:52) [16]

> Нет)) Ну так что делать то?

Если нет, то ничего не надо делать, поскольку нет предмета.

---

← →
RoLeX   (2006-10-24 16:53) [17]

Сервер:

procedure TForm1.IdTCPServer1Execute(AThread: TIdPeerThread);
var sCommand, sAction,s:string;
   plist:TStrings;
   i:integer;

 file_size, read_total: Int64;
 buf: array [0..1024 - 1] of Byte;
 read_current: Integer;
begin

try
s:=uppercase(AThread.Connection.ReadLn);
sCommand:=copy(s,1,3);
sAction:=copy(s,5,length(s));
plist:=TStringList.Create;        
if (sCommand = "SСR") then
   begin
   plist.Clear; plist.AddStrings(GetList(sAction));
   GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

   with TFileStream.Create(ch+"\screen.jpg", fmOpenRead) do
   try
   file_size := Size;
   AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
   read_total := 0;
   while (read_total <> file_size) do
   begin
     read_current := Read(buf, 1024);
     AThread.Connection.WriteBuffer(buf, read_current);
     Inc(read_total, read_current);
   end;
   finally
     Free;
   end;

   AThread.Connection.Disconnect;
   End
except
end;
end;


Клиент:

procedure TForm1.Button1Click(Sender: TObject);
var plist:TStrings;
 buf: array [0..1024 - 1] of Byte;
 file_size, read_current: Int64;
 read_total: Integer;
begin
 plist:=TStringList.Create;
 plist.Clear;
 plist.Insert(0,"SСR:");
 plist.Insert(1,"250");
 plist.Insert(2,"200");
 plist.Insert(3,IntToStr(TrackBar1.Position));
 try
     if IdTCPClient1.connected then IdTCPClient1.DisConnect;
     IdTCPClient1.Host:=Edit1.Text;
     IdTCPClient1.Port:=StrToInt(Edit3.text);
     IdTCPClient1.Connect;
     IdTCPClient1.WriteLn(GiveString(plist));
     if Form1.IdTCPClient1.Socket.Recv(file_size, SizeOf(Int64)) = SizeOf(Int64) then
     begin
     read_total := 0;
     with TFileStream.Create("C:\screen.jpg", fmCreate) do
     try
       while (read_total <> file_size)  do
       begin
         read_current := Form1.IdTCPClient1.Socket.Recv(buf, 1024);
         Write(buf, read_current);
         Inc(read_total, read_current);
       end;
     finally
       Free;
     end;
     end;
     IdTCPClient1.Disconnect;
    if FileExists("C:\screen.jpg") then
     begin
     Image2.Picture.Graphic := nil;
     Image2.Picture.LoadFromFile("C:\screen.jpg");
     if Image2.Picture.Graphic is TJPEGImage then TJPEGImage(Image2.Picture.Graphic).Performance := jpBestSpeed;
     DeleteFile("C:\screen.jpg");
     end;

 except
 end;
end;


---

← →
Сергей М. ©   (2006-10-24 16:59) [18]

> RoLeX   (24.10.06 16:53) [17]


Чудесно.

И какая конкретно строка в этом коде приводит к "ошибке" ?

---

← →
RoLeX   (2006-10-24 17:07) [19]

Если быстро посылать эти запросы, то клиент виснет и потом не оживает.
Смотрим до куда дошла прога, и видим что после запроса файл screen.jpg на машине сервера не обновился.
А если убарть строку
GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));
то как часто не нажимай на кнопку Button1 на клиенте, всё работает ОК.

---

← →
RoLeX   (2006-10-24 17:21) [20]

А что все затихли?
Я вот подумал, а если сделать в процедуре GetScreenImage(); в конце удаление файла screen.jpg, а потом нужно как-то подождать когда появится файл screen.jpg и как только он появился, выполнять оставшийся код (with TFileStream.Create(ch+"\screen.jpg", fmOpenRead) do...)

---

← →
RoLeX   (2006-10-24 18:07) [21]

var stop:boolean;
А если сделать так:
1-я процедура:
stop:=false;
DeleteFile(ch+"screen.jpg");
GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

repeat
2-я процдура:
if Fileexist(ch+"screen.jpg") then stop:=true;
  with TFileStream.Create(ch+"\screen.jpg", fmOpenRead) do
  try
  file_size := Size;
  AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
  read_total := 0;
  while (read_total <> file_size) do
  begin
    read_current := Read(buf, 1024);
    AThread.Connection.WriteBuffer(buf, read_current);
    Inc(read_total, read_current);
  end;
  finally
    Free;
  end;
until stop=true;

Что скажите?

---

← →
RoLeX   (2006-10-24 18:10) [22]

ой... не так :)
Вот:

var stop:boolean;
А если сделать так:
1-я процедура:
stop:=false;
DeleteFile(ch+"screen.jpg");
GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrToInt(plist[3]));

repeat
2-я процдура:
if Fileexist(ch+"screen.jpg") then
begin
 stop:=true;
 with TFileStream.Create(ch+"\screen.jpg", fmOpenRead) do
 try
 file_size := Size;
 AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
 read_total := 0;
 while (read_total <> file_size) do
 begin
   read_current := Read(buf, 1024);
   AThread.Connection.WriteBuffer(buf, read_current);
   Inc(read_total, read_current);
 end;
 finally
   Free;
 end;
end;
until stop=true;

Что скажите?

---

← →
metalfan ©   (2006-10-24 21:34) [23]

ничего хорошего! где stop объявлен?
кибальчиш, почитай про потоки для начала) а то ахинея какая-то выходит...

---

← →
Пусик ©   (2006-10-24 21:44) [24]

> RoLeX   (24.10.06 15:43)


У тебя двойное нажатие на кнопку обрабатывается(с большой вероятностью) - отсюда и ошибка доступа.

---

← →
Сергей М. ©   (2006-10-25 08:08) [25]

> RoLeX   (24.10.06 17:21) [20]
> что все затихли?


Покорнейше ждем-с твоего соизволения ответить на вопрос в [18]..

---

← →
metalfan ©   (2006-10-25 09:47) [26]

> JPEG.SaveToFile(ch+"\screen.jpg");

что за загадочная ch? у тебя два потока в один момент могут выполнить эту строку?... что и должно привести к ошибке, если значение ch одинаково для этих потоков.

---

← →
RoLeX   (2006-10-25 21:53) [27]

> Сергей М. ©   (24.10.06 16:59) [18]
> > RoLeX   (24.10.06 16:53) [17]Чудесно.И какая конкретно
> строка в этом коде приводит к "ошибке" ?

неизвестно какая строка.


> metalfan ©   (25.10.06 09:47) [26]
> > JPEG.SaveToFile(ch+"\screen.jpg");что за загадочная ch?
>  у тебя два потока в один момент могут выполнить эту строку?
> ... что и должно привести к ошибке, если значение ch одинаково
> для этих потоков.

Да, значение ch одинаковое.

---

← →
Anatoly Podgoretsky ©   (2006-10-25 22:59) [28]

Не лез бы ты в потоки.

---

← →
Сергей М. ©   (2006-10-26 09:01) [29]

> RoLeX   (25.10.06 21:53) [27]


> неизвестно какая строка


Ну так выясни !
Отладчик-то на что тебе дан ?

---

← →
RoLeX   (2006-10-26 13:08) [30]

> Anatoly Podgoretsky ©   (25.10.06 22:59) [28]
> Не лез бы ты в потоки.

А разве TCPServer может без потоков?

---

← →
Anatoly Podgoretsky ©   (2006-10-26 13:12) [31]

TCPServer а это что?

---

← →
Сергей М. ©   (2006-10-26 13:14) [32]

> RoLeX   (26.10.06 13:08) [30]


> разве TCPServer может без потоков?


Зависит от BlockMode

---

← →
RoLeX   (2006-10-26 13:18) [33]

> Ну так выясни !Отладчик-то на что тебе дан ?


Пока сделал так:

   if FileExists(ch+"\screen.jpg") then DeleteFile(ch+"\screen.jpg");

   with TFileStream.Create(GetScreenImage(StrToInt(plist[1]),StrToInt(plist[2]),StrTo Int(plist[3])), fmOpenRead) do
   try
   file_size := Size;
   AThread.Connection.WriteBuffer(file_size, SizeOf(Int64));
   read_total := 0;
   while (read_total <> file_size) do
   begin
     read_current := Read(buf, 1024);
     AThread.Connection.WriteBuffer(buf, read_current);
     Inc(read_total, read_current);
   end;
   finally
     Free;
   end;
   AThread.Connection.Disconnect;

Т.е. чтобы полностью завершалась функция GetScreenImage я в её Result сделал адрес (ch + "screen.jpg") и добавил выполнение этой функции в TFileStream.Create(...); чтобы TFileStream не начинала работать раньше времени.
Субъективно стало немного лучше, хотя не факт. Помоему всё зависит от нагруженности процессора, т.е. успеет ли совершиться функция GetScreenImage.

А вылетает ошибка следующая:
Project Project1.exe raised exception class EOutOfResources with message "Не удается найти указанный файл.". Process stopped. Use Step or Run to continue.

---

← →
RoLeX   (2006-10-26 13:20) [34]

> Anatoly Podgoretsky ©   (26.10.06 13:12) [31]
> TCPServer а это что?

См. [17] я там выложил полный код события. А TCPServer это компонент такой. - TidTCPServer.

---

← →
Сергей М. ©   (2006-10-26 13:27) [35]

> вылетает ошибка следующая


Ты вообще русский язык понимать ?)

Вопрос был при выполнении какой конкретно строчки текста твоей программы возникает эта ошибка ?

---

← →
Anatoly Podgoretsky ©   (2006-10-26 13:27) [36]

TidTCPServer без потоков по определению работать не может, но тебе о них не надо заботиться в большинстве случаев.

---

← →
han_malign ©   (2006-10-26 13:46) [37]

> Не лез бы ты в потоки.


>> А разве TCPServer может без потоков?

чудило, "раньше времени" ничего не работает - все работает в свое время
 AThread1   AThread2
  proc1
  proc2      proc1   - "Не удается найти указанный файл."
........................
  proc1      proc1   - "Не удается найти указанный файл."

и даже вызов функции при заполнении списка параметров другой функции - не сделает выполнение функции(ни той, ни другой) атомарной операцией(да и, по сути, практически ничем не отличается от раздельного вызова)...
самое простое
    ch+"\"+IntToHex(AThread.Id)+"\screen.jpg"
- но лучше, всетаки, почитать про потоки и критические секции...

---

← →
RoLeX   (2006-10-26 13:49) [38]

> Anatoly Podgoretsky ©   (26.10.06 13:27) [36]
> TidTCPServer без потоков по определению работать не может,
>  но тебе о них не надо заботиться в большинстве случаев.
>

Ну вот щас понадобилось, так как эти потоки ничего не ждут.


> Вопрос был при выполнении какой конкретно строчки текста
> твоей программы возникает эта ошибка ?

там не показывается. А в шестнадцатеричных кодах окна "CPU" я ничего не понимаю.

---

← →
RoLeX   (2006-10-26 14:01) [39]

> ch+"\"+IntToHex(AThread.Id)+"\screen.jpg"

Не пашет. пишет Id - Undeclared identifier.
Пробовал ch+"\"+IntToHex(AThread.ThreadId)+"\screen.jpg" пишет This is no overloaded version of IntToHex...

---

← →
Сергей М. ©   (2006-10-26 14:07) [40]

> там не показывается. А в шестнадцатеричных кодах окна "CPU"
> я ничего не понимаю


"Там" действительно не показывается. И в тех самых "кодах" понимать тебя никто не заставляет.

От тебя требовалось всего лишь cfvjcnjzntkmyj изучить матчасть на предмет меню "Search -> Find Error ..." либо сообразить (что не так уж сложно) задать контрвопрос "Как определить эту строку ?"

---

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

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

Наверх

Память: 0.56 MB
Время: 0.046 c