GetTCPTable

← →
Nucer (2008-12-15 12:33) [0]

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;

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

← →
Сергей М. © (2008-12-15 12:41) [1]

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

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

← →
Nucer (2008-12-15 12:46) [2]

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:57) [3]

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

← →
Nucer (2008-12-15 20:18) [4]

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

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

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

← →
Nucer (2008-12-15 20:21) [5]

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

← →
Eraser © (2008-12-15 21:59) [6]

у меня данный код
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 22:03) [7]

Да у меня мой тоже работает...

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

← →
Eraser © (2008-12-15 22:08) [8]

> [4] Nucer (15.12.08 20:18)

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

скорее всего ошибка вообще не в этом коде. какая то часть приложения портит память. включите опциях компилятора, чтобы в runtime"e были проверки range check и overflow check.

← →
Nucer (2008-12-15 22:12) [9]

Спасибо за совет, попробую. Трудность в том, что это DLL-plugin к чужому приложению и используется Themida. Попробую еще сделать отдельную программу с таким же кодом и дать тем у кого возникает ошибка.

← →
Nucer (2008-12-16 00:55) [10]

Нет, все-таки дело именно в функции. Сделал пустой проект и вставил только кнопку с функцией. Пользователи (у которых были проблемы) получают:
Access violation at address 76D68EB1 in module "IPHLPAPI.DLL". Read of address 009F1F2C.

← →
Германн © (2008-12-16 01:06) [11]

> Nucer (16.12.08 00:55) [10]
>
> Нет, все-таки дело именно в функции. Сделал пустой проект
> и вставил только кнопку с функцией. Пользователи (у которых
> были проблемы) получают:
> Access violation at address 76D68EB1 in module "IPHLPAPI.
> DLL". Read of address 009F1F2C.
>

Ага. Именно в функции. :)
О сколько нам открытий чудных готовит чей-то дух! Выходит виновата функция, которая не умеет работать у "некоторых пользователей".

← →
Eraser © (2008-12-16 01:50) [12]

> [10] Nucer (16.12.08 00:55)

ошибка не в функции, а, к примеру, в выделении кривого участка памяти функцией GetMem, по причине того, что память где то попорчена.

← →
Сергей М. © (2008-12-16 09:01) [13]

> Nucer

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

Что видишь ?

← →
Nucer (2008-12-16 17:11) [14]

> ошибка не в функции, а, к примеру, в выделении кривого участка
> памяти функцией GetMem, по причине того, что память где
> то попорчена

Абсолютно новый проект (file -> new -> application). На форму кидаю TMemo и TButton. В обработчик OnClick вставляю только вызов функции GetPorts.

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;

В результате:

> size: 592
> AfterGetMem
> BeforeFunc
>
> and then another window popup with message:
>
> "Access violation at address 76D68EB1 in module "IPHLPAPI.
> DLL". Read of address 009E9E7C"

Еще один отзыв:

> Access violation at address 76D58EB1 in module "IPHLPAPI.
> DLL" read of address 00A33ADC
>
> debug.exe:
> size: 772
> AfterGetMem
> BeforeFunc

---

> Сергей М.
> Что видишь ?

Сейчас добавлю try/except блок и вывод значения указателя и дам пользователям. Как ответят - скину сюда.

← →
Eraser © (2008-12-16 19:59) [15]

а если попробовать использовать не делфевский менеджер памяти, а системный?

← →
Rouse_ © (2008-12-17 10:33) [16]

> Сергей М. © (15.12.08 12:57) [3]
>
> http://lineage2c5.info/2267_get_tcp_table.html

По ссылке пример кривой, первый параметр обьявлен как указатель на указатель на буффер, второй с тем-же ляпом... Собственно у меня сей пример так и не собрался...

> Nucer (16.12.08 17:11) [14]

Падает на финальной сортировке результатов, при считке первого параметра, он по всей видимости приходит пустым:
.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]

Попробуй отключить сортировку (bOrder = False)

← →
Сергей М. © (2008-12-17 11:49) [17]

> Rouse_ © (17.12.08 10:33) [16]

Угу, вижу

← →
Nucer (2008-12-17 20:40) [18]

Убрал сортировку:

> Access violation at address 0045113C in module "debug.exe".
> Read of address 00958008.
>
> Content of debug.exe:
>
> size: 512
> AfterGetMem
> BeforeFuncEx
> FuncDone

Ну а это уже у тебя падает (обрати внимание на адрес - 0045113C), можешь в отладчике посмотреть где именно память бьется ...

> at address 0045113C

Это адрес в твоем коде, а не в коде IPHLPAPI.

Так что утверждение [10] на поверку оказывается ложным.

← →
Nucer (2008-12-18 11:44) [21]

Ошибка возникает при доступе к той памяти где должна находиться таблица. При включенной сортировке туда сначала обращается IPHLPAPI. Если сортировку отключить, то моя программа:

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

Непонятно почему проблема постоянно возникает на небольшом проценте компьютеров, а у остальных никогда.

← →
Nucer (2008-12-18 11:50) [22]

Как ее можно локализовать - понятия не имею. Сложность в том, что проверить результат (работает или нет) можно только отправив программу пользователям (а они могут ответить и через сутки). Память выделяется, иначе бы процедуру GetMem вызвала исключение.

см. меню Search -> Find Error ..

По всей видимости на машине у проблемных пользователей может стоять некое ПО, приводящее к такому результату. Запроси у них информацию, выдаваемую утилитой MSINFO32 и посмотри что стоит на их машинах.

TCPTable^.dwNumEntries > (Size - sizeof(TCPTable^.dwNumEntries)) div sizeof(TCPTable^.Table[I])
???

← →
amarant555 (2009-01-22 18:30) [26]

http://www.delphisources.ru/pages/faq/base/get_tcp_table.html

GetTCPTable Найти похожие ветки