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

Вниз

Проблема с WebModule1   Найти похожие ветки 

← →
raslmc ©   (2009-08-18 19:37) [0]

Добрый день.
Пытаюсь создать модуль для Apache.
Есть вот такой код:


procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
 Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
 var
 s: string;
 n: integer;
 Stream: TMemoryStream;
begin

Response.ContentType := "application/octet-stream";
Stream := TMemoryStream.Create;

s := "Hello WorldHello WorldHello WorldHello WorldHello ";
Stream.Write(s[1], length(s));
Stream.Position := 0;

try
   for n := 1 to 1024 do
    begin            
      Response.SendStream(Stream);
      sleep(20);
    end;
 finally
     Stream.Free;      
 end;
end;


После подключения клиента срабатывает событие
WebModule1WebActionItem1Action и начинается отправка файла клиенту. Для примера отправляю ерунду.
Проблема в том, если клиент отсоединится во время отправки,
сама отправка все равно рабоает. События OnDisconnect не нашел. Скажите можно ли как то узнатьчто клиент отключился чтобы прервать отправку? К примеру:

...
for n := 1 to 1024 do
    begin      
      if client.disconnected then break;
      Response.SendStream(Stream);
      sleep(20);
    end;
...


Спасибо

---

← →
Сергей М. ©   (2009-08-18 22:03) [1]

> отправка все равно рабоает


На основание чего сделано сие умозаключение ?

---

← →
raslmc ©   (2009-08-18 22:24) [2]

На основании этого:


procedure Log(str: string);
 var f: TFileStream;
begin
 str := str + #13#10;
 f := TFileStream.Create("c:\log.txt", fmOpenWrite);
 f.Position := f.Size;
 f.Write(str[1], length(str));
 f.Free;
end;

procedure TWebModule1.WebModule1WebActionItem1Action(Sender: TObject;
Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
s: string;
n: integer;
Stream: TMemoryStream;
begin

Log("Connected "+ DateTimeToStr(Now));

Response.ContentType := "application/octet-stream";
Stream := TMemoryStream.Create;

s := "Hello WorldHello WorldHello WorldHello WorldHello ";
Stream.Write(s[1], length(s));
Stream.Position := 0;

try
  for n := 1 to 1024 do
   begin            
     Response.SendStream(Stream);
     sleep(20);
   end;
finally
    Stream.Free;      
     Log("Disconnected "+ DateTimeToStr(Now));
end;
end;


Объясню.
Когда клиент подключается в лог файл записывается
Log("Connected "+ DateTimeToStr(Now));
И начинается отправка.
В конце отправки Log("Disconnected "+ DateTimeToStr(Now));

По идее, если клиент оборвет связь во время приема информации от сервера, сервер должен завершить
Response.SendStream(Stream);
ошибкой, либо просто закрыть поток.
Но после обрыва соединения поток все равно работает до конца.
В данном примере отправка занимает 20 секунд. И все 20 секунд поток висит и отправляет. Что при отправки больших файлов и большой нагруженности не есть хорошо.

---

← →
Сергей М. ©   (2009-08-19 08:42) [3]

Вникни в это:

function TApacheRequest.WriteClient(var Buffer; Count: Integer): Integer;
begin
 Result := 0;
 if Count > 0 then
   Result := ap_rwrite(Buffer, Count, FRequest_rec) //<-- вот здесь выполняется собственно отправка
end;

procedure TApacheTwoResponse.SendStream(AStream: TStream);
var
 Buffer: array[0..8191] of Byte;
 BytesToSend: Integer;
begin
 while AStream.Position < AStream.Size do
 begin
   BytesToSend := AStream.Read(Buffer, SizeOf(Buffer));
   FHTTPRequest.WriteClient(Buffer, BytesToSend); //<-- к сожалению, результат вызова метода игнорируется
 end;
end;


---

← →
raslmc ©   (2009-08-19 09:08) [4]

Уважаемый Сергей.
Благодарю за Ваш пинок. Помогло.
Вот решение:

В ApacheTwoHTTP нужно добавить

TApacheTwoResponse = class(TWebResponse)
 private
 ...
 public
 ...
 function  SendStream2(AStream: TStream): Integer;
 ...
 end;
.......

function TApacheTwoResponse.SendStream2(AStream: TStream): Integer;
var
 Buffer: array[0..8191] of Byte;
 BytesToSend: Integer;
begin
 while AStream.Position < AStream.Size do
 begin
   BytesToSend := AStream.Read(Buffer, SizeOf(Buffer));
   result := FHTTPRequest.WriteClient(Buffer, BytesToSend);
 end;
end;


А вот определяем, что клиент отключился и завершаем цикл:

Request: TWebRequest; Response: TWebResponse; var Handled: Boolean);
var
s: string;
n: integer;
Stream: TMemoryStream;
begin

Log("Connected "+ DateTimeToStr(Now));

Response.ContentType := "application/octet-stream";
Stream := TMemoryStream.Create;

s := "Hello WorldHello WorldHello WorldHello WorldHello ";
Stream.Write(s[1], length(s));
Stream.Position := 0;

try
 for n := 1 to 1024 do
  begin            
    if TApacheTwoResponse(Response).SendStream2(Stream) < 0 then break;
    sleep(20);
  end;
finally
   Stream.Free;      
    Log("Disconnected "+ DateTimeToStr(Now));
end;
end;


P.S. файл ApacheTwoHTTP.pas должен находится в одной папке с проектом.
Спасибо.

---

← →
Сергей М. ©   (2009-08-19 09:37) [5]

> нужно добавить


Если уж на то пошло, то можно было и не добавлять новый метод SendStream2, а просто подзаточить имеющийся процедурный SendStream, сделав его функциональным.

---

← →
Сергей М. ©   (2009-08-19 09:47) [6]

Т.е.

TWebResponse = class(TObject)
..
  function SendStream(AStream: TStream): Integer; virtual; abstract;
..
end;

TApacheTwoResponse = class(TWebResponse)
..
  function SendStream(AStream: TStream): Integer; override;
..
end;

Тогда это избавит от необходимости явного приведения типа в строке

if TApacheTwoResponse(Response).SendStream2(Stream) < 0 then break;

Просто
if Response.SendStream(Stream) < 0 then break;

---

← →
raslmc ©   (2009-08-19 10:42) [7]

Спасибо.
Правда пришлось еще несколько файлов из папки
Delphi7\Source\Internet скопировать в папку с программой.

---

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

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

Наверх

Память: 0.47 MB
Время: 0.004 c