[Delphi] Aplikacja konsolowa a ClientSocket

0

Witam
Próbuję stworzyć aplikację konsolową, która łączyłaby się z serwerem HTTP za pomocą ClientSocket'a. No i wszystko szłoby pięknie, gdyby nie jeden problem. A mianowicie nie wiem, jak zatrzymać wykonywanie programu aż do momentu, gdy ściągnę wszystko co potrzebuję. Mam coś takiego:

program Project1;

{$APPTYPE CONSOLE}

uses
  SysUtils, ScktComp, Dialogs;

type
  TMethods = object
    procedure SocketConnect(Sender: TObject; Socket: TCustomWinSocket);
    procedure SocketRead(Sender: TObject; Socket: TCustomWinSocket);
    end;

var
  Methods: TMethods;
  MySocket: TClientSocket;

  Buffer: String;

procedure TMethods.SocketConnect(Sender: TObject; Socket: TCustomWinSocket);
begin
  ShowMessage('Udało się ;)');
  Socket.SendText('GET /ver.php HTTP/1.1'+#13+#10+'Host: www.epsisoft.devtown.net'+#13+#10+#13+#10);
  end;

procedure TMethods.SocketRead(Sender: TObject; Socket: TCustomWinSocket);
begin
  Buffer:=Buffer+Socket.ReceiveText;
  end;

begin
  { TODO -oUser -cConsole Main : Insert code here }
  MySocket:=TClientSocket.Create(nil);
  MySocket.Host:='www.epsisoft.devtown.net';
  MySocket.Port:=80;
  MySocket.OnConnect:=Methods.SocketConnect;
  MySocket.OnRead:=Methods.SocketRead;
  MySocket.Open;

  MySocket.Free;
  end.

Tutaj oczywiście Dialogs jest tylko w celach testowych. No i mam problem. Gdyż program zamyka się natychmiast po uruchomieniu, gdyż dochodzi do end. i koniec. Próbowałem zastosować coś takiego, żeby w odpowiednim miejscu ustawiać zmienną Koniec na true (w obsłudze zdarzeń), a do programu głównego dostawić

repeat Application.ProcessMessages; until Koniec;

, ale takie podeście wymaga niestety dodania unitu Forms do uses (Application jest tam zdefiniowane), a co za tym idzie zwiększenie programu do rozmiarów programu okienkowego. Czy da się to zrobić jakoś inaczej? Tak, żeby nie używać unitów VCL'a?

//Dopisane:
Żeby nie było, że nie szukałem: znalazłem trzy wątki, które w pewien sposób się wiążą z tym tematem:
http://4programmers.net/Forum/viewtopic.php?id=25449
http://4programmers.net/Forum/234211
http://4programmers.net/Forum/55287
jednak żaden z nich nie rozwiązuje mojego problemu...

0

Hmm... Ktos wysłał mi źródło biblioteki Forms.pas. Dzięki temu udało mi się stworzyć coś, co nazwałem MyMessages.pas i wygląda w ten sposób:

unit MyMessages;

interface

uses Windows, Messages, Controls;

type TMessageEvent = procedure (var Msg: TMsg; var Handled: Boolean) of object;

procedure ProcessMessages;

implementation

var
  FOnMessage: TMessageEvent;
  FHintWindow: THintWindow;
  FHintControl: TControl;
  FHintActive: Boolean;
  HintHook: HHOOK;
  HintThread: THandle;
  HintDoneEvent: THandle;
  HintThreadID: DWORD;
  FTimerHandle: Word;
  FDialogHandle: HWnd;
  FTerminate: Boolean;
  
function IsDlgMsg(var Msg: TMsg): Boolean;
begin
  Result := False;
  if FDialogHandle <> 0 then
    Result := IsDialogMessage(FDialogHandle, Msg);
end;

function IsKeyMsg(var Msg: TMsg): Boolean;
var
  Wnd: HWND;
begin
  Result := False;
  with Msg do
    if (Message >= WM_KEYFIRST) and (Message <= WM_KEYLAST) then
    begin
      Wnd := GetCapture;
      if Wnd = 0 then
      begin
        Wnd := HWnd;
{        if (MainForm <> nil) and (Wnd = MainForm.ClientHandle) then
          Wnd := MainForm.Handle
        else}                    //Jak niżej
        begin
          // Find the nearest VCL component.  Non-VCL windows wont know what
          // to do with CN_BASE offset messages anyway.
          // TOleControl.WndProc needs this for TranslateAccelerator
          while (FindControl(Wnd) = nil) and (Wnd <> 0) do
            Wnd := GetParent(Wnd);
          if Wnd = 0 then Wnd := HWnd;
        end;
        if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
          Result := True;
      end
      else if (LongWord(GetWindowLong(Wnd, GWL_HINSTANCE)) = HInstance) then
      begin
        if SendMessage(Wnd, CN_BASE + Message, WParam, LParam) <> 0 then
          Result := True;
      end;
    end;
end;

function IsMDIMsg(var Msg: TMsg): Boolean;
begin
  Result := False;
{  if (MainForm <> nil) and (MainForm.FormStyle = fsMDIForm) and
     (Screen.ActiveForm <> nil) then
    Result := TranslateMDISysAccel(MainForm.ClientHandle, Msg);} //Zakomentowane, bo my nie mamy main form, a nie chce mi się
                                                                 //tego dalej wklejac ;)
end;

procedure StopHintTimer;
begin
  if FTimerHandle <> 0 then
  begin
    KillTimer(0, FTimerHandle);
    FTimerHandle := 0;
  end;
end;

procedure UnhookHintHooks;
begin
  if HintHook <> 0 then UnhookWindowsHookEx(HintHook);
  HintHook := 0;
  if HintThread <> 0 then
  begin
    SetEvent(HintDoneEvent);
    if GetCurrentThreadId <> HintThreadID then
      WaitForSingleObject(HintThread, INFINITE);
    CloseHandle(HintThread);
    HintThread := 0;
  end;
end;

procedure HideHint;
begin
  if (FHintWindow <> nil) and FHintWindow.HandleAllocated and
    IsWindowVisible(FHintWindow.Handle) then
    ShowWindow(FHintWindow.Handle, SW_HIDE);
end;

procedure CancelHint;
begin
  if FHintControl <> nil then
  begin
    HideHint;
    FHintControl := nil;
    FHintActive := False;
    UnhookHintHooks;
    StopHintTimer;
  end;
end;

function IsHintMsg(var Msg: TMsg): Boolean;
begin
  Result := False;
  if (FHintWindow <> nil) and FHintWindow.IsHintMsg(Msg) then
    CancelHint;
end;

function ProcessMessage(var Msg: TMsg): Boolean;
var
  Handled: Boolean;
begin
  Result := False;
  if PeekMessage(Msg, 0, 0, 0, PM_REMOVE) then
  begin
    Result := True;
    if Msg.Message <> WM_QUIT then
    begin
      Handled := False;
      if Assigned(FOnMessage) then FOnMessage(Msg, Handled);
      if not IsHintMsg(Msg) and not Handled and not IsMDIMsg(Msg) and
        not IsKeyMsg(Msg) and not IsDlgMsg(Msg) then
      begin
        TranslateMessage(Msg);
        DispatchMessage(Msg);
      end;
    end
    else
      FTerminate := True;
  end;
end;

procedure ProcessMessages;
var
  Msg: TMsg;
begin
  while ProcessMessage(Msg) do {loop};
  end;

end.

Niestety, po zastąpieniu Forms tym tworem wielkość binarki spadła tylko nieznacznie. Czy jest jakieś inne (efektywniejsze) rozwiązanie? A może to, co podałem wyżej dałoby się jeszcze bardziej okroić, żeby do tego zastosowania wystarczyło, a żeby nie wymagało tylu zewnętrznych bibliotek (obawiam się, że Messages i Controls są głównymi sprawcami tutaj, nie liczę, by Windows można było jakoś wyeliminować).

0

a skąd wiesz, że ściągnąłeś wszystko?

0

to czego szukasz to ApplicationUnit.pas aphex`a

0

Woj: Dzięki! Właśnie o to chodziło :]
Misiekd: Nie wiem, że ściągnąłem całość :]. To, co podałem to był najprostszy przykład. Do działania wystarczyłoby mi, żebym dostał jeden znaczek nagłówka. W tym momencie mój programik (na dysku) sprawdza wszystko ładnie, analizuje nagłówki HTTP itp., ale to nie było obiektem mojego pytania, więc nie chciałem, by coś takiego bezpotrzebnie zaśmiecało post.

0
Adam.Pilorz napisał(a)

Misiekd: Nie wiem, że ściągnąłem całość :]. To, co podałem to był najprostszy przykład. Do działania wystarczyłoby mi, żebym dostał jeden znaczek nagłówka. W tym momencie mój programik (na dysku) sprawdza wszystko ładnie, analizuje nagłówki HTTP itp., ale to nie było obiektem mojego pytania, więc nie chciałem, by coś takiego bezpotrzebnie zaśmiecało post.

Pytałem dlatego, bo jeśli np. wiedział byś kiedy wszystko zostanie zakończone, to wystarczyła by jakaś pętla na końcu

while not Koniec do
begin
  sleep(1000);;
end;

tyle, że ten obiekt wsadzasz w wątek, a w wątku jak skończy to Koniec := True i tyle

0

Mógłbym, ale to rozwiązanie ma dwie wady:

  1. Sam główny program "wieszałby się" przez pętlę ze sleep'em, aż do skończenia pobierania. W momencie, gdy mam Application.ProcessMessages; to ten efekt nie ma miejsca.
  2. Musiałbym bawić się z wątkami, co wydaje mi się tutaj raczej niepotrzebne. A nie mam w nich takiego doświadczenia, by to były dla mnie dwie minuty, żeby to do wątku wrzucić. Szczerze powiedziawszy, nie mam w ręcznej obsłudze wątków żadnego doświadczenia chyba ;).

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