Example of using winsock (sockets) ultibo and Windows

Discussion and questions about programming with Ultibo.
jefferobertson
Posts: 8
Joined: Fri Aug 10, 2018 4:29 pm

Example of using winsock (sockets) ultibo and Windows

Postby jefferobertson » Fri Sep 07, 2018 12:57 pm

I was looking for a good Free Pascal winsock (socket) example. I could not find one so I made one. The basic socket code works on both a Windows PC and ultibo. The main is a bit different on both.

Common winsock code

Code: Select all

unit WinSock2_Example;

{$mode objfpc}{$H+}

interface           
uses
  Classes, SysUtils,
  WinSock2
  ;



  procedure Server_Test(server_port: integer);
  procedure Client_Test(server_name: AnsiString; server_port: integer);

  implementation

  //
  // Return the IP address of the host identified by host_data
  //
  function IP(host_data: PHostEnt): String;
  var
    ip_address: String;
  begin

    //
    // This is the magic formula to extract the IP address from the host data
    // Cannot claim I figure this out on my own :-).  I stole it from
    // the following C code (not that it makes it much clearer)
    // inet_ntoa (*(struct in_addr *)*host_entry->h_addr_list);
    ip_address := String(Winsock2.inet_ntoa(PInAddr(host_data^.h_addr_list^)^));
    exit(ip_address);
  end;

  //
  // Both Clients and Servers start by defining a basic socket
  // In theory the parameters to Winsock2.socket might change,
  // but I have never seen a real case.
  //
  function Basic_Socket(): Winsock2.TSocket;
  begin
    Basic_Socket := Winsock2.socket(Winsock2.AF_INET, Winsock2.SOCK_STREAM, 0);
    if (Basic_Socket = Winsock2.INVALID_SOCKET) then
    begin
      Writeln('Cound not create socket');
      exit;
    end;
    exit;
  end;

  //
  // On a PC all of the socket stuff is pretty much initialized
  // befor the program executes.  On a PI the processor has (usually)
  // not yet started the ethernet port, received an IP address etc.
  // So we do some polling.
  //
  procedure Initialize_Winsock;
  var
    WSData: TWSAData;
    cnt: integer;
    status: Longint;
    name: AnsiString;
    error: string;
    ip_address: string;
    host_data: PHostEnt;
  begin

    Winsock2.WSAStartup(WINSOCK_VERSION, WSData);

    // Need to reserve enough space in name to save the host name.
    SetLength(name, 255);

    // don't think this usually fails, but lets be safe.
    repeat
      status := Winsock2.gethostname(PChar(name),255);
      name := String(PChar(name));
      if (status < 0) then
      begin
        error := IntToStr(WinSock2.WSAGetLastError());
        WriteLn('GetLastError = ' + error);
        Sleep(1000);
      end
      else
      begin
        WriteLn('Hostname = ' + name);
      end;
    until (status >= 0);

    //
    // The gethostbyname usually fails the first couple of times
    // there are a couple of different failure patterns in the loop
    cnt := 0;
    repeat
      // if not the first time through the loop sleep a bit.
      if (cnt > 0)  then Sleep(1000);
      WriteLn('Checking for ip info');
      host_data := Winsock2.gethostbyname(PChar(name));

      //
      // First failure is that host_data is nil
      // This does happen, so check for it.
      if (host_data = nil) then
      begin
        ip_address := '';
      end
      else begin
        //
        // got some host data, lets get the ip address.
        ip_address := IP(host_data);
        Writeln('PHostEnt.h_addr_list = ' + ip_address);
      end;
      cnt := cnt + 1;
      //
      // for several calls, even if host data is not nil, the ip_address has
      // not been set.  The processor is asking the router (DHCP I suppose)
      // but has not yet been assigned an ip address.
    until (host_data <> nil) and ((ip_address <> '') and (ip_address <> '0.0.0.0'));

    // we are ready to rock and roll.
    Writeln('PHostEnt.hostname = ' + host_data^.h_name);
    Writeln('PHostEnt.h_addr_list = ' + ip_address)
  end;

  //
  // See definition below
  procedure Server_Process_Client(client_socket: Winsock2.TSocket;
                                  client_info: Winsock2.TSockAddr); forward;


  //
  // A server operates on multiple sockets.
  // One is a listening socket (defined and used here)
  // and the other is (potentially multiple) client sockets used
  // to comunicate with a client when it attaches to the server.
  // The processing of client messages is done in Server_Process_Client.
  procedure Do_Server(server_port: integer);
  var
    error: string;
    size: integer;
    listening_socket: Winsock2.TSocket;
    listening_parms:  Winsock2.TSockAddr;
    client_info: Winsock2.TSockAddr;
    client_socket: Winsock2.TSocket;

  begin
    //
    // create a listening socket
    //

    Writeln('Create a listening socket');

    // get socket framework
    listening_socket := Basic_Socket();

    //
    // set listening socket parameters
    //
    listening_parms.sin_family := Winsock2.AF_INET;
    listening_parms.sin_addr.s_addr := Winsock2.INADDR_ANY;

    // something funny about htons on ultibo PI that makes me assign
    // server port to sin_port and thnen htons it.  Probably a data type
    // conversion goint to htons.
    listening_parms.sin_port := server_port;
    listening_parms.sin_port := Winsock2.htons(listening_parms.sin_port);

    //Bind
    if( Winsock2.bind(listening_socket, @listening_parms , sizeof(listening_parms)) = Winsock2.SOCKET_ERROR) then
    begin
      Writeln('Cound not bind socket');
    end;

    //
    // start listening for connects to the server.
    //
    Winsock2.listen(listening_socket,3);

    //
    // At this point clients can begin to connect to the server.
    //

    //
    // Server is going to run forever.
    //
    while (true) do
    begin


      //
      // Winsock2.accept is a blocking call, when a client attaches
      // it returns with a valid (not -1) socket id which is used
      // to talk to the client.
      Writeln('Waiting for a clint to connect to port ' + IntToStr(server_port));
      size := sizeof(client_info);
      client_socket := Winsock2.accept(listening_socket , @client_info, size);

      // if not valid
      if (client_socket = $FFFFFFFF) then
      begin
        error := IntToStr(WinSock2.WSAGetLastError());
        WriteLn('GetLastError = ' + error);
      end
      else
      begin
        //
        // most servers would start a thread her to service the clinet
        // Not that ambitious.  The thread could either be started here
        // or within Server_Process_Client.  However it is done
        // the Server_Process_Client should be made responsible for
        // the client_socket and should close it when done.
        //
        Writeln('Got a Client');
        Server_Process_Client(client_socket, client_info);
      end;

    end;

    // if the server ever exited, it would close the listening_socket.
    Winsock2.closesocket(listening_socket);
  end;



  //
  //
  procedure Server_Process_Client(client_socket: Winsock2.TSocket;
                                  client_info: Winsock2.TSockAddr);
  var 
    receive_buffer: AnsiString;
    send_buffer: AnsiString;
    size: integer;
  begin

    //
    // process client commands until client closes the connection
    repeat
      // reserve space for receive_buffer, not sure I have to do this
      // everytime, but I am being safe.
      SetLength(receive_buffer, 1024);

      //
      // recv returns the number of byte in its streaming buffer up to
      // the length parameter.  Sockets are not record based operations
      // so it does not mean that if a client sends 256 bytes that you will
      // receive all of them on one recv call.  You could receive less or more
      // (if multiple sends were combined into one ethernet packet for instance)
      // When I care about record like messages I usually send the size (in one word)
      // of the record and the rest of the size bytes in the following.
      // I first read the size, and then I keep reading (appending as needed)
      // until I receive all of the expected bytes.
      // In this example I did not care.
      //
      // recv is blocking
      size := Winsock2.recv(client_socket, PChar(receive_buffer), 1024, 0);

      //
      // recv returns the number bytes read.  If that value is > 0 then
      // we got a message, else the client has closed the socket.
      if (size > 0 ) then
      begin
        //
        // got some data, do something with it.
        receive_buffer[size+1] := Char(0);
        receive_buffer := String(pChar(receive_buffer));
        Writeln('Message from client = ' + receive_buffer);
        send_buffer := 'To Client ' + receive_buffer;
        Writeln('Message to client = ' + send_buffer);
        Winsock2.send(client_socket, PChar(send_buffer), Length(send_buffer),0);
      end;
    until size <= 0;  // exit loop if client has closed the socket
    //
    // close the server end of the client socket.
    // If the server wants to initiate the close, it can close the client
    // socket.  The client will receive a size <= 0 on its next call to recv
    // and can act accordingly.
    //
    Winsock2.closesocket(client_socket);
  end;

  //
  // Server_Test performs the server side of a client/server socket
  // interface.
  // This server is designed to work with Client_Test below.
  procedure Server_Test(server_port: integer);
  begin
    Initialize_Winsock();
    Do_Server(server_port);
  end;

  procedure Client_Test(server_name: AnsiString; server_port: integer);
  var
    server_info: PHostEnt;
    ip_address: string;
    to_server_parms:  Winsock2.TSockAddr; 
    to_server: Winsock2.TSocket;


    receive_buffer: AnsiString;
    send_buffer: AnsiString;
    size: integer;
    cnt: integer;
  begin   
    Initialize_Winsock();
    server_info := Winsock2.gethostbyname(PChar(server_name));
    ip_address := IP(server_info);
    writeln('server ' + server_name + ' is at ' +  ip_address);


    //
    // set my to_server socket parameters
    //
    to_server_parms.sin_family := Winsock2.AF_INET;
    to_server_parms.sin_addr.s_addr := Winsock2.inet_addr(PChar(ip_address));

    to_server_parms.sin_port := server_port;
    to_server_parms.sin_port := Winsock2.htons(to_server_parms.sin_port);

    //
    // create my to_server socket
    to_server := Basic_Socket();

    //
    // loop trying to connect to server
    //
    while (Winsock2.connect(to_server, to_server_parms, sizeof(to_server_parms)) < 0)
    do begin
       writeln('Failed to connect to server ' + server_name + ' at ' + ip_address + ' port ' + InttoStr(server_port));
       Sleep(1000);
    end;

    //
    // connected to the server, send it some data (which it echos back)
    //
    cnt := 0;
    repeat
      send_buffer := 'Sending to Server Msg #' + InttoStr(cnt);
      writeln(send_buffer);
      cnt := cnt + 1;
      Winsock2.send(to_server, PChar(send_buffer), Length(send_buffer),0);
      SetLength(receive_buffer, 1024);
      size := Winsock2.recv(to_server, PChar(receive_buffer), 1024, 0);
      //
      // recv returns the number bytes read.  If that value is > 0 then
      // we got a message, else the client has closed the socket.
      if (size > 0 ) then
      begin
        //
        // got some data, do something with it.
        receive_buffer[size+1] := Char(0);                  // make sure it is 0 terminiated
        receive_buffer := String(pChar(receive_buffer));    // make it a ligit string
        Writeln('Message from Server = ' + receive_buffer); // log the message
       end;
    until size<=0;

  end;


