Simple Chat Server :: 4programmers.net

Wstęp

Simple Chat Server jest tylko pretekstem. Jak wiadomo nikt przy zdrowych zmysłach nie uruchamia żadnych usług sieciowych pod systemem Windows, a serwer ten i tak jest na prawdę ubogi w swoich możliwościach. Jest to jednak okazja do przedstawienia kilku funkcji z WinAPI i pokazania szkieletu takiego sieciowego programu.

Założenia

Nasz serwer będzie włączał się od razu po uruchomieniu programu. Tak więc jedyny parametr, jakim jest port na którym ma nasłuchiwać, wprowadzany będzie z wiersza poleceń.

Po uruchomieniu będzie on akceptował połączenia klientów i tworzył dla nich osobne wątki (wszystko to w nieskończonej pętli).

W każdym z wątków dane odebrane z gniazda zostaną wysłane do wszystkich połączonych klientów (także w pętli nieskończonej).

Na zakończenie trzeba będzie jakoś zatrzymać to "cudo". Z pomocą przyjdzie funkcja SetConsoleCtrlHandler() do której można wprowadzić adres funkcji (HandlerRoutine) przechwytującej sygnały wysyłane do procesu konsoli, takie jak CTRL+C, CTRL+BREAK, zamknięcie konsoli, wylogowanie użytkownika czy zamknięcie systemu. W tej że funkcji zwrócimy wartość True co uniemożliwi zatrzymanie programu, żebyśmy mogli zamknąć wszystkie gniazda, przerwać pętle i z godnością zatrzymać nasz serwer.

Zaczynamy

Jedyne moduły jakie będą nam potrzebne to Windows i WinSock. Przyda się także dodatkowy typ, wskaźnik na Integer, ponieważ tylko w takiej postaci można przekazać zmienną do nowego wątku.

  type
    PInteger = ^Integer;

Zmienne globalne:

  var
    I: Integer;
    Tmp: DWord;
      // zmienne pomocnicze
    Port: Word;
      // port na którym nasłuchuje serwer
    Sock: TSocket;
      // deskryptor gniazda serwera
    PInt: PInteger;
      // wskaźnik na integer
    WSAData: TWSAData;
      // przetrzymuje dane o implementacji winsock
    AdrL, AdrR: TSockAddrIn;
      // struktury sockaddrin
    Clnts: Array of TSocket;
      // tablica z deskryptorami gniazd klientów

Na początku programu wypada przekonwertować parametr z wiersza poleceń do zmiennej Port. Do takiej konwersji można użyć funkcji Val() z której korzysta funkcja StrToInt() z modułu SysUtils.

  Val(ParamStr(1), Port, Tmp);

Dalej inicjalizujemy użycie biblioteki Windows Sockets DLL w wersji 1.1 po przez funkcje WSAStartUp().

  WSAStartUp(MAKEWORD(1,1), WSAData);

Tworzymy standardowe gniazdo do komunikacji TCP funkcją socket().

  Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);

Przypisujemy mu adres i port przy pomocy funkcji bind() oraz struktury sockaddrin.

  AdrL.sin_family := AF_INET;
  AdrL.sin_addr.S_addr := htonl(INADDR_ANY);
  AdrL.sin_port := htons(Port);
  bind(Sock, AdrL, SizeOf(AdrL));

Ustawiamy je w tryb nasłuchiwania funkcją listen().

  listen(Sock, 5)

Teraz najważniejsza część czyli odbieranie połączeń z naszym serwerem. Służy do tego funkcja accept(), która wstrzymuje działanie programu do czasu gdy ktoś się z nami połączy. Jeżeli wystąpi błąd lub gniazdo zostanie zamknięte funkcja zwróci wartość INVALID_SOCKET w przeciwnym wypadku otrzymamy deskryptor nowego gniazda. Musimy umieścić go w tablicy Clnts gdyż później będzie nam potrzebny do komunikacji z klientem.

  repeat
    I := 0;
    while I < Length(Clnts) do begin
      // szukamy wolnego miejsca w tablicy Clnts
      if Clnts[I] = INVALID_SOCKET then Break;
      Inc(I);
    end;
    if I = Length(Clnts) then SetLength(Clnts, I + 1);
      // jeżeli nie ma wolnego miejsca powiększamy tablicę
    Tmp := SizeOf(AdrR);
    Clnts[I] := accept(Sock, @AdrR, @Tmp);
      // czekamy na połączenie
    if Clnts[I] = INVALID_SOCKET then Break;
      // jeśli gniazdo zostało zamknięte lub wystąpił błąd
      // przerywamy pętlę i wychodzimy z programu
 
      // reszta kodu za chwilę...
      // ...
  until False;

