Learn how to a build a cloud-first strategyRegister Now

x
?
Solved

Port Redirector Help?

Posted on 2005-04-16
9
Medium Priority
?
781 Views
Last Modified: 2011-04-14
I've just 'attempted' to translate some C port redirector code to Delphi and it's not working for me properly. The server port binds properly but when a connection request comes in it errors out and won't work right. Not sure if anything else is wrong but if anybody has any solutions/code to fix it I'd be grateful and award you max points, grade 'A'.

Original C code:

/*
31.12.2002
This is a proxy, port redirector, bouncer etc. for windows winsock.
it works like this

client---------->(saddr192.168.0.113,sport12345)This_Proxy------->(daddr192.168.0.99,dport21)Remote_Host

type   bounce 192.168.0.113              192.168.0.99      12345     21

This code is written  by Delikon, visit my site www.delikon.de , or write me a mail ich@delikon.de

This is only a test, and my fist work with winsock, if you have any improvments, questions etc. please
mail me

This code is compiled with vc++6.0 ,and tested with win2k.

 
      
 you MUST link it with wsock32.lib.



*/




#include <windows.h>
#include <winsock.h>
#include <stdio.h>
#include <stdlib.h>


int startWinsock(void);

int main(int argc, char **argv)
{
 


if (argc<5)
{
printf("%s sourceaddr destinationaddr sourceport destiationport\n\n\n",argv[0]);
printf("for example\n\n\n ");
printf("%s 192.168.0.113 192.168.0.99 12345 21\n",argv[0]);
return 0;
}
      bounce(inet_addr(argv[1]),inet_addr(argv[2]),atoi(argv[3]),atoi(argv[4]));

}




 
int bounce(unsigned long int saddr,unsigned long int daddr,int sport,int dport)
{
  fd_set fds;
      
  long rc;
  long rc2;
  int max,count=0;
  SOCKET acceptSocket;
  SOCKET connectedSocket;
  SOCKET s;
  SOCKADDR_IN addr;
  char buf [256];
        
 

  rc=startWinsock();
      if(rc!=0)
      {
    printf("Fehler: startWinsock, fehler code: %d\n",rc);
    return 1;
      }
      else
      {
    printf("Winsock gestartet!\n");
      }

  // create Socket
  acceptSocket=socket(PF_INET,SOCK_STREAM,0);
      if(acceptSocket==INVALID_SOCKET)
      {
    printf("Fehler: Der Socket konnte nicht erstellt werden, fehler code: %d\n",WSAGetLastError());
    return 1;
      }
      else
      {
    printf("Socket erstellt!\n");
      }


  s=socket(PF_INET,SOCK_STREAM,0);
       if(s==INVALID_SOCKET)
      {
    printf("Fehler: Der Socket konnte nicht erstellt werden, fehler code: %d\n",WSAGetLastError());
    return 1;
      }
      else
      {
    printf("Socket erstellt!\n");
      }


 
 
 
 
 
  // bind socket
  memset(&addr,0,sizeof(SOCKADDR_IN));
  addr.sin_family=AF_INET;
  addr.sin_port=htons(sport);
  addr.sin_addr.s_addr=saddr;
  rc=bind(acceptSocket,(SOCKADDR*)&addr,sizeof(SOCKADDR_IN));
      if(rc==SOCKET_ERROR)
      {
    printf("Fehler: bind, fehler code: %d\n",WSAGetLastError());
    return 1;
      }
      else
      {
    printf("Socket an port gebunden\n");
      }

 
 
  // go into listen Modus
  rc=listen(acceptSocket,10);
  if(rc==SOCKET_ERROR)
  {
    printf("Fehler: listen, fehler code: %d\n",WSAGetLastError());
    return 1;
  }
  else
  {
    printf("acceptSocket ist im listen Modus....\n");
  }


 
  // accept connection
  connectedSocket=accept(acceptSocket,NULL,NULL);
 
  if(connectedSocket==INVALID_SOCKET)
  {
    printf("Fehler: accept, fehler code: %d\n",WSAGetLastError());
    return 1;
  }
  else
  {
      
  // connect
  memset(&addr,0,sizeof(SOCKADDR_IN));
  addr.sin_family=AF_INET;
  addr.sin_port=htons(dport);
  addr.sin_addr.s_addr=daddr;
      printf("Neue Verbindung wurde akzeptiert!\n");

      rc2=connect(s,(SOCKADDR*)&addr,sizeof(SOCKADDR));
      if(rc2==SOCKET_ERROR)
      {
    printf("Fehler: connect gescheitert, fehler code: %d\n",WSAGetLastError());
    return 1;
      }
      else
      {
    printf("Verbunden\n");
      }



  }


   

      
      max = connectedSocket;
      if ( s> max)
      max = s;

      
      while(rc!=SOCKET_ERROR && rc2!=SOCKET_ERROR)
      {

               
               
      FD_ZERO(&fds);
      FD_SET(s, &fds);
      FD_SET(connectedSocket, &fds);
      select(max + 1, &fds, 0, 0, 0);

      
      
      if(FD_ISSET(connectedSocket,&fds))
      {
      rc=recv(connectedSocket,buf,256,0);  
      buf[rc]='\0';
      send(s,buf,rc,0);
      }

      
      
      if(FD_ISSET(s,&fds))
      {
      rc2=recv(s,buf,256,0);        
      buf[rc2]='\0';
      send(connectedSocket,buf,rc2,0);  
      }
      

      //Kill bouncer on disconnect
      if(rc==0)
      {
            count++;
            if (count >1)
            break;
      }
 
}

  closesocket(acceptSocket);
  closesocket(connectedSocket);
  WSACleanup();
  return 0;
}



int startWinsock(void)
{
  WSADATA wsa;
  return WSAStartup(MAKEWORD(2,0),&wsa);
}