end.



Ultibo Main

Code: Select all

program winsock_test;

{$mode objfpc}{$H+}

{ Raspberry Pi 3 Application                                                   }
{  Add your program code below, add additional units to the "uses" section if  }
{  required and create new units by selecting File, New Unit from the menu.    }
{                                                                              }
{  To compile your program select Run, Compile (or Run, Build) from the menu.  }

uses
   RaspberryPi3,
   GlobalConfig,
   GlobalConst,
   GlobalTypes,
   Platform,
   Threads,
   SysUtils,
   Classes,
   Ultibo,
   Shell,            {Add the Shell unit just for some fun}
   ShellFilesystem,  {Plus the File system shell commands}
   RemoteShell,      {And the RemoteShell unit so we can Telnet to our Pi}
   WinSock2_Example,
   Console
   { Add additional units here };
var
  WindowHandle:TWindowHandle;

begin

 WindowHandle:=ConsoleWindowCreate(ConsoleDeviceGetDefault,CONSOLE_POSITION_FULL,True);

 ConsoleWindowRedirectOutput(WindowHandle);
 WriteLn('Hello World: Writeln goes to window');
 WinSock2_Example.Server_Test(34);
 WriteLn('Starting telnet Shell');
 ShellInit();
 RemoteShellInit();
 WriteLn('Waiting a minute before halting');
 Sleep(1000 * 60);
 WriteLn('halting');
 ThreadHalt(0);