Przyszedł czas na stworzenie nowego wątku dla połączenia i przekazanie do niego zmiennej I po to żeby "wiedział" na którym miejscu w tablicy Clnts znajduje się jego gniazdo. Posłużymy się funkcją CreateThread(). Jej trzeci parametr to właśnie adres procedury która ma wykonać się w nowym wątku. Czwartym argumentem jest wskaźnik do zmiennej.

  repeat 
    // ...
    // reszta kodu teraz...
 
    New(PInt);   // tworzymy zmienną dynamiczną
    PInt^ := I;  // przypisujemy jej index z tablicy Clnts
    CreateThread(nil, 0, @SockThread, PInt, 0, Tmp);
      // odpalamy procedurę SockThread w osobnym wątku
      // i przesyłamy do niej index z tablicy Clnts
  until False;

Musimy jeszcze zdefiniować procedurę SockThread, w której będziemy odbierać dane od klienta przy pomocy recv() i wysyłać do wszystkich funkcją send().

  procedure SockThread(Pint: PInteger); stdcall;
  var
    Size, I: Integer;
    Buff: Array[0..1023] of Char;
  begin
    repeat
      Size := recv(Clnts[PInt^], Buff[0], SizeOf(Buff), 0);
        // czekamy na dane od klienta
        // recv() zwróci ilość odczytanych bajtów
      if Size < 1 then Break;
        // jeśli recv() zwróci 0 to znaczy że klient się rozłączył
        // jeśli -1 to znaczy że wystąpił błąd, tak czy inaczej
        // należy przerwać pętlę
      for I := 0 to Length(Clnts) -1 do
        // odsyłamy dane do wszystkich klientów
        // (jest to punkt kulminacyjny programu ;-) )
        if Clnts[I] <> INVALID_SOCKET then
          send(Clnts[I], Buff[0], Size, 0);
    until False;
    shutdown(Clnts[PInt^], SD_BOTH);  // blokujemy przepływ danych
    closesocket(Clnts[PInt^]);        // zamykamy gniazdo
    Clnts[PInt^] := INVALID_SOCKET;   // zwalniamy miejsce w tablicy
    Dispose(PInt);                    // niszczymy zmienną dynamiczną
  end;

Na zakończenie trzeba obsłużyć wspomniane wcześniej sygnały zatrzymujące naszą aplikację konsolową. Do tego należy zdefiniować funkcję HandlerRoutine i skojarzyć ją z naszą konsolą.

  function HandlerRoutine(CtrlType: DWord): Bool; stdcall;
  var
    I: Integer;
  begin
    closesocket(Sock);
      // zamykamy gniazdo przerywając nieskończoną pętlę główną
    for I := 0 to Length(Clnts) -1 do
      if Clnts[I] <> INVALID_SOCKET then begin
        // zamykamy gniazda klientów przerywając ich pętle
        shutdown(Clnts[I], SD_BOTH);
        closesocket(Clnts[I]);
      end;
    Result := True; 
      // zwrcamy True uniemożliwiając zamknięcie konsoli
  end;

Gdzieś na początku programu należy umieścić taką linijkę:

  SetConsoleCtrlHandler(@HandlerRoutine, True);

To już chyba wszystko...

Simple Chat Server

A teraz kompletny kod programu. Wystarczy wkleić do edytora Delphi i wcisnąć F9.

program ChatServ;
{$APPTYPE CONSOLE}
 
uses
  Windows, WinSock;
 
type
  PInteger = ^Integer;
 
var
  I: Integer;
  Tmp: DWord;
  Port: Word;
  Sock: TSocket;
  PInt: PInteger;
  WSAData: TWSAData;
  AdrL, AdrR: TSockAddrIn;
  Clnts: Array of TSocket;
 
procedure SockThread(Pint: PInteger); stdcall;
var
  Size, I: Integer;
  Buff: Array[0..1023] of Char;
