Simple Chat Server

piechnat

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

10 komentarzy

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)

Fajny arcik :D

Stary uratowałes mnie :)

Ja osobiescie dodal bym do arta kod źrodlowy z forma itp...

pozdrawiam

Bardzo dobra rzetelna robota. gratuluje

Artykuł naprawdę bardzo dobry. Gdyby wszystkie takie były!!!!

Full professional. Extra. Dawno tak dobrego artu nie czytałem. Pozdro dla wszystkich sieciowych programistów.

Cześć! No, no, no, piękny arcik :) brawo :)

wow, tak powinien wyglądać każdy artykuł.