end.


PC Main

Code: Select all

program sockets;

{$mode objfpc}{$H+}

uses
  {$IFDEF UNIX}{$IFDEF UseCThreads}
  cthreads,
  {$ENDIF}{$ENDIF}
  Classes,
  WinSock2_Example
  { you can add units after this };

begin
  WriteLn('Hello World!');
  //WinSock2_Example.Server_Test(34);
  WinSock2_Example.Client_Test('192.168.1.11', 34);
  ReadLn;
end.

User avatar
Ultibo
Site Admin
Posts: 1980
Joined: Sat Dec 19, 2015 3:49 am
Location: Australia

Re: Example of using winsock (sockets) ultibo and Windows

Postby Ultibo » Fri Sep 07, 2018 11:46 pm

Excellent, I'm surprised you couldn't find any pure Winsock examples but since most people probably start using one of the libraries like Indy or Synapse (which also has an Ultibo port) then I guess many don't bother to learn actual socket programming.

Since your example is nicely commented we could add it to the contributed section of the Ultibo examples in order to help others if you don't object (credited of course).
Ultibo.org | Make something amazing
https://ultibo.org
jefferobertson
Posts: 8
Joined: Fri Aug 10, 2018 4:29 pm

Re: Example of using winsock (sockets) ultibo and Windows

Postby jefferobertson » Sat Sep 08, 2018 12:23 pm

Feel free to add it.
jefferobertson
Posts: 8
Joined: Fri Aug 10, 2018 4:29 pm

Re: Example of using winsock (sockets) ultibo and Windows

Postby jefferobertson » Sat Sep 08, 2018 12:26 pm

I wanted to make an example that ran, with minimal changes, on both the PC and the PI. Much easier to debug on a PC. Also I know how to do sockets, but have not used pascal since Turbo Pascal years ago. It was a good way to learn the language again. Still have problems remembering := instead of =. Not being case sensitive has bitten me a couple of times.

Return to “General”

Who is online

Users browsing this forum: No registered users and 0 guests