My Delphi 'translated' code:

var
  Form1: TForm1;
    fds: TFDSet;
rc, rc2: LongInt;
    max: integer = 0;
  count: integer = 0;
AcceptSocket, ConnectedSocket, s: TSocket;
   addr: SockAddr_In;
    buf: array [0..$FF] of char;

implementation

{$R *.dfm}

Function StartWinsock: integer;
var WSA: TWSADATA;
begin
  ZeroMemory(@WSA, SizeOf(WSA));
  result :=  WSAStartup(MAKEWORD(2, 0), WSA);
end;

Function Bounce(saddr: u_long; daddr: u_long; sport: integer; dport: integer): integer;
begin
  rc := StartWinsock();
      if ( rc <> 0 ) then
   begin
    ShowMessageFmt('Fehler: StartWinsock, fehler code: %d'+#13+#10,[rc]);
    result := 1;
      end
      else
      begin
  ShowMessage('Winsock gestartet!');
      end;
 
  AcceptSocket := Socket(PF_INET, SOCK_STREAM, 0);

      if ( acceptSocket = INVALID_SOCKET ) then
  begin
ShowMessageFmt('Fehler: Der Socket konnte nicht erstellt werden, fehler code: %d'+#13+#10,[WSAGetLastError()]);
    result := 1;
      end
  else
      begin
  ShowMessage('Socket erstellt'+#13);
      end;

  s := socket(PF_INET, SOCK_STREAM, 0);

       if( s = INVALID_SOCKET ) then
   begin
ShowMessageFmt('Fehler: Der Socket konnte nicht erstellt werden, fehler code: %d'+#13,[WSAGetLastError()]);
    result := 1;
      end
else
      begin
    ShowMessage('Socket erstellt!'+#13+#10);
      end;

  FillMemory(@addr, 0, sizeof(addr));
  ZeroMemory(@addr, sizeof(addr));
  addr.sin_family := AF_INET;
  addr.sin_port := htons(sport);
  addr.sin_addr.s_addr := saddr;

  rc := bind(AcceptSocket, addr, sizeof(addr));

  if ( rc = SOCKET_ERROR ) then
 begin
    ShowMessageFmt('Fehler: bind, fehler code: %d',[WSAGetLastError()]);
    result := 1;
end
   else
       begin
  ShowMessage('Socket an port gebunden'+#13+#10);
       end;

  rc := listen(AcceptSocket, 10);

  if( rc = SOCKET_ERROR ) then
  begin
  ShowMessageFmt('Fehler: listen, fehler code: %d',[WSAGetLastError()]);
    result := 1;
  end
  else
  begin
  ShowMessage('acceptSocket ist im listen Modus....');
  end;
 
  connectedSocket := accept(acceptSocket, nil, nil);

  if ( ConnectedSocket = INVALID_SOCKET ) then
  begin
  ShowMessageFmt('Fehler: accept, fehler code: %d',[WSAGetLastError()]);
    result := 1;
  end
    else
  begin

  FillMemory(@addr, 0, sizeof(addr));
  Zeromemory(@addr, sizeof(addr));
  addr.sin_family := AF_INET;
  addr.sin_port := htons(dport);
  addr.sin_addr.s_addr := daddr;

  ShowMessage('Neue Verbindung wurde akzeptiert!');

  rc2 := Connect(s, addr, sizeof(addr));

      if( rc2 = SOCKET_ERROR ) then
  begin
      ShowMessageFmt('Fehler: connect gescheitert, fehler code: %d',[WSAGetLastError()]);
    result := 1;
 end
      else
      begin
    ShowMessage('Verbunden');
      end;
  end;

      max := ConnectedSocket;
  if ( s > max ) then
  max := s;

 while( rc <> SOCKET_ERROR) and ( rc2 <> SOCKET_ERROR ) do
      begin
      FD_ZERO(fds);
      FD_SET(s, fds);
      FD_SET(ConnectedSocket, fds);
      Select(max +1, @fds, nil, nil, nil);

 if ( FD_ISSET(ConnectedSocket, fds) ) then
      begin
      rc := recv(ConnectedSocket, buf, 256, 0);
  buf[rc] := #0;                                   // Null terminated
      send(s, buf, rc, 0);
      end;
 if ( FD_ISSET(s, fds) ) then
      begin
      rc2 := recv(s, buf, 256, 0);
  buf[rc2] := #0;                                  // Null terminated
      send(ConnectedSocket, buf, rc2, 0);
      end;

      if( rc = 0 ) then
      begin
            inc(count);
            if ( count >1 ) then
            break;
      end;
    end;
  CloseSocket(acceptSocket);
  CloseSocket(connectedSocket);
  WSACleanup();
  result := 0;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
bounce(inet_addr(Pchar(edit1.Text)),
inet_addr(Pchar(edit2.Text)), StrToInt(edit3.Text),
StrToInt(edit4.Text));
end;

end.
0
Comment
Question by:Thor371
  • 5
  • 3
9 Comments
 
LVL 1

Expert Comment

by:JustinWillis
ID: 13801178
Not sure how to fix your example but last time I needed port redirection I did this with Indy's components, download the Indy Examples I think there is a demo program included which does this.

The website does not seem to be working for me right now for some reason but I believe this is the correct place to get them www.nevrona.com

Otherwise google search for "Indy Delphi".

Hope this is of some help.

Justin Willis.
0
 

Author Comment

by:Thor371
ID: 13803041
JustinWillis: I'm looking for this code to be fixed since I translated it from c. I plan to use no components in my projects, thanks anyway. If anyone can tell me how to get this stuff working I'll award them maximum points :) Maybe RLibby is interested?

Thor371
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 13806646

Thor371,

Listed below is a literal translation of the code (though I didn't find any major differences between the 2 translations). I did test this by using the following:

  bounce(inet_addr('127.0.0.1'), inet_addr('66.102.7.99'), 80, 80);

which in effect will bind to the local client port 80, and redirect the connection out to www.google.com (port 80). This is then easily tested by having your browser navigate to http://localhost. BUT... it should be noted that this code is only a generic redirect, and should not be mistaken for a proxy (http) server. If you are having problems with the code, then you should list which portions/message boxes are coming up and what you expect the result to be. It may turn out to be a case that this code won't do what you think it should. If this is the case, then you should specify what it is exactly that you are looking for.

Regards,
Russell


unit Bouncer;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit           :  Bouncer
//   Date           :  04.18.2005
//
//   31.12.2002
//   This is a proxy, port redirector, bouncer etc. for windows winsock.
//   it works like this
//   client---------->(saddr192.168.0.113,sport12345)This_Proxy------->(daddr192.168.0.99,dport21)Remote_Host
//
//   type   bounce 192.168.0.113              192.168.0.99      12345     21
//
//   This code is written  by Delikon, visit my site www.delikon.de , or write me a mail ich@delikon.de
//
//   This is only a test, and my fist work with winsock, if you have any improvments, questions etc. please
//   mail me
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows,
  SysUtils,
  WinSock;

function   bounce(saddr, daddr: u_long; sport, dport: Integer): Integer;
function   startWinsock: Integer;

implementation

////////////////////////////////////////////////////////////////////////////////
//   Protected vars
////////////////////////////////////////////////////////////////////////////////
var
  wsaData:          TWSAData;

function bounce(saddr, daddr: u_long; sport, dport: Integer): Integer;
var  fds:              TFDSet;
     rc, rc2:          Integer;
     max, count:       Integer;
     acceptSocket:     TSocket;
     connectedSocket:  TSocket;
     s:                TSocket;
     addr:             TSockAddrIn;
     buf:              Array [0..256] of Char;
begin

  count:=0;

  rc:=startWinsock;
      if (rc <> 0) then
      begin
     MessageBox(0, PChar(Format('Fehler: startWinsock, fehler code: %d', [rc])), nil, MB_OK);
     result:=1;
     exit;
  end
  else
     MessageBox(0, 'Winsock gestartet!', nil, MB_OK);

  // create Socket
  acceptSocket:=socket(PF_INET, SOCK_STREAM, 0);
      if (DWORD(acceptSocket) = DWORD(INVALID_SOCKET)) then
  begin
     MessageBox(0, PChar(Format('Fehler: Der Socket konnte nicht erstellt werden, fehler code: %d', [WSAGetLastError])), nil, MB_OK);
     result:=1;
     exit;
  end
  else
     MessageBox(0, 'Socket erstellt!', nil, MB_OK);

  s:=socket(PF_INET, SOCK_STREAM, 0);
  if (DWORD(s) = DWORD(INVALID_SOCKET)) then
      begin
     MessageBox(0, PChar(Format('Fehler: Der Socket konnte nicht erstellt werden, fehler code: %d', [WSAGetLastError])), nil, MB_OK);
     result:=1;
     exit;
  end
      else
     MessageBox(0, 'Socket erstellt!', nil, MB_OK);

  // connect
  ZeroMemory(@addr, SizeOf(TSockAddrIn));
  addr.sin_family:=AF_INET;
  addr.sin_port:=htons(dport);
  addr.sin_addr.s_addr:=daddr;

      rc2:=connect(s, addr, SizeOf(TSockAddrIn));
      if (rc2 = SOCKET_ERROR) then
  begin
     MessageBox(0, PChar(Format('Fehler: connect gescheitert, fehler code: %d', [WSAGetLastError])), nil, MB_OK);
     result:=1;
     exit;
  end
      else
     MessageBox(0, 'Verbunden', nil, MB_OK);

  // bind socket
  ZeroMemory(@addr, SizeOf(TSockAddrIn));
  addr.sin_family:=AF_INET;
  addr.sin_port:=htons(sport);
  addr.sin_addr.s_addr:=saddr;
  rc:=bind(acceptSocket,addr, SizeOf(TSockAddrIn));
      if (rc = SOCKET_ERROR) then
  begin
     MessageBox(0, PChar(Format('Fehler: bind, fehler code: %d', [WSAGetLastError])), nil, MB_OK);
     result:=1;
     exit;
  end
      else
     MessageBox(0, 'Socket an port gebunden', nil, MB_OK);

  // go into listen Modus
  rc:=listen(acceptSocket, 10);
  if (rc = SOCKET_ERROR) then
  begin
     MessageBox(0, PChar(Format('Fehler: listen, fehler code: %d', [WSAGetLastError])), nil, MB_OK);
     result:=1;
     exit;
  end
  else
     MessageBox(0, 'acceptSocket ist im listen Modus....', nil, MB_OK);

  // accept connection
  connectedSocket:=accept(acceptSocket, nil, nil);

  if (DWORD(connectedSocket) = DWORD(INVALID_SOCKET)) then
  begin
     MessageBox(0, PChar(Format('Fehler: accept, fehler code: %d', [WSAGetLastError])), nil, MB_OK);
     result:=1;
     exit;
  end
  else
     MessageBox(0, 'Neue Verbindung wurde akzeptiert!', nil, MB_OK);

      max:=s;
      if (connectedSocket > max) then max:=connectedSocket;

      while (rc <> SOCKET_ERROR) and (rc2 <> SOCKET_ERROR) do
  begin
     FD_ZERO(fds);
     FD_SET(s, fds);
     FD_SET(connectedSocket, fds);
     select(Succ(max), @fds, nil, nil, 0);

         if FD_ISSET(connectedSocket, fds) then
     begin
        rc:=recv(connectedSocket, buf, 256, 0);
            buf[rc]:=#0;
            send(s, buf, rc, 0);
     end;

         if FD_ISSET(s, fds) then
     begin
            rc2:=recv(s, buf, 256, 0);
           buf[rc2]:=#0;
            send(connectedSocket, buf, rc2, 0);
     end;

         // Kill bouncer on disconnect
         if (rc = 0) then
     begin
        Inc(count);
        if (count > 1) then break;
     end;
  end;

  closesocket(acceptSocket);
  closesocket(connectedSocket);

end;

function startWinsock: Integer;
begin

  // Init the winsock library
  result:=WSAStartup(MAKEWORD(2,0), wsaData);

end;

end.



0
Concerto's Cloud Advisory Services

Want to avoid the missteps to gaining all the benefits of the cloud? Learn more about the different assessment options from our Cloud Advisory team.

 

Author Comment

by:Thor371
ID: 13810229
Hi Rlibby :)
Thanks for the quick response I appreciate it! Okay, here's the deal.

I'm getting these messages displayed.

Winsock gestartet!
Socket erstellt!
Verbunden
Socket an port gebunden
acceptSocket ist im listen Modus....

// german to english translation is

Winsock started!
Socket provides!
Connected
Socket at haven bind
Mode is acceptSocket.... in would list

Sometimes the source address (localhost) is bound correctly but after that it seems to freeze the application.

The socket isn't binding properly (it seems) for the dest port.

I'm opening Delphi, dropping a TButton (Button1) on the form and adding the code:

bounce(inet_addr('127.0.0.1'), inet_addr('66.102.7.99'), 80, 80);

to the OnClick event handler, compiling the project and clicking the button.

 When looking at your code changes I see why you chose to use API MessageBoxA over ShowMessageFMT (VCL), succ() in Select(Succ(Max)) over Max +1 etc. It completely makes sense to me but I'm not quite sure why you're typecasting socket return flags as type DWORD, i don't see the point, then again I'm no pro in delphi ;)

What I'm trying to do is get this bouncer code working so I can build an application layer gateway off of it to modify specific inbound data from 4 different connections. The application would be connecting to this program and in return it's 4 connection's data (all to different ports) would be relayed to the "client" connections which would then connect to the remote destination as usual and back and forth normally.

Thanks.
Thor371







 
 





0
 
LVL 26

Accepted Solution

by:
Russell Libby earned 2000 total points
ID: 13815245
Thor371,

1.) You do realize that the code above is dealing with blocking mode sockets, right? And a call to accept will suspend the thread that it is called on (in this case the main thread) until a connection is made to it. If you require non-blocking handling, then you must either thread this code, or switch to the message based handling mechanism of tcp sockets.

2.) "The socket isn't binding properly (it seems) for the dest port."
How can you tell if there are no messages past the one indicating that the mode is acceptSocket? Did you try the above code and use your browser to navigate to "http://localhost" (which you are currently listening on).

3.) Regarding the casting of sockets for comparison against INVALID_SOCKET; this comes from a lot of hard learned experience regarding integer/unsigned comparison in Delphi. Simply put, Borland has different declarations (-1, $FFFFFFFF) depending on the version of Delphi you are using. The DWORD(...) cast makes sure that both values are being compared using the same data type.

4.) Regarding what your trying to do overall; Will you be connecting to different destination ports for each of the "bounced" connections, or will they all connect to the same dest addr and port?

application ------> localhost/port -----> dest addr/port

If different ports, then what will you use to determine which dest port is chosen? Perhaps a little more info on this would help me in providing a more complete sample (though the code above does work)

Russell




0
 

Author Comment

by:Thor371
ID: 13818310
Hello Russell,
This is somewhat lengthy I do apologize;

1.) Blocking socket work is only required at this point in time.
     I have some threading experience in Delphi, not too much however. As long as I create a thread class deriving from    (encapsulating) TThread class it seems a breeze and overriding the execute method.

I'm aware that (console apps)(limited) handle messages differently than GUI apps. The c example is a typical console application and if I tested the translated code in delphi as a console application  {$APPTYPE CONSOLE} it should work as the 'c' example?  

2.) Something like that, I have a packet sniffer open and as soon as a connection request is established it errors out when data is pushed last time I checked, I'll see if it still does this when on it's own thread.

3.) Thanks for that information as I was curious about your DWORD typecasting =) I learned something

4.) Both, some of the connection bouncers will be connecting to different destination ports and different dest addresses but others will be bounced connections will be using static dest ports and addresses, the source address will be the same however Loopback will be used ( not 0.0.0.0 (ALL Interfaces)) and bound to loopback on a specific source port unique to each connection. At this point in time you may be wondering how I plan to anticipate dest ports which can change. well that seems to be the tricky part and the only answer I could give you, based on some hooking experience I have is to hook winsock in a shim-like manner, read the packet header and relay the info to my connection bouncer so that it can be forwarded after modifcation, make sense? I should be able to manipulate the buffers with Write/ReadProcessMemory if I have to end up hooking Winsocks send/recv/recvfrom/sendto/connect etc.. after I determine which version of winsock is supported and more importantly which version imlicitly calls which functions (WSA) prefixed or not etc..

