В событии 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]

TCPServer а это что?

> 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.

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

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

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

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

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

>> А разве 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...

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

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

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

> cfvjcnjzntkmyj

самостоятельно

← →
RoLeX (2006-10-26 14:24) [42]

Не получается. Ввожу адрес ошибки (который в первом столбце самого большого фрейма окошка CPU) и он меня отправляет на строку с этим адресом окна CPU, а в исходниках ничего не подсвечивается и т.д.

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