| Новости | Поиск | FAQ | Статьи | Книги | Новости VCL | | Форумы ЧАТ | Орешник | KOL и MCK |
Форумы -» Основная («Начинающим»)/ Базы / WinAPI / Компоненты / Сети / Media / Игры / Corba и COM / KOL / FreePascal / .Net / Прочее / RSDN.ORG

	« предыдущая ветвь | форум | следующая ветвь »

GetTCPTable

Страницы:   < 1 2 >

Nucer ©   (2008-12-15 12:33:00) 

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;

При втором вызове приложение вылетает с ошибкой. Подскажите, в чем может быть ошибка?

---

Eraser   (2008-12-15 21:59:00) [21]

у меня данный код
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;
отлично работает. протитипы взяти из JEDI API - JwaIpHlpApi, JwaIpRtrMib:
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;


---

Nucer   (2008-12-15 20:21:00) [22]

Мой код по сути взят из примера Rouse_:
http://forum.sources.ru/index.php?showtopic=81522

---

Nucer   (2008-12-15 20:18:00) [23]

Честно говоря существенной разницы не уловил. В прототипе у них var перед первым параметром и разыменование при вызове, у меня же var нет и разыменования нет.

И мой код больше похож на пример из MSDN:
http://msdn.microsoft.com/en-us/library/aa366026(VS.85).aspx

Дело в том, что программа вылетает где-то на одном компьютере из сотни (и на XP, и на Vista). В чем дело - понять не могу. Size при первом вызове возвращается нормальный (не 0). GetMem проходит нормально, а при втором вызове ошибка.

---

Сергей М.   (2008-12-15 12:57:00) [24]

http://lineage2c5.info/2267_get_tcp_table.html

---

Nucer   (2008-12-15 12:46:00) [25]

 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';

---

Сергей М.   (2008-12-15 12:41:00) [26]

> в чем может быть ошибка?


Приведи свой прототип GetTcpTable

---

Страницы:   < 1 2 >

Наверх