On another note: I Don't mean to get off the subject :)

I was looking around last night and came across some examples of doing similar things with the indy components (built on threads). I found this example. http://www.planet-source-code.com/vb/scripts/ShowCode.asp?txtCodeId=1284&lngWId=7

I'm using Delphi 7 and the indy version that comes with it reads 9.00.10 which lacks the AThread.Connection.CurrentReadBufferSize method on the IdTCPServer1 OnExecute method.
I was able to compile it after changing all instances of currentreadbuffersize to length(currentreadbuffer);

The Indy bindings on the TCPserver component (with loopback as the ONLY binding) doesnt seem to bind to loopback and instead binds to 0.0.0.0 _until_ a connection is made, I DID test this when navigating to http://localhost/ in my web browser. Any possible insight on that? I shouldn't have to navigate to localhost in my browser for a connection to be established, cant I simply bind to 127.0.0.1 right off the bat and listen for the connection? This might be exactly what I need/am looking for.

My goal is to atleast get a connection relay working in delphi for my gui app which can bounce a (static) dest port, address.

Thanks
Thor371
0
 

Author Comment

by:Thor371
ID: 13819283
Ok, I have the relay working as i see fit and threaded.

 If you would like to elaborate on anything in my previous post I plan to reward you with as many pts as needed for this sort of topic since you're experienced and I questions still like manipulating the socket data, maybe setting as smart buffer size, one which will accurately grab the size of the recv and then set the length according to that etc. Thanks again and Ill open up another thread for anything else you can tell me.

cheers,
Thor371
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 13819407

Thanks for the points Thor371,

To address some of your questions:

1.) I can post some library code that I have that somewhat simplifies the handling of blocking sockets, and also creates its own worker thread for listener handlers (it messages connections back to the specified window handle). And yes, if done as a console app, it would work the same as the C  example.

3.) If your compiler ever complains about 'expression always evaluates to false', then you will know what i mean ;-)

4.) I am not that familiar with the Indy code, so really can't comment on this.

More points are not required, but thanks for the offer. If you are looking at setting a smart buffer size, then you can use the getsockopt api with a flag of SO_RCVBUF to determine the lower layer recv size, then allocate a buffer that large for performing the recv's.

Russell

// Some code that I use for general socket blocking handling
unit BSDSock;

interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows,
  SysUtils,
  Classes,
  WinSock;

////////////////////////////////////////////////////////////////////////////////
//   Forward from winsock
////////////////////////////////////////////////////////////////////////////////
type
  TSocket           =  WinSock.TSocket;

////////////////////////////////////////////////////////////////////////////////
//   Missing constants from winsock
////////////////////////////////////////////////////////////////////////////////
const
  SD_BOTH           =  2;

////////////////////////////////////////////////////////////////////////////////
//   Status structure
////////////////////////////////////////////////////////////////////////////////
type
  PBSDStatus        =  ^TBSDStatus;
  TBSDStatus        =  packed record
     bCanRead:      Boolean;
     bCanWrite:     Boolean;
     bHasErrored:   Boolean;
  end;
  PBSDStatusArray   =  ^TBSDStatusArray;
  TBSDStatusArray   =  Array [0..63] of TBSDStatus;

////////////////////////////////////////////////////////////////////////////////
//   Status states to check
////////////////////////////////////////////////////////////////////////////////
type
  TStatusStates     =  set of (ssRead, ssWrite, ssError);

////////////////////////////////////////////////////////////////////////////////
//   Server listen structure
////////////////////////////////////////////////////////////////////////////////
type
  PBSDListen        =  ^TBSDListen;
  TBSDListen        =  packed record
     dwThreadCB:    DWORD;
     hwndCB:        HWND;
     uMsgID:        UINT;
     shListen:      TSocket;
  end;

////////////////////////////////////////////////////////////////////////////////
//
//   Flat socket functions
//   ---------------------
//
//   All functions are designed to return ERROR_SUCCESS when the function
//   succeeds, or the result of WSAGetLastError when the function fails.
//
////////////////////////////////////////////////////////////////////////////////

////////////////////////////////////////////////////////////////////////////////
//
//   BSDConnect
//
//   Connects to the specified server and port and returns the new socket handle
//   in the SocketHandle param.
//
//      SocketHandle   -  Returns the newly created socket handle
//      Server         -  Server to connect to in either . notation or DNS name.
//      Port           -  Port to connect to on the server.
//
////////////////////////////////////////////////////////////////////////////////
function   BSDConnect(var SocketHandle: TSocket; Server: String; Port: Cardinal): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDClose
//
//   Shuts down and closes the specified socket
//
//      SocketHandle   -  Socket to shutdown and close
//
////////////////////////////////////////////////////////////////////////////////
function   BSDClose(SocketHandle: TSocket): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDCloseAndClear
//
//   Shuts down and closes the specified socket and resets the handle to a
//   value of INVALID_SOCKET.
//
//      SocketHandle   -  Socket to shutdown and close
//
////////////////////////////////////////////////////////////////////////////////
function   BSDCloseAndClear(var SocketHandle: TSocket): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDSetTimeout
//
//   Sets the recv timeout for the specified socket
//
//      SocketHandle   -  Socket to set the timeout value for
//      Timeout        -  Timout value in milliseconds
//
////////////////////////////////////////////////////////////////////////////////
function   BSDSetTimeout(SocketHandle: TSocket; Timeout: Cardinal): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDSend
//
//   Sends data on the connected socket
//
//      SocketHandle   -  Socket to send data on
//      Data           -  Pointer to block of data to send
//      DataLen        -  Size of data to be sent
//
////////////////////////////////////////////////////////////////////////////////
function   BSDSend(SocketHandle: TSocket; Data: Pointer; DataLen: Cardinal): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDRecv
//
//   Receives data from the socket
//
//      SocketHandle   -  Socket to receive data on
//      Data           -  Buffer to receive the data
//      DataLen        -  On calling, specifies the size of the buffer. On return,
//                        specifies the number of bytes actually received.
//
////////////////////////////////////////////////////////////////////////////////
function   BSDRecv(SocketHandle: TSocket; var Data; var DataLen: Cardinal): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDPeek
//
//   Peek at the incoming data on the socket. The data is copied into the buffer
//   but is not removed from the input queue.
//
//      SocketHandle   -  Socket to peek data on
//      Data           -  Buffer to receive the peeked data
//      DataLen        -  On calling, specifies the size of the buffer. On return,
//                        specifies the number of bytes actually received.
//
////////////////////////////////////////////////////////////////////////////////
function   BSDPeek(SocketHandle: TSocket; var Data; var DataLen: Cardinal): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDSelect
//
//   Determines the state of the specified socket and fills the Status structure
//   with the results.
//
//      SocketHandle   -  Socket to determine status for
//      Status         -  Status structure to fill for the specified socket. If
//                        bCanRead is set, the socket can call BSDRecv without
//                        the call blocking. If bCanWrite is set, the socket can
//                        call BSDSend without blocking. If bHasErrored is set,
//                        then the socket is an error state.
//
////////////////////////////////////////////////////////////////////////////////
function   BSDSelect(SocketHandle: TSocket; var Status: TBSDStatus): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDSelectMultiple
//
//   Determines the state of up to 64 specified sockets and fills the status
//   array structure with the results for each socket. This allows a client to
//   block (with a timeout) on a group of sockets, and will return when one of
//   the specified states is set, or the timeout is reached.
//
//      SocketHandles  -  Array of sockets to determine status for
//      Timeout        -  Maximum amount of time to wait for the select call
//      StatusStates   -  The states (read, write, error) that should be checked
//      StatusArray    -  Array of status to fill for the specified sockets. If
//                        bCanRead is set, the socket can call BSDRecv without
//                        the call blocking. If bCanWrite is set, the socket can
//                        call BSDSend without blocking. If bHasErrored is set,
//                        then the socket is an error state.
//
////////////////////////////////////////////////////////////////////////////////
function   BSDSelectMultiple(SocketHandles: Array of TSocket; Timeout: Integer; StatusStates: TStatusStates; var StatusArray: TBSDStatusArray): Integer;

////////////////////////////////////////////////////////////////////////////////
//
//   BSDListen
//
//   Creates a server listening socket for the specified port. If the call
//   succeeds, a thread is spun to handle the inbound connections to this
//   socket. When a client then connects, the thread will accept() the
//   connection and then send a message to the specified window, using the
//   specified MessageID to notify the application that a client has connected.
//   The wParam of the message will contain the newly accepted socket connection.
//   If the listening socket is no longer required, a BSDClose should be called
//   on the server socket which will allow the thread to fully complete.
//
//      SocketHandle   -  Returns the newly created listening socket handle
//      Port           -  Port for the server socket to listen on
//      hwndCallback   -  Window handle to SendMessage to when a client connects.
//                        If this parameter is 0, then a PostThreadMessage will
//                        be sent to the original thread that created the server
//                        socket.
//      MessageID      -  Specifies the window message to to be used for callbacks.
//
////////////////////////////////////////////////////////////////////////////////
function   BSDListen(var SocketHandle: TSocket; Port: Cardinal; hwndCallback: HWND; MessageID: UINT): Integer;

implementation

////////////////////////////////////////////////////////////////////////////////
//   Protected variables
////////////////////////////////////////////////////////////////////////////////
var
  gWSAData:         TWSAData;

function ThreadListenFunc(Param: Pointer): DWORD; stdcall;
var  lpListen:      PBSDListen;
     shClient:      TSocket;
begin

  // Cast the param as a listening structure
  lpListen:=Param;

  // Resource handling
  try
     // Call listen on the socket
     if (listen(lpListen^.shListen, 5) = ERROR_SUCCESS) then
     begin
        // Accept loop
        while True do
        begin
           // Accept the client connection
           shClient:=accept(lpListen^.shListen, nil, nil);
           // Is this a valid socket?
           if (shClient = INVALID_SOCKET) then break;
           // Notify the callback of the new connection
           if (lpListen^.hwndCB = 0) then
              // Notify the thread
              PostThreadMessage(lpListen^.dwThreadCB, lpListen^.uMsgID, shClient, 0)
           else
           begin
              // Check that the window is still valid. If its not, then we are done
              // listening for client connections
              if not(IsWindow(lpListen^.hwndCB)) then break;
              // Send the message to the window
              SendMessage(lpListen^.hwndCB, lpListen^.uMsgID, shClient, 0);
           end;
        end;
     end;
  finally
     // Free the memory block
     FreeMem(Param);
     // Exit the thread
     ExitThread(0);
  end;

  // To satisfy the compiler
  result:=0;

end;

function BSDListen(var SocketHandle: TSocket; Port: Cardinal; hwndCallback: HWND; MessageID: UINT): Integer;
var  lpSin:      TSockAddrIn;
     lpListen:   PBSDListen;
     dwThread:   DWORD;
begin

  // Check window handle first
  if (hwndCallback = 0) or not(IsWindow(hwndCallback)) then
     // Invalid window specified
     result:=ERROR_INVALID_HANDLE
  else
  begin
     // Create the socket
     SocketHandle:=socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);
     // Check socket handle creation
     if (SocketHandle = INVALID_SOCKET) then
        // Failed to create socket
        result:=WSAGetLastError
     else
     begin
        // Set sock internet address
        lpSin.sin_family:=AF_INET;
        // Set socket family and addr
        lpSin.sin_family:=AF_INET;
        lpSin.sin_addr.s_addr:=INADDR_ANY;
        lpSin.sin_port:=htons(Port);
        // Bind the socket
        if (bind(SocketHandle, lpSin, SizeOf(lpSin)) = SOCKET_ERROR) then
        begin
           // Failed to bind socket
           result:=WSAGetLastError;
           // Close the socket
           BSDClose(SocketHandle);
           // Invalidate the handle
           SocketHandle:=INVALID_SOCKET;
        end
        else
        begin
           // Allocate a block of memory to pass to the thread
           GetMem(lpListen, SizeOf(TBSDListen));
           // Fill in the structure
           with lpListen^ do
           begin
              // Set parameters for the thread
              dwThreadCB:=GetCurrentThreadID;
              hwndCB:=hwndCallback;
              uMsgID:=MessageID;
              shListen:=SocketHandle;
           end;
           // Create the listening thread
           if (CreateThread(nil, 0, @ThreadListenFunc, lpListen, 0, dwThread) = 0) then
           begin
              // Failed to create listening thread
              result:=GetLastError;
              // Free memory block
              FreeMem(lpListen);
              // Close the socket
              BSDClose(SocketHandle);
              // Invalidate the handle
              SocketHandle:=INVALID_SOCKET;
           end
           else
              // Success
              result:=ERROR_SUCCESS;
        end;
     end;
  end;