begin
  repeat
    Size := recv(Clnts[PInt^], Buff[0], SizeOf(Buff), 0);
    if Size < 1 then Break;
    for I := 0 to Length(Clnts) -1 do
      if Clnts[I] <> INVALID_SOCKET then
        send(Clnts[I], Buff[0], Size, 0);
  until False;
  shutdown(Clnts[PInt^], SD_BOTH);
  closesocket(Clnts[PInt^]);
  Clnts[PInt^] := INVALID_SOCKET;
  Dispose(PInt);
end;
 
function HandlerRoutine(CtrlType: DWord): Bool; stdcall;
var
  I: Integer;
begin
  closesocket(Sock);
  for I := 0 to Length(Clnts) -1 do
    if Clnts[I] <> INVALID_SOCKET then begin
      shutdown(Clnts[I], SD_BOTH);
      closesocket(Clnts[I]);
    end;
  Result := True;
end;
 
begin
  Val(ParamStr(1), Port, Tmp);
  if Port = 0 then begin
    WriteLn('Nieprawidlowy port.');
    Halt(0);
  end;
  if WSAStartUp(MAKEWORD(1,1), WSAData) <> 0 then begin
    WriteLn('Blad Windows Sockets DLL.');
    Halt(0);
  end;
  Sock := socket(AF_INET, SOCK_STREAM, IPPROTO_TCP);
  AdrL.sin_family := AF_INET;
  AdrL.sin_addr.S_addr := htonl(INADDR_ANY);
  AdrL.sin_port := htons(Port);
  bind(Sock, AdrL, SizeOf(AdrL));
  if listen(Sock, 5) = SOCKET_ERROR then begin
    WriteLn('Blad gniazda.');
    Exit;
  end;
  SetConsoleCtrlHandler(@HandlerRoutine, True);
  WriteLn('Serwer uruchomiony na porcie ',Port,'...');
  repeat
    I := 0;
    while I < Length(Clnts) do begin
      if Clnts[I] = INVALID_SOCKET then Break;
      Inc(I);
    end;
    if I = Length(Clnts) then SetLength(Clnts, I + 1);
    Tmp := SizeOf(AdrR);
    Clnts[I] := accept(Sock, @AdrR, @Tmp);
    if Clnts[I] = INVALID_SOCKET then Break;
    New(PInt);
    PInt^ := I;
    CreateThread(nil, 0, @SockThread, PInt, 0, Tmp);
  until False;
  WriteLn('Serwer zatrzymany.');
  WSACleanUp();
  Halt(0);
end.

Na zakończenie

Nie jest to na pewno nic specjalnego, ale można już zacząć kombinować i rozbudowywać taki serwer a co najważniejsze mieć satysfakcję z tego że nie korzystało się z żadnych komponentów. Jeżeli chodzi o jakiś przykład klienta którym można by przetestować nasz serwer to najprościej otworzyć Delphi i wstawić na formę komponenty Edit, Memo oraz ClientSocket.

W zdarzeniu OnCreate formy wstawić taki kod:

  procedure TMyForm.FormCreate(Sender: TObject);
  begin
    ClientSocket.Address := '127.0.0.1';
    ClientSocket.Port := 12345;
    ClientSocket.Active := True;
  end;

W zdarzeniu OnRead komponentu ClientSocket dać:

  procedure TMyForm.ClientSocketRead(Sender: TObject;
    Socket: TCustomWinSocket);
  begin
    Memo.Lines.Add(Socket.ReceiveText);
  end;

A zdarzenie OnKeyPress komponentu Edit oprogramować tak:

  procedure TMyForm.EditKeyPress(Sender: TObject; var Key: Char);
  begin
    if Key = #13 then begin
      ClientSocket.Socket.SendText(Edit.Text);
      Edit.Text := '';
      Key := #0;
    end;
  end;

Mam nadzieję że cokolwiek z tego co tu napisałem komuś się przyda. Jeżeli coś byłoby niezrozumiałe to zachęcam do przejrzenia WinSDK i oczywiście korzystania z Google.

pozdrawiam...
Mateusz Piechnat

Kategoria: Delphi » Gotowce

10 komentarzy

Napisany 2009-06-05 19:04 przez krwq

super :) co prawda pisze w c++, ale kod jest bardzo latwo przenosny :) dobrze ze nie ma tu zbednych rzeczy ktore nie nalezą do ideii serwera (obsluga okna itp itd)

Napisany 2008-06-28 21:37 przez adus41

Fajny arcik :D

Napisany 2006-01-29 13:30 przez _fan_pascala

Stary uratowałes mnie :)