Advertisement
assasaha

netblock Delphi 7

Sep 17th, 2016
260
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Delphi 8.54 KB | None | 0 0
  1. unit netblock;
  2. ////////////////////////////////////////////////////////////////////////////////
  3. //
  4. //    Unit           :  NETBLOCK
  5. //   Date           :  05.25.2004
  6. //    Description    :  TCPIP network connection blocking unit
  7. //
  8. ////////////////////////////////////////////////////////////////////////////////
  9. interface
  10.  
  11. ////////////////////////////////////////////////////////////////////////////////
  12. //    Include units
  13. ////////////////////////////////////////////////////////////////////////////////
  14. uses
  15.    Windows,
  16.   MMSystem;
  17.  
  18. ////////////////////////////////////////////////////////////////////////////////
  19. //    IPHLPAPI data structures
  20. ////////////////////////////////////////////////////////////////////////////////
  21. type
  22.    PMIB_TCPROW       =  ^MIB_TCPROW;
  23.   MIB_TCPROW        =  packed  record
  24.      dwState:       DWORD;
  25.      dwLocalAddr:   DWORD;
  26.       dwLocalPort:   DWORD;
  27.      dwRemoteAddr:  DWORD;
  28.       dwRemotePort:  DWORD;
  29.   end;
  30.  
  31.   PMIB_TCPTABLE     =   ^MIB_TCPTABLE;
  32.   MIB_TCPTABLE      =  packed record
  33.       dwNumEntries:  DWORD;
  34.      Table:         Array [0..MaxWord] of  MIB_TCPROW;
  35.   end;
  36.  
  37. type
  38.   TGetTcpTable      =   function(pTcpTable: PMIB_TCPTABLE; dwSize: PDWORD; bOrder: BOOL):  DWORD; stdcall;
  39.   TSetTcpEntry      =  function(pTcpRow:  PMIB_TCPROW): DWORD; stdcall;
  40.  
  41. ////////////////////////////////////////////////////////////////////////////////
  42. //    IPHLPAPI constants
  43. ////////////////////////////////////////////////////////////////////////////////
  44. const
  45.    IPHLPAPI_NAME           =  'iphlpapi.dll';
  46.   GETTCPTABLE_NAME         =  'GetTcpTable';
  47.   SETTCPENTRY_NAME        =  'SetTcpEntry';
  48.  
  49. const
  50.    MIB_TCP_STATE_DELETE_TCB= 12;
  51.  
  52. ////////////////////////////////////////////////////////////////////////////////
  53. //    NetBlock constants
  54. ////////////////////////////////////////////////////////////////////////////////
  55. const
  56.    NB_TABLE_SIZE     =  1024;
  57.  
  58. const
  59.   NB_BLOCK_NONE     =  0;
  60.    NB_BLOCK_INTERNET =  1;
  61.   NB_BLOCK_ALL      =  2;
  62.  
  63. ////////////////////////////////////////////////////////////////////////////////
  64. //    NetBlock data structures
  65. ////////////////////////////////////////////////////////////////////////////////
  66. type
  67.    PNetBlockInfo     =  ^TNetBlockInfo;
  68.   TNetBlockInfo     =  packed  record
  69.      dwBlockMode:   DWORD;
  70.      dwResolution:  DWORD;
  71.       dwTimer:       DWORD;
  72.   end;
  73.  
  74. ////////////////////////////////////////////////////////////////////////////////
  75. //    NetBlock functions
  76. ////////////////////////////////////////////////////////////////////////////////
  77. function    SetNetBlock(lpNetBlockInfo: PNetBlockInfo): DWORD;
  78. function    StatNetBlock(lpNetBlockInfo: PNetBlockInfo): DWORD;
  79. procedure   StopNetBlock;
  80.  
  81. var
  82.   x:       DWORD = 0;
  83.  
  84. implementation
  85.  
  86. ////////////////////////////////////////////////////////////////////////////////
  87. //    Protected variables
  88. ////////////////////////////////////////////////////////////////////////////////
  89. var
  90.    hIphlp:           HMODULE        =  0;
  91.   dwResolution:     DWORD           =  0;
  92.   dwBlockMode:      DWORD          =  0;
  93.   dwTimer:           DWORD          =  0;
  94.   dwProcError:      DWORD          =  0;
  95.    _GetTcpTable:     TGetTcpTable   =  nil;
  96.   _SetTcpEntry:      TSetTcpEntry   =  nil;
  97.  
  98. procedure NetBlockTimerProc(uTimerID,  uMessage: UINT; dwUser, dw1, dw2: DWORD); stdcall;
  99. var  lpTable:        PMIB_TCPTABLE;
  100.      lpRow:         PMIB_TCPROW;
  101.      bRemove:        Boolean;
  102.      dwReturn:      DWORD;
  103.      dwSize:         DWORD;
  104. begin
  105.  
  106.   Inc(x);
  107.  
  108.   // Start with an optimal  table size
  109.   dwSize:=(NB_TABLE_SIZE * SizeOf(MIB_TCPROW)) +  SizeOf(DWORD);
  110.  
  111.   // Allocate memory for the table
  112.    GetMem(lpTable, dwSize);
  113.  
  114.   // Get the table
  115.    dwReturn:=_GetTcpTable(lpTable, @dwSize, False);
  116.  
  117.   // We may  have to reallocate and try again
  118.   if (dwReturn =  ERROR_INSUFFICIENT_BUFFER) then
  119.   begin
  120.      // Reallocate  memory for new table
  121.      ReallocMem(lpTable, dwSize);
  122.      //  Make the call again
  123.      dwReturn:=_GetTcpTable(lpTable,  @dwSize, False);
  124.   end;
  125.  
  126.   // Check for succes
  127.   if  (dwReturn = ERROR_SUCCESS) then
  128.   begin
  129.      // Iterate the table
  130.       for dwSize:=0 to Pred(lpTable^.dwNumEntries) do
  131.      begin
  132.          // Get the row
  133.         lpRow:=@lpTable^.Table[dwSize];
  134.          // Check for 0.0.0.0 address
  135.         if (lpRow^.dwLocalAddr =  0) or (lpRow^.dwRemoteAddr = 0) then Continue;
  136.         // What  blocking mode are we in
  137.         case dwBlockMode of
  138.            //  Need to check the first two bytes in network address
  139.             NB_BLOCK_INTERNET :  bRemove:=not(Word(Pointer(@lpRow^.dwLocalAddr)^)  = Word(Pointer(@lpRow^.dwRemoteAddr)^));
  140.            //  Need to check all four bytes in network address
  141.             NB_BLOCK_ALL      :  bRemove:=not(lpRow^.dwLocalAddr =  lpRow^.dwRemoteAddr);
  142.         else
  143.            // No checking
  144.             bRemove:=False;
  145.         end;
  146.         // Do we need to  remove the entry?
  147.         if bRemove then
  148.         begin
  149.             // Set entry state
  150.            lpRow^.dwState:=MIB_TCP_STATE_DELETE_TCB;
  151.             // Remove the TCP entry
  152.            _SetTcpEntry(lpRow);
  153.          end;
  154.      end;
  155.   end;
  156.  
  157.   // Free the table
  158.    FreeMem(lpTable);
  159.  
  160. end;
  161.  
  162. function StatNetBlock(lpNetBlockInfo:  PNetBlockInfo): DWORD;
  163. begin
  164.  
  165.   // Parameter check
  166.   if  not(Assigned(lpNetBlockInfo)) then
  167.      // Null buffer
  168.       result:=ERROR_INVALID_PARAMETER
  169.   else
  170.   begin
  171.      //  Fill in the current settings
  172.      lpNetBlockInfo^.dwResolution:=dwResolution;
  173.       lpNetBlockInfo^.dwBlockMode:=dwBlockMode;
  174.       lpNetBlockInfo^.dwTimer:=dwTimer;
  175.      // Success
  176.       result:=ERROR_SUCCESS;
  177.   end;
  178.  
  179. end;
  180.  
  181. function  SetNetBlock(lpNetBlockInfo: PNetBlockInfo): DWORD;
  182. begin
  183.  
  184.    // Parameter check
  185.   if not(Assigned(lpNetBlockInfo)) then
  186.    begin
  187.      // Treat the same way as if StopNetBlock had been called
  188.       StopNetBlock;
  189.      // Success
  190.      result:=ERROR_SUCCESS;
  191.    end
  192.   else if (@_GetTcpTable = @_SetTcpEntry) then
  193.      // Failed  to load library or get the function pointers
  194.       result:=dwProcError
  195.   else if (lpNetBlockInfo^.dwResolution =  0) then
  196.      // Invalid time specified
  197.       result:=ERROR_INVALID_PARAMETER
  198.   else if  (lpNetBlockInfo^.dwBlockMode > NB_BLOCK_ALL) then
  199.      //  Invalid blocking mode
  200.      result:=ERROR_INVALID_PARAMETER
  201.    else
  202.   begin
  203.      // Kill the current timer if the blocking is  running
  204.      if (dwTimer > 0) then timeKillEvent(dwTimer);
  205.       // Clear timer tracking handle
  206.      dwTimer:=0;
  207.      // Save off  the current block mode and resolution
  208.      dwBlockMode:=lpNetBlockInfo^.dwBlockMode;
  209.       dwResolution:=lpNetBlockInfo^.dwResolution;
  210.      // If  the block mode is NB_BLOCK_NONE then nothing to do
  211.      if  (dwBlockMode = NB_BLOCK_NONE) then
  212.         // Success
  213.          result:=ERROR_SUCCESS
  214.      else
  215.      begin
  216.         // Create  the timer to handle the network blocking
  217.          dwTimer:=timeSetEvent(lpNetBlockInfo^.dwResolution, 0,  @NetBlockTimerProc, 0, TIME_PERIODIC or TIME_CALLBACK_FUNCTION);
  218.          // Check timer handle
  219.         if (dwTimer = 0) then
  220.             // Failure
  221.            result:=GetLastError
  222.         else
  223.             // Succes
  224.            result:=ERROR_SUCCESS;
  225.      end;
  226.    end;
  227.  
  228. end;
  229.  
  230. procedure StopNetBlock;
  231. begin
  232.  
  233.   //  This will stop the current net blocking
  234.   if (dwTimer > 0) then
  235.    begin
  236.      // Kill the timer
  237.      timeKillEvent(dwTimer);
  238.       // Reset all values
  239.      dwBlockMode:=NB_BLOCK_NONE;
  240.       dwResolution:=0;
  241.      dwTimer:=0;
  242.   end;
  243.  
  244. end;
  245.  
  246. initialization
  247.  
  248.    // Load the ip helper api library
  249.   hIphlp:=LoadLibrary(IPHLPAPI_NAME);
  250.  
  251.    // Attempt to get the function addresses
  252.   if (hIphlp > 0) then
  253.    begin
  254.      @_GetTcpTable:=GetProcAddress(hIpHlp,  GETTCPTABLE_NAME);
  255.      if not(Assigned(@_GetTcpTable)) then
  256.          dwProcError:=GetLastError
  257.      else
  258.      begin
  259.          @_SetTcpEntry:=GetProcAddress(hIpHlp, SETTCPENTRY_NAME);
  260.          if not(Assigned(@_SetTcpEntry)) then dwProcError:=GetLastError
  261.       end;
  262.   end
  263.   else
  264.      // Save off the error
  265.       dwProcError:=GetLastError;
  266.  
  267. finalization
  268.  
  269.   // Kill  the timer if running
  270.   if (dwTimer > 0) then  timeKillEvent(dwTimer);
  271.  
  272.   // Clear functions
  273.    @_GetTcpTable:=nil;
  274.   @_SetTcpEntry:=nil;
  275.  
  276.   // Free the ip  helper api library
  277.   if (hIphlp > 0) then FreeLibrary(hIphlp);
  278.  
  279. end.
  280.  
  281.  
  282. /// Simple Code Untuk melakukan Blocking
  283.   nbiStart.dwBlockMode:=NB_BLOCK_INTERNET; // Blocking type
  284.   nbiStart.dwResolution:=20; // Timer event delay
  285.   SetNetBlock(@nbiStart);
  286.  
  287. ///simple code untuk stop blocking
  288. StopNetBlock;
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement