[Webinar] Learn how to a build a cloud-first strategyRegister Now

x
  • Status: Solved
  • Priority: Medium
  • Security: Public
  • Views: 618
  • Last Modified:

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 ?
0
alpires
Asked:
alpires
  • 3
1 Solution
 
CodedKCommented:
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

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
0
 
alpiresAuthor Commented:
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.
0
 
CodedKCommented:
Hi Alpires.

You said :
   I want the users to connect on the Internet only through the proxy...
Although this is not stated in your initial question... Here is a solution.

Use this function :

~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
function GetProxy(var Host : string;
                  var Port : integer;
                  var ProxyEnabled : boolean) : boolean;
const
  sProxyEnable = 'ProxyEnable';
var
  s : string;
  p : integer;
  sPortTmp : String;
begin
  with TRegistry.Create do
  begin
    RootKey := HKEY_CURRENT_USER;
    ProxyEnabled := false;
    s := '';
    OpenKey ('\Software\Microsoft\Windows\CurrentVersion\Internet Settings',
             True);
    if ValueExists('ProxyServer') then
      s := ReadString('ProxyServer');

    if s <> '' then
    begin
      p := pos(':', s);
      if p=0 then
        p := length(s)+1;
      Host := copy(s, 1, p-1);
      try
        Port := StrToInt(copy (s,p+1,999));
      except
        Port := 80;
      end;

      ProxyEnabled := true;
    end;

    if ValueExists('ProxyEnable') then
    begin
        case GetDataType(sProxyEnable) of
        rdString,
        rdExpandString:
        begin
          sPortTmp := AnsiLowerCase(ReadString(sProxyEnable));
          ProxyEnabled := true;
          if pos((' '+sPortTmp+' '), ' yes true t enabled 1 ') > 0 then
            ProxyEnabled := true
          else
          if pos(' '+sPortTmp+' ', ' no false f none disabled 0 ') > 0 then
            ProxyEnabled := false
        end;
        rdInteger:
        begin
          ProxyEnabled := ReadBool(sProxyEnable);
        end;
        rdBinary:
        begin
          ProxyEnabled := true;
          ReadBinaryData(sProxyEnable, ProxyEnabled, 1);
        end;
        end;
    end;

    Free;
  end;
  Result := s<>'';
end;
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-
Example of usage :Drop 2 labels and a button in a form and the code for blocking....In Button1 click event...

procedure TForm1.Button1Click(Sender: TObject);
var
  Host : string;
  Port : integer;
  ProxyEnabled : boolean;
  MyHost: String;
const
  YesNo : array [false..true] of string = (' not ', '');
begin
  // get proxy information
  MyHost:='193.84.12.58';
  if GetProxy(Host, Port, ProxyEnabled) then
  begin
    ShowMessage(Format('Your proxy is %s on port %d, it is%s enabled.',
                [Host, Port, YesNo[ProxyEnabled]]));
    Label1.Caption := Host;
    Label2.Caption := IntToStr(Port);
    If Trim(Host)<>MyHost then //start blocking code   <-------- The block code above...
  end
  else
    ShowMessage('No proxy detected');
   -----> Start Blocking here....<-------- The block code above...
end;
~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-~-

Hope this will help you.
0

Featured Post

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.

  • 3
Tackle projects and never again get stuck behind a technical roadblock.
Join Now