Problem z socketem w konsoli

0

Mam pewien problem. Pisze program w okienkach, i działa cacy. Potem próbuję wrzucić go jako konsolowy, i nie działa.

Program powinien być prostym serwerem HTTP. Od przegladarki info dostaje cacy, tymczasem do przegladarki juz dane nie leca, i nie bardzo wiem, co jest tego powodem.

Oczywiscie wiem, ze program na kazde zadanie na razie odpowie tak samo nie zaleznie od tego, czy to przegladarka wysle czy cokolwiek, ale tym sie pozniej zajme, najpierw chce, zeby cokolwiek dzialalo.

Oto pełny kod programu w konsoli:

program http_serw;

{$R *.res}
{$APPTYPE CONSOLE}
uses
sockets, classes, SysUtils; //, txtprocs in 'txtprocs.pas';

var TcpServer1: TTcpServer;

procedure TcpServerAccept(Sender: TObject;
ClientSocket: TCustomIpClient);
var s:string;
p:integer;
begin
s := ClientSocket.Receiveln;
while (s <> '') do
begin
s := ClientSocket.Receiveln;
end;

writeln('GET');
s:='';
s:=s+'HTTP/1.0 200 OK' + #13#10;
s:=s+'Content-Type: text/html' + #13#10;
s:=s+#10#13;
s:=s+'DZIALA';
ClientSocket.Sendln(s);
end;

begin
TcpServer1:=TTcpServer.Create(nil);
TcpServer1.LocalHost:='localhost';
TcpServer1.LocalPort:='82';
TcpServer1.BlockMode:=bmThreadBlocking;
TcpServer1.Name:='TcpServer1';
@TcpServer1.OnAccept:=@TcpServerAccept;
TcpServer1.Active:=true;
if not TcpServer1.Listening then
begin
writeln('Nie słuchan!!!???');
end else writeln('Slucham');

readln;

TcpServer1.Active:=false;
TcpServer1.Free;
end.

0

Sprawa prosta - wykonujesz prockę, która kończy działanie programu, w międzyczasie nie pozwalając zareagować. Użyj pętli z ProcessMessages (jeśli chcesz ograniczyć rozmiar programu nie używając modułu Forms, to jest gdzieś dostępny moduł zastępczy, który pozwala to zrobić - link gdzieś jest na forum, kiedyś o to pytałem).

0

Znalazłem na forum tą funkcję, ale wygląda na to, że nadal to samo się dzieje.

dodałem

procedure MyProcessMessages;
var
  Msg: TMsg;
begin
  while PeekMessage(Msg, 0, 0, 0, PM_REMOVE) do
  begin
    if Msg.Message <> WM_QUIT then
    begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
    end else
    begin
        stop:=true;
    end;
  end;
end;

a zamiast readln dałem

   repeat
       MyProcessMessages;
   until stop;

ale nadal nic do przeglądarki nie dociera.

BTW: Jakiś pomysł jak zrobić, żeby to nie zżerało procka na maxa? Ale bez sleepa wewnątrz repeata, bo przy większej ilości żądań sleep spowodował by, że serwer nie obsłuży tego wszystkiego.
Ale to mniej istotne, bo to i tak będzie najważniejszy program na serwerze, gdy to skończę, a serwer będzie cały dla mnie.

0

OK, to powiem, co jeszcze znalazłem.
W helpie do winsocka pisze tak:

For non-blocking sockets, the data is sent to the WinSock DLL which has it's own internal buffers. If the WinSock can accept additional data, SendBuf returns immediately with the number of bytes queued. If the WinSock internal buffer space is not able to accept the buffer being sent, SendBuf returns -1 and no data is queued at all. In this case, wait a bit for the WinSock to have a chance to send out already-queued data; then try again.

For blocking sockets, SendBuf returns the number of bytes actually written.

Teoretycznie defaultowo jest ustawione BlockMode na ThreadBlocking, i tak jest, jak sprawdzam.
sendbuf (oraz SendLn) zwraca mi jednak zawsze wartośc -1. Oczywiście próbowałem czekać, i powtarzać próbę, gdy jest to -1, ale to nic nie daje oczywiscie.

Może gdzieś coś źle zainicjowałem?

1 użytkowników online, w tym zalogowanych: 0, gości: 1