Link to home
Start Free TrialLog in
Avatar of alpires
alpiresFlag for Brazil

asked on

Ip and port blocking

Hi Experts,

I need a program in delphi 7 that allow me to block some specific TCP,UDP ports and IP adress, this way the network users can not access these addresses and ports.

I am using Win Xp and Delphi 7

can you help me ?
Avatar of CodedK
CodedK
Flag of Greece image
Hi Alpires.

To block specific ports you need some low level programming but you can bypass this and manipulate ip helper API's.

The code below is posted by Russell , i cannot find the PAQ but i kept this code.
I hope it will help you...
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
1) You will need admin rights to run this...
2) You can run the application as an admin by using "WinExecAsUser " or "ImpersonateLoggedOnUser"

unit netblock;
////////////////////////////////////////////////////////////////////////////////
//
//   Unit           :  NETBLOCK
//   Date           :  05.25.2004
//   Description    :  TCPIP network connection blocking unit
//
////////////////////////////////////////////////////////////////////////////////
interface

////////////////////////////////////////////////////////////////////////////////
//   Include units
////////////////////////////////////////////////////////////////////////////////
uses
  Windows,
  MMSystem;

////////////////////////////////////////////////////////////////////////////////
//   IPHLPAPI data structures
////////////////////////////////////////////////////////////////////////////////
type
  PMIB_TCPROW       =  ^MIB_TCPROW;
  MIB_TCPROW        =  packed record
     dwState:       DWORD;
     dwLocalAddr:   DWORD;
     dwLocalPort:   DWORD;
     dwRemoteAddr:  DWORD;
     dwRemotePort:  DWORD;
  end;

  PMIB_TCPTABLE     =  ^MIB_TCPTABLE;
  MIB_TCPTABLE      =  packed record
     dwNumEntries:  DWORD;
     Table:         Array [0..MaxWord] of MIB_TCPROW;
  end;

type
  TGetTcpTable      =  function(pTcpTable: PMIB_TCPTABLE; dwSize: PDWORD; bOrder: BOOL): DWORD; stdcall;
  TSetTcpEntry      =  function(pTcpRow: PMIB_TCPROW): DWORD; stdcall;

////////////////////////////////////////////////////////////////////////////////
//   IPHLPAPI constants
////////////////////////////////////////////////////////////////////////////////
const
  IPHLPAPI_NAME           =  'iphlpapi.dll';
  GETTCPTABLE_NAME        =  'GetTcpTable';
  SETTCPENTRY_NAME        =  'SetTcpEntry';

const
  MIB_TCP_STATE_DELETE_TCB= 12;

////////////////////////////////////////////////////////////////////////////////
//   NetBlock constants
////////////////////////////////////////////////////////////////////////////////
const
  NB_TABLE_SIZE     =  1024;

const
  NB_BLOCK_NONE     =  0;
  NB_BLOCK_INTERNET =  1;
  NB_BLOCK_ALL      =  2;

////////////////////////////////////////////////////////////////////////////////
//   NetBlock data structures
////////////////////////////////////////////////////////////////////////////////
type
  PNetBlockInfo     =  ^TNetBlockInfo;
  TNetBlockInfo     =  packed record
     dwBlockMode:   DWORD;
     dwResolution:  DWORD;
     dwTimer:       DWORD;
  end;

////////////////////////////////////////////////////////////////////////////////
//   NetBlock functions
////////////////////////////////////////////////////////////////////////////////
function   SetNetBlock(lpNetBlockInfo: PNetBlockInfo): DWORD;
function   StatNetBlock(lpNetBlockInfo: PNetBlockInfo): DWORD;
procedure  StopNetBlock;

var
  x:       DWORD = 0;

implementation

////////////////////////////////////////////////////////////////////////////////
//   Protected variables
////////////////////////////////////////////////////////////////////////////////
var
  hIphlp:           HMODULE        =  0;
  dwResolution:     DWORD          =  0;
  dwBlockMode:      DWORD          =  0;
  dwTimer:          DWORD          =  0;
  dwProcError:      DWORD          =  0;
  _GetTcpTable:     TGetTcpTable   =  nil;
  _SetTcpEntry:     TSetTcpEntry   =  nil;

procedure NetBlockTimerProc(uTimerID, uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
var  lpTable:       PMIB_TCPTABLE;
     lpRow:         PMIB_TCPROW;
     bRemove:       Boolean;
     dwReturn:      DWORD;
     dwSize:        DWORD;
begin

  Inc(x);

  // Start with an optimal table size
  dwSize:=(NB_TABLE_SIZE * SizeOf(MIB_TCPROW)) + SizeOf(DWORD);

  // Allocate memory for the table
  GetMem(lpTable, dwSize);

  // Get the table
  dwReturn:=_GetTcpTable(lpTable, @dwSize, False);

  // We may have to reallocate and try again
  if (dwReturn = ERROR_INSUFFICIENT_BUFFER) then
  begin
     // Reallocate memory for new table
     ReallocMem(lpTable, dwSize);
     // Make the call again
     dwReturn:=_GetTcpTable(lpTable, @dwSize, False);
  end;

  // Check for succes
  if (dwReturn = ERROR_SUCCESS) then
  begin
     // Iterate the table
     for dwSize:=0 to Pred(lpTable^.dwNumEntries) do
     begin
        // Get the row
        lpRow:=@lpTable^.Table[dwSize];
        // Check for 0.0.0.0 address
        if (lpRow^.dwLocalAddr = 0) or (lpRow^.dwRemoteAddr = 0) then Continue;
        // What blocking mode are we in
        case dwBlockMode of
           // Need to check the first two bytes in network address
           NB_BLOCK_INTERNET :  bRemove:=not(Word(Pointer(@lpRow^.dwLocalAddr)^) = Word(Pointer(@lpRow^.dwRemoteAddr)^));
           // Need to check all four bytes in network address
           NB_BLOCK_ALL      :  bRemove:=not(lpRow^.dwLocalAddr = lpRow^.dwRemoteAddr);
        else
           // No checking
           bRemove:=False;
        end;
        // Do we need to remove the entry?
        if bRemove then
        begin
           // Set entry state
           lpRow^.dwState:=MIB_TCP_STATE_DELETE_TCB;
           // Remove the TCP entry
           _SetTcpEntry(lpRow);
        end;
     end;
  end;

  // Free the table
  FreeMem(lpTable);

end;

function StatNetBlock(lpNetBlockInfo: PNetBlockInfo): DWORD;
begin

  // Parameter check
  if not(Assigned(lpNetBlockInfo)) then
     // Null buffer
     result:=ERROR_INVALID_PARAMETER
  else
  begin
     // Fill in the current settings
     lpNetBlockInfo^.dwResolution:=dwResolution;
     lpNetBlockInfo^.dwBlockMode:=dwBlockMode;
     lpNetBlockInfo^.dwTimer:=dwTimer;
     // Success
     result:=ERROR_SUCCESS;
  end;

end;

function SetNetBlock(lpNetBlockInfo: PNetBlockInfo): DWORD;
begin

  // Parameter check
  if not(Assigned(lpNetBlockInfo)) then
  begin
     // Treat the same way as if StopNetBlock had been called
     StopNetBlock;
     // Success
     result:=ERROR_SUCCESS;
  end
  else if (@_GetTcpTable = @_SetTcpEntry) then
     // Failed to load library or get the function pointers
     result:=dwProcError
  else if (lpNetBlockInfo^.dwResolution = 0) then
     // Invalid time specified
     result:=ERROR_INVALID_PARAMETER
  else if (lpNetBlockInfo^.dwBlockMode > NB_BLOCK_ALL) then
     // Invalid blocking mode
     result:=ERROR_INVALID_PARAMETER
  else
  begin
     // Kill the current timer if the blocking is running
     if (dwTimer > 0) then timeKillEvent(dwTimer);
     // Clear timer tracking handle
     dwTimer:=0;
     // Save off the current block mode and resolution
     dwBlockMode:=lpNetBlockInfo^.dwBlockMode;
     dwResolution:=lpNetBlockInfo^.dwResolution;
     // If the block mode is NB_BLOCK_NONE then nothing to do
     if (dwBlockMode = NB_BLOCK_NONE) then
        // Success
        result:=ERROR_SUCCESS
     else
     begin
        // Create the timer to handle the network blocking
        dwTimer:=timeSetEvent(lpNetBlockInfo^.dwResolution, 0, @NetBlockTimerProc, 0, TIME_PERIODIC or TIME_CALLBACK_FUNCTION);
        // Check timer handle
        if (dwTimer = 0) then
           // Failure
           result:=GetLastError
        else
           // Succes
           result:=ERROR_SUCCESS;
     end;
  end;

end;

procedure StopNetBlock;
begin

  // This will stop the current net blocking
  if (dwTimer > 0) then
  begin
     // Kill the timer
     timeKillEvent(dwTimer);
     // Reset all values
     dwBlockMode:=NB_BLOCK_NONE;
     dwResolution:=0;
     dwTimer:=0;
  end;

end;

initialization

  // Load the ip helper api library
  hIphlp:=LoadLibrary(IPHLPAPI_NAME);

  // Attempt to get the function addresses
  if (hIphlp > 0) then
  begin
     @_GetTcpTable:=GetProcAddress(hIpHlp, GETTCPTABLE_NAME);
     if not(Assigned(@_GetTcpTable)) then
        dwProcError:=GetLastError
     else
     begin
        @_SetTcpEntry:=GetProcAddress(hIpHlp, SETTCPENTRY_NAME);
        if not(Assigned(@_SetTcpEntry)) then dwProcError:=GetLastError
     end;
  end
  else
     // Save off the error
     dwProcError:=GetLastError;

finalization

  // Kill the timer if running
  if (dwTimer > 0) then timeKillEvent(dwTimer);

  // Clear functions
  @_GetTcpTable:=nil;
  @_SetTcpEntry:=nil;

  // Free the ip helper api library
  if (hIphlp > 0) then FreeLibrary(hIphlp);

end.

-----------------

Using it is very simple; to start the net blocking

var  nbiStart:      TNetBlockInfo;
begin

  nbiStart.dwBlockMode:=NB_BLOCK_INTERNET; // Blocking type
  nbiStart.dwResolution:=20;                            // Timer event delay
  SetNetBlock(@nbiStart);

end;

//and to stop it...
 StopNetBlock;


Code by Russell

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
Avatar of alpires
alpires
Flag of Brazil image

ASKER

interesting, but I need something in delphi for blocking only direct connection to Internet (only http and https).

I want the users to connect on the Internet (http and https protocol) only through the proxy. I want to force them set your browser to connect in the proxy, so I need to block direct connections.
ASKER CERTIFIED SOLUTION
Avatar of CodedK
CodedK
Flag of Greece image
Link to home
membership
This solution is only available to members.
To access this solution, you must be a member of Experts Exchange.
Start Free Trial