procedure GetPorts;
var
Size: Cardinal;
TCPTable: PTMibTCPTable;
I: DWORD;
n: integer;
begin
SetLength(ports,0);
GetMem(TCPTable, SizeOf(TMibTCPTable));
try
 Size:=0;
 if GetTcpTable(TCPTable, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
finally
 FreeMem(TCPTable);
end;
GetMem(TCPTable, Size);
try
 if GetTcpTable(TCPTable, Size, True) = NO_ERROR then
    begin
     for i:=0 to TCPTable^.dwNumEntries - 1 do
        begin
         if TCPTable^.Table[I].dwState=MIB_TCP_STATE_LISTEN then
            begin
             n:=length(ports);
             setlength(ports,n+1);
             ports[n]:=htons(TCPTable^.Table[I].dwLocalPort);
            end;
        end;
    end;
finally
 FreeMem(TCPTable);
end;
end;

 PTMibTCPRow = ^TMibTCPRow;
 TMibTCPRow = packed record
   dwState: DWORD;
   dwLocalAddr: DWORD;
   dwLocalPort: DWORD;
   dwRemoteAddr: DWORD;
   dwRemotePort: DWORD;
 end;

 PTMibTCPTable = ^TMibTCPTable;
 TMibTCPTable = packed record
   dwNumEntries: DWORD;
   Table: array[0..0] of TMibTCPRow;
 end;

 function GetTcpTable(pTCPTable: PTMibTCPTable; var pDWSize: DWORD;
   bOrder: BOOL): DWORD; stdcall; external 'IPHLPAPI.DLL';

procedure TForm1.Button1Click(Sender: TObject);
var
 Size: Cardinal;
 TCPTable: PMibTcpTable;
 I: DWORD;
 n: integer;
 ports: array of Integer;
begin
 SetLength(ports, 0);
 GetMem(TCPTable, SizeOf(TMibTCPTable));
 try
   Size := 0;
   if GetTcpTable(TCPTable, Size, True) <> ERROR_INSUFFICIENT_BUFFER then
     Exit;
 finally
   FreeMem(TCPTable);
 end;

 GetMem(TCPTable, Size);
 try
   if GetTcpTable(TCPTable, Size, True) = NO_ERROR then
   begin
     for i := 0 to TCPTable^.dwNumEntries - 1 do
     begin
       if TCPTable^.Table[I].dwState=MIB_TCP_STATE_LISTEN then
       begin
         n := Length(ports);
         SetLength(ports, n+1);
         ports[n] := htons(TCPTable^.Table[I].dwLocalPort);
       end;
     end;
   end;
 finally
   FreeMem(TCPTable);
 end;
end;

type
 PMIB_TCPTABLE = ^MIB_TCPTABLE;
 {$EXTERNALSYM PMIB_TCPTABLE}
 _MIB_TCPTABLE = record
   dwNumEntries: DWORD;
   table: array [0..ANY_SIZE - 1] of MIB_TCPROW;
 end;
 {$EXTERNALSYM _MIB_TCPTABLE}
 MIB_TCPTABLE = _MIB_TCPTABLE;
 {$EXTERNALSYM MIB_TCPTABLE}
 TMibTcpTable = MIB_TCPTABLE;
 PMibTcpTable = PMIB_TCPTABLE;

function GetTcpTable(pTcpTable: PMIB_TCPTABLE; var pdwSize: DWORD; bOrder: BOOL): DWORD; stdcall;

Access violation at address 76D68EB1 in module 'IPHLPAPI.DLL'. Read of address 009F1F2C.

..
GetMem(TCPTable, Size);
try
  try
    if GetTcpTable(TCPTable, Size, True) = NO_ERROR then
    begin
     ...
  finally
    FreeMem(TCPTable);
  end;
 except
   ShowMessage('Size = ' + IntToStr(Size) + ' BufPtr = ' + IntToHex(Integer(TCPTable), 8));
 end;

procedure ATL(s:string);
begin
frmMain.mLog.lines.add(s);
end;

procedure GetPorts;
var
Size: Cardinal;
TCPTable: PTMibTCPTable;
I: DWORD;
n: integer;
begin
SetLength(ports,0);
//try
 GetMem(TCPTable, SizeOf(TMibTCPTable));
 try
  Size:=0;
  if GetTcpTable(TCPTable, Size, True) <> ERROR_INSUFFICIENT_BUFFER then Exit;
 finally
  FreeMem(TCPTable);
 end;
 ATL('size: '+IntToStr(size));
 GetMem(TCPTable, Size);
 ATL('AfterGetMem');
 try                      
  ATL('BeforeFunc');
  if GetTcpTable(TCPTable, Size, True) = NO_ERROR then
     begin
      ATL('FuncDone');
      for i:=0 to TCPTable^.dwNumEntries - 1 do
         begin
          if TCPTable^.Table[I].dwState=MIB_TCP_STATE_LISTEN then
             begin
              n:=length(ports);
              setlength(ports,n+1);
              ports[n]:=htons(TCPTable^.Table[I].dwLocalPort);
             end;
         end;
      ATL('AfterFor');
     end;
  ATL('AfterBlock');
 finally
  FreeMem(TCPTable);
 end;
//except
// SetLength(ports,0);
//end;
end;

.text:76D58EAE                 mov     eax, [ebp+arg_4]
.text:76D58EB1                 mov     edx, [eax+4] <- вот тут падение
.text:76D58EB4                 mov     eax, [ebp+arg_0]
.text:76D58EB7                 mov     ecx, [eax+4]