end;

function BSDSelectMultiple(SocketHandles: Array of TSocket; Timeout: Integer; StatusStates: TStatusStates; var StatusArray: TBSDStatusArray): Integer;
var  fdSet:         Array [0..2] of TFDSet;
     lpSet:         Array [0..2] of PFDSet;
     tvWait:        TTimeVal;
     dwCount:       Integer;
     dwIndex:       Integer;
begin

  // Clear the status structure
  ZeroMemory(@StatusArray, SizeOf(TBSDStatusArray));

  // Walk the read, write, error indexes
  for dwIndex:=0 to 2 do
  begin
     // Zero the set
     FD_ZERO(fdSet[dwIndex]);
     // Set up FDSETs for polling status
     dwCount:=0;
     while (dwCount <= High(SocketHandles)) do
     begin
        // Set the socket handle
        FD_SET(SocketHandles[dwCount], fdSet[dwIndex]);
        // Next count
        Inc(dwCount);
        // Break if count is as at 63
        if (dwCount = 64) then break;
     end;
  end;

  // Set for polling current status
  ZeroMemory(@tvWait, SizeOf(TTimeVal));
  tvWait.tv_sec:=Timeout div 1000;
  tvWait.tv_usec:=Timeout mod 1000;

  // Clear the pointer set
  ZeroMemory(@lpSet, SizeOf(lpSet));

  // Check empty set
  if (StatusStates = []) then
     // Empty set
     result:=0
  else
  begin
     // Set addresses for sets to check
     if (ssRead in StatusStates) then lpSet[0]:=@fdSet[0];
     if (ssWrite in StatusStates) then lpSet[1]:=@fdSet[1];
     if (ssError in StatusStates) then lpSet[2]:=@fdSet[2];
     result:=select(0, lpSet[0], lpSet[1], lpSet[2], @tvWait);
  end;

  // Check error status
  if (result = SOCKET_ERROR) then
     // Set the last error code
     result:=WSAGetLastError
  else
  begin
     // Check for timeout
     if (result > 0) then
     begin
        // Set results
        dwCount:=0;
        while (dwCount <= High(SocketHandles)) do
        begin
           // Set status fields
           if (ssRead in StatusStates) then StatusArray[dwCount].bCanRead:=FD_ISSET(SocketHandles[dwCount], fdSet[0]);
           if (ssWrite in StatusStates) then StatusArray[dwCount].bCanWrite:=FD_ISSET(SocketHandles[dwCount], fdSet[1]);
           if (ssError in StatusStates) then StatusArray[dwCount].bHasErrored:=FD_ISSET(SocketHandles[dwCount], fdSet[2]);
           // Next count
           Inc(dwCount);
           // Break if count is as at 63
           if (dwCount = 64) then break;
        end;
     end;
     // Set success
     result:=ERROR_SUCCESS;
  end;

end;

function BSDSelect(SocketHandle: TSocket; var Status: TBSDStatus): Integer;
var  fdSet:         Array [0..2] of TFDSet;
     tvWait:        TTimeVal;
     dwCount:       Integer;
begin

  // Clear the status structure
  ZeroMemory(@Status, SizeOf(TBSDStatus));

  // Set up FDSETs for polling status
  for dwCount:=0 to 2 do
  begin
     FD_ZERO(fdSet[dwCount]);
     FD_SET(SocketHandle, fdSet[dwCount]);
  end;

  // Set for polling current status
  ZeroMemory(@tvWait, SizeOf(TTimeVal));

  // Poll for status
  result:=select(0, @fdSet[0], @fdSet[1], @fdSet[2], @tvWait);

  // Check error status
  if (result = SOCKET_ERROR) then
     // Set the last error code
     result:=WSAGetLastError
  else
  begin
     // Set status fields
     Status.bCanRead:=FD_ISSET(SocketHandle, fdSet[0]);
     Status.bCanWrite:=FD_ISSET(SocketHandle, fdSet[1]);
     Status.bHasErrored:=FD_ISSET(SocketHandle, fdSet[2]);
     // Set success
     result:=ERROR_SUCCESS;
  end;

end;

function BSDPeek(SocketHandle: TSocket; var Data; var DataLen: Cardinal): Integer;
begin

  // Empty the passed buffer first
  FillChar(Data, DataLen, #0);

  // Receive the data with Peek parameter set
  DataLen:=recv(SocketHandle, Data, DataLen, MSG_PEEK);

  // Check return code
  if (DataLen = DWORD(SOCKET_ERROR)) then
  begin
     // Clear the datalen
     DataLen:=0;
     // Set the last error code
     result:=WSAGetLastError;
  end
  else
     // Success - If datalen is zero then the socket was closed gracefully
     result:=ERROR_SUCCESS;

end;

function BSDRecv(SocketHandle: TSocket; var Data; var DataLen: Cardinal): Integer;
begin

  // Empty the passed buffer first
  FillChar(Data, DataLen, #0);

  // Receive the data
  DataLen:=recv(SocketHandle, Data, DataLen, 0);

  // Check return code
  if (DataLen = DWORD(SOCKET_ERROR)) then
  begin
     // Clear the datalen
     DataLen:=0;
     // Set the last error code
     result:=WSAGetLastError;
  end
  else
     // Success - If datalen is zero then the socket was closed gracefully
     result:=ERROR_SUCCESS;

end;

function BSDSend(SocketHandle: TSocket; Data: Pointer; DataLen: Cardinal): Integer;
begin

  // Send the data
  result:=send(SocketHandle, Data^, DataLen, 0);

  // Check the result of send
  if (result = SOCKET_ERROR) then
     // Failed to send data
     result:=WSAGetLastError
  else
     // Data was sent
     result:=ERROR_SUCCESS;

end;

function BSDSetTimeout(SocketHandle: TSocket; Timeout: Cardinal): Integer;
begin

  // Set the timeout in milliseconds
  result:=setsockopt(SocketHandle, SOL_SOCKET, SO_RCVTIMEO, @Timeout, SizeOf(Timeout));

  // Check result
  if (result = SOCKET_ERROR) then
     // Failure
     result:=WSAGetLastError
  else
     // Success
     result:=ERROR_SUCCESS;

end;

function BSDConnect(var SocketHandle: TSocket; Server: String; Port: Cardinal): Integer;
var  lpSin:      TSockAddrIn;
     lpPhe:      PHostEnt;
     lpLinger:   linger;
begin

  // Create the socket
  SocketHandle:=socket(PF_INET, SOCK_STREAM, IPPROTO_TCP);

  // Check socket handle creation
  if (SocketHandle = INVALID_SOCKET) then
     // Failed to create socket
     result:=WSAGetLastError
  else
  begin
     // Set sock internet address
     lpSin.sin_family:=AF_INET;
     // Set server and port to connect to
     lpSin.sin_port:=htons(Port);
     lpSin.sin_addr.s_addr:=inet_addr(PChar(Server));
     // Check address conversion
     if (DWORD(lpSin.sin_addr.s_addr) = DWORD(INADDR_NONE)) then
     begin
        // Try to get the address using name resolution
        lpPhe:=gethostbyname(PChar(Server));
        // Did the name resolve?
        if (lpPhe = nil) then
        begin
           // Failed to convert address
           result:=WSAGetLastError;
           // Close the socket
           BSDClose(SocketHandle);
           // Invalidate the handle
           SocketHandle:=INVALID_SOCKET;
           // Finished
           exit;
        end;
        // Set the address
        lpSin.sin_addr.s_addr:=LongInt(PLongInt(lpPhe^.h_addr_list^)^);
     end;
     // Set socket to NOT linger
     lpLinger.l_onoff:=0;
     lpLinger.l_linger:=0;
     setsockopt(SocketHandle, SOL_SOCKET, SO_DONTLINGER, @lpLinger, SizeOf(linger));
     // Connect the socket
     if (connect(SocketHandle, lpSin, SizeOf(lpSin)) = SOCKET_ERROR) then
     begin
        // Set last error code
        result:=WSAGetLastError;
        // Close the socket
        BSDClose(SocketHandle);
        // Invalidate the handle
        SocketHandle:=INVALID_SOCKET;
     end
     else
        // Success
        result:=ERROR_SUCCESS;
  end;

end;

function BSDCloseAndClear(var SocketHandle: TSocket): Integer;
begin

  // Resource protection
  try
     // Close the socket
     result:=BSDClose(Sockethandle);
  finally
     // Reset the handle
     SocketHandle:=INVALID_SOCKET;
  end;

end;

function BSDClose(SocketHandle: TSocket): Integer;
begin

  // Shutdown socket by disabling send and recv's. We don't care so much
  // about this call as we do the final closesocket
  if (SocketHandle <> INVALID_SOCKET) then
  begin
     // Shutdown
     shutdown(SocketHandle, SD_BOTH);
     // Close the socket
     result:=closesocket(SocketHandle);
     // Check result of close
     if (result = SOCKET_ERROR) then
        // Failed to close socket
        result:=WSAGetLastError
     else
        // Success
        result:=ERROR_SUCCESS;
  end
  else
     // Success
     result:=ERROR_SUCCESS;

end;

initialization

  // Mark the system as multi threaded for safety
  IsMultiThread:=True;

  // Initialize the winsock engine for use
  WSAStartup(MakeWord(1, 1), gWsaData);

finalization

  // Cancel any outstanding blocking calls
  if WSAIsBlocking then WSACancelBlockingCall;

  // Free the winsock engine
  WSACleanup;

end.


0
 

Author Comment

by:Thor371
ID: 13820839
@RLibby

Thanks for the insight and blocking sock unit you earned the points and I'm understanding a lot more of delphi now :)

 I've opened another thread here as a continuance to this example:

http://www.expertsexchange.com/Programming/Programming_Languages/Delphi/Q_21395115.html 

to ask some basic stuff and point me in an even better direction.

Thanks guys,
Thor371

0

Featured Post

VIDEO: THE CONCERTO CLOUD FOR HEALTHCARE

Modern healthcare requires a modern cloud. View this brief video to understand how the Concerto Cloud for Healthcare can help your organization.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

A lot of questions regard threads in Delphi.   One of the more specific questions is how to show progress of the thread.   Updating a progressbar from inside a thread is a mistake. A solution to this would be to send a synchronized message to the…
The uses clause is one of those things that just tends to grow and grow. Most of the time this is in the main form, as it's from this form that all others are called. If you have a big application (including many forms), the uses clause in the in…
Please read the paragraph below before following the instructions in the video — there are important caveats in the paragraph that I did not mention in the video. If your PaperPort 12 or PaperPort 14 is failing to start, or crashing, or hanging, …
Look below the covers at a subform control , and the form that is inside it. Explore properties and see how easy it is to aggregate, get statistics, and synchronize results for your data. A Microsoft Access subform is used to show relevant calcul…
Suggested Courses

810 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question