lazarus/components/simplewebservergui/simplewebsrvutils.pas

798 lines
21 KiB
ObjectPascal

{
Author: Mattias Gaertner
}
unit SimpleWebSrvUtils;
{$mode objfpc}{$H+}
{$IFOPT R+}{$DEFINE RangeChecking}{$ENDIF}
interface
uses
{$IFDEF MSWindows}
Windows,
{$ENDIF}
{$IFDEF Unix}
BaseUnix, Errors,
{$ENDIF}
Classes, SysUtils, Types, Sockets, Process,
// lazutils
LazLoggerBase, FileUtil,
// LCL
Dialogs,
// IDEIntf
IDEDialogs,
SimpleWebSrvStrConsts;
type
{ TSimpleWebServerUtility }
TSimpleWebServerUtility = class
private
FViewCaption: string;
{$IFDEF Darwin}
function FindProcessListeningOnPortMac(const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer): boolean;
function KillProcessMac(aPID: integer): boolean;
function FindFreePortMac(aStartPort: word; AvoidPorts: TWordDynArray): word;
{$ENDIF}
{$IFDEF Linux}
function FindProcessListeningOnPortLinux(const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer): boolean;
function KillProcessLinux(aPID: integer): boolean;
function FindFreePortLinux(aStartPort: word; AvoidPorts: TWordDynArray): word;
{$ENDIF}
{$IFDEF MSWindows}
function FindProcessListeningOnPortWin(const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer): boolean;
function KillProcessWin(aPID: integer): boolean;
function FindFreePortWin(aStartPort: word; AvoidPorts: TWordDynArray): word;
{$ENDIF}
public
function FindProcessListeningOnPort(const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer): boolean;
function KillProcess(aPID: integer): boolean;
function FindFreePort(aStartPort: word; Interactive: boolean; AvoidPorts: TWordDynArray): word;
function SameInAddr(const A,B: in_addr): boolean;
property ViewCaption: string read FViewCaption write FViewCaption;
end;
{$IFDEF MSWindows}
{$linklib iphlpapi}
{$linklib psapi}
const
ANY_SIZE = 1;
type
PMIB_TCPROW2 = ^MIB_TCPROW2;
MIB_TCPROW2 = record
dwState: DWORD;
dwLocalAddr: DWORD;
dwLocalPort: DWORD;
dwRemoteAddr: DWORD;
dwRemotePort: DWORD;
dwOwningPid: DWORD;
dwTCPOffloadState: DWORD;
end;
PMIB_TCPTABLE2 = ^MIB_TCPTABLE2;
MIB_TCPTABLE2 = record
dwNumEntries: DWORD;
table: array [0..ANY_SIZE - 1] of MIB_TCPROW2;
end;
function GetTcpTable2(pTcpTable: PMIB_TCPTABLE2; var pdwSize: DWORD; bOrder: BOOL): DWORD; stdcall; external name 'GetTcpTable2';
function GetModuleFilenameExW(hndProcess: HANDLE; hndModule: HMODULE; lpFilename: LPWSTR; nSize: DWord): DWord; stdcall; external name 'GetModuleFileNameExW';
{$ENDIF}
function MaybeQuote(S : String) : String;
function ReadNext(const Line: string; var p: integer): string;
function GetNextIPPort(Port: word): word;
implementation
function ReadNext(const Line: string; var p: integer): string;
var
l: SizeInt;
StartP: Integer;
begin
Result:='';
l:=length(Line);
if p>l then exit;
while (p<=l) and (Line[p] in [' ',#9]) do inc(p);
StartP:=p;
while (p<=l) and not (Line[p] in [' ',#9]) do inc(p);
Result:=copy(Line,StartP,p-StartP);
end;
function GetNextIPPort(Port: word): word;
begin
if Port=high(word) then
Result:=1024
else
Result:=Port+1;
end;
function MaybeQuote(S: String): String;
begin
if Pos(' ',S)=0 then
Result:=S
else
Result:='"'+S+'"';
end;
function TSimpleWebServerUtility.FindProcessListeningOnPort(
const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer
): boolean;
begin
Result:=false;
aDesc:='';
aPID:=0;
try
{$IFDEF Darwin}
Result:=FindProcessListeningOnPortMac(IPAddr,aPort,aDesc,aPID);
{$ENDIF}
{$IFDEF Linux}
Result:=FindProcessListeningOnPortLinux(IPAddr,aPort,aDesc,aPID);
{$ENDIF}
{$IFDEF MSWindows}
Result:=FindProcessListeningOnPortWin(IPAddr,aPort,aDesc,aPID);
{$ENDIF}
except
on E: Exception do begin
IDEMessageDialog(rsSWError,
ViewCaption+':'+sLineBreak
+Format(rsSWErrorCheckingWhichProcessUsesTCPPort, [IntToStr(aPort)])+
sLineBreak
+E.Message,mtError,[mbOK]);
end;
end;
end;
function TSimpleWebServerUtility.KillProcess(aPID: integer): boolean;
begin
Result:=false;
try
{$IFDEF Darwin}
Result:=KillProcessMac(aPID);
{$ENDIF}
{$IFDEF Linux}
Result:=KillProcessLinux(aPID);
{$ENDIF}
{$IFDEF MSWindows}
Result:=KillProcessWin(aPID);
{$ENDIF}
except
on E: Exception do begin
IDEMessageDialog(rsSWError,
ViewCaption+':'+sLineBreak
+Format(rsSWErrorKillingProcess, [IntToStr(aPID)])+sLineBreak
+E.Message,mtError,[mbOK]);
end;
end;
end;
function TSimpleWebServerUtility.FindFreePort(aStartPort: word;
Interactive: boolean; AvoidPorts: TWordDynArray): word;
begin
Result:=0;
try
{$IFDEF Darwin}
Result:=FindFreePortMac(aStartPort,AvoidPorts);
{$ENDIF}
{$IFDEF Linux}
Result:=FindFreePortLinux(aStartPort,AvoidPorts);
{$ENDIF}
{$IFDEF MSWindows}
Result:=FindFreePortWin(aStartPort,AvoidPorts);
{$ENDIF}
except
on E: Exception do begin
if not Interactive then
exit(0);
IDEMessageDialog(rsSWError,
ViewCaption+':'+sLineBreak
+rsSWErrorFindingFreeTCPPort+sLineBreak
+E.Message,mtError,[mbOK]);
end;
end;
end;
function TSimpleWebServerUtility.SameInAddr(const A, B: in_addr): boolean;
begin
if (A.s_addr=0) or (B.s_addr=0) then
Result:=true
else
Result:=A.s_addr=B.s_addr;
end;
{$IFDEF Darwin}
function ParseLsofAddr(s: string; out IPAddr: in_Addr; out aPort: word): boolean;
// e.g. 192.168.16.193:64174->35.82.112.36:443 (ESTABLISHED)
// 127.0.0.1:7777 (LISTEN)
// *:7000 (LISTEN)
var
p, StartP: SizeInt;
CurAddr: String;
i: LongInt;
begin
Result:=false;
IPAddr.s_addr:=0;
aPort:=0;
p:=Pos(':',s);
if p<1 then exit;
CurAddr:=LeftStr(s,p-1);
if CurAddr='*' then
IPAddr.s_addr:=0
else
IPAddr:=StrToHostAddr(CurAddr);
inc(p);
if p>length(s) then exit;
if s[p]='*' then
exit(true); // ip:*
StartP:=p;
while (p<=length(s)) and (s[p] in ['0'..'9']) do inc(p);
if p-StartP>5 then exit;
i:=StrToIntDef(copy(s,StartP,p-StartP),0);
if (i<=0) or (i>65535) then exit;
aPort:=i;
Result:=true;
end;
function TSimpleWebServerUtility.FindProcessListeningOnPortMac(
const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer
): boolean;
const
lsofparams = '-nPi4:';
var
ExePath, Params, OutStr, s, PIDStr, CurLocalAddr, Line, CurUserName,
CurArgs: String;
sl: TStringList;
i, p: Integer;
CurPort: word;
CurIPAddr: in_addr;
UserPos, ArgsPos: SizeInt;
begin
Result:=false;
aDesc:='';
aPID:=0;
if aPort=0 then exit;
// query lsof to find the PID listening on IPv4 tcp/udp port
ExePath:=FindDefaultExecutablePath('lsof');
if ExePath='' then
begin
debugln(['Hint: [20220114175144] FindProcessListeningOnPortMac "lsof" not found in PATH']);
exit;
end;
Params:=lsofparams+IntToStr(aPort);
if not RunCommand(ExePath,[Params],OutStr,[]) then
begin
debugln(['Hint: [20220114175148] FindProcessListeningOnPortMac could not run "'+ExePath+' '+Params+'"']);
exit;
end;
sl:=TStringList.Create;
try
sl.Text:=OutStr;
for i:=0 to sl.Count-1 do
begin
Line:=sl[i];
// COMMAND PID USER FD TYPE DEVICE SIZE/OFF NODE NAME
p:=1;
s:=ReadNext(Line,p); // command
if s='' then continue;
PIDStr:=ReadNext(Line,p); // PID
if PIDStr='' then continue;
s:=ReadNext(Line,p); // USER
if s='' then continue;
s:=ReadNext(Line,p); // FD
if s='' then continue;
s:=ReadNext(Line,p); // TYPE
if s='' then continue;
s:=ReadNext(Line,p); // DEVICE
if s='' then continue;
s:=ReadNext(Line,p); // SIZE
if s='' then continue;
s:=ReadNext(Line,p); // NODE
if s='' then continue;
CurLocalAddr:=ReadNext(Line,p); // NAME, e.g. 192.168.16.193:64174->35.82.112.36:443 (ESTABLISHED) or 127.0.0.1:7777 (LISTEN) or *:7000 (LISTEN)
if CurLocalAddr='' then continue;
if not ParseLsofAddr(CurLocalAddr,CurIPAddr,CurPort) then continue;
if not SameInAddr(CurIPAddr,IPAddr) then continue;
aPID:=StrToIntDef(PIDStr,0);
if aPID>0 then
begin
debugln(['Hint: [20220117195255] FindProcessListeningOnPortMac ',CurLocalAddr,':',CurPort,' ',aPID]);
Result:=true;
end;
break;
end;
if aPID=0 then exit;
finally
sl.Free;
end;
// query ps for command line of PID
ExePath:=FindDefaultExecutablePath('ps');
if ExePath='' then
begin
debugln(['Hint: [20220114182717] FindProcessListeningOnPortMac "ps" not found in PATH']);
exit;
end;
if not RunCommand(ExePath,['-p',IntToStr(aPID),'-o','pid,user,args'],OutStr,[]) then
begin
debugln(['Hint: [20220114182751] FindProcessListeningOnPortMac could not run "'+ExePath+' -p '+IntToStr(aPID)+' -o pid,user,args"']);
exit;
end;
//debugln(['FindProcessListeningOnPortLinux ps OutStr={',OutStr,'}']);
sl:=TStringList.Create;
try
sl.Text:=OutStr;
if sl.Count<2 then
begin
debugln(['Hint: [20220114182832] FindProcessListeningOnPortLinux ps returned no info']);
exit;
end;
Line:=sl[0];
UserPos:=Pos('USER',Line);
if UserPos<1 then
begin
debugln(['Hint: [20220114182857] FindProcessListeningOnPortLinux ps returned no USER']);
exit;
end;
ArgsPos:=Pos('ARGS',Line);
if ArgsPos<1 then
begin
debugln(['Hint: [20220114182911] FindProcessListeningOnPortLinux ps returned no ARGS']);
exit;
end;
Line:=sl[1];
CurUserName:=Trim(copy(Line,UserPos,ArgsPos-UserPos));
CurArgs:=Trim(copy(Line,ArgsPos,length(Line)));
aDesc:='User: '+CurUserName+sLineBreak
+'Args: '+CurArgs;
finally
sl.Free;
end;
end;
function TSimpleWebServerUtility.KillProcessMac(aPID: integer): boolean;
var
e: LongInt;
begin
if FpKill(aPID,SIGTERM)=0 then exit(true);
e:=fpgeterrno;
IDEMessageDialog('Error',
ViewCaption+':'+sLineBreak
+'Unable to kill pid '+IntToStr(aPID)+sLineBreak
+sys_errlist[e],
mtError,[mbOk]);
Result:=false;
end;
function TSimpleWebServerUtility.FindFreePortMac(aStartPort: word;
AvoidPorts: TWordDynArray): word;
const
lsofparams = '-nPi4';
var
ExePath, Params, OutStr, s, CurLocalAddr, Line: String;
sl: TStringList;
i, p: Integer;
CurPort: word;
CurIPAddr: in_addr;
Ports: array of word;
l: SizeInt;
begin
Result:=aStartPort;
if aStartPort=0 then exit;
// query lsof to find the IPv4 tcp/udp ports
ExePath:=FindDefaultExecutablePath('lsof');
if ExePath='' then
begin
debugln(['Hint: [20220114183430] FindFreePortMac "lsof" not found in PATH']);
exit;
end;
Params:=lsofparams;
if not RunCommand(ExePath,[Params],OutStr,[]) then
begin
debugln(['Hint: [20220114183449] FindFreePortMac could not run "'+ExePath+' '+Params+'"']);
exit;
end;
Ports:=copy(AvoidPorts);
sl:=TStringList.Create;
try
sl.Text:=OutStr;
for i:=0 to sl.Count-1 do
begin
Line:=sl[i];
// COMMAND PID USER FD TYPE DEVICE SIZE/OFF NODE NAME
p:=1;
s:=ReadNext(Line,p); // command
if s='' then continue;
s:=ReadNext(Line,p); // PID
if s='' then continue;
s:=ReadNext(Line,p); // USER
if s='' then continue;
s:=ReadNext(Line,p); // FD
if s='' then continue;
s:=ReadNext(Line,p); // TYPE
if s='' then continue;
s:=ReadNext(Line,p); // DEVICE
if s='' then continue;
s:=ReadNext(Line,p); // SIZE
if s='' then continue;
s:=ReadNext(Line,p); // NODE
if s='' then continue;
CurLocalAddr:=ReadNext(Line,p); // NAME, e.g. 192.168.16.193:64174->35.82.112.36:443 (ESTABLISHED) or 127.0.0.1:7777 (LISTEN) or *:7000 (LISTEN)
if CurLocalAddr='' then continue;
if not ParseLsofAddr(CurLocalAddr,CurIPAddr,CurPort) then continue;
l:=length(Ports);
SetLength(Ports,l+1);
Ports[l]:=CurPort;
end;
finally
sl.Free;
end;
l:=length(Ports);
Result:=aStartPort;
repeat
i:=l-1;
while (i>=0) and (Ports[i]<>Result) do dec(i);
if i<0 then exit;
Result:=GetNextIPPort(Result);
until Result=aStartPort;
Result:=0;
end;
{$ENDIF} // Darwin
{$IFDEF Linux}
function TSimpleWebServerUtility.FindProcessListeningOnPortLinux(
const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer
): boolean;
const NetstatParams = '-nlptu4';
var
ExePath, OutStr, Line, PIDPrg, CurLocalAddr, CurUserName, CurArgs: String;
sl: TStringList;
i: Integer;
LocalAddrPos, ForeignAddrPos, PIDPos, p, UserPos, ArgsPos: SizeInt;
CurPort: LongInt;
LocalInAddr: in_addr;
begin
Result:=false;
aDesc:='';
aPID:=0;
if aPort=0 then exit;
// query netstat to find the PID listening on IPv4 tcp/udp port
ExePath:=FindDefaultExecutablePath('netstat');
if ExePath='' then
begin
DebugLn(['Hint: [20220108222805] FindProcessListeningOnPortLinux "netstat" not found in PATH']);
exit;
end;
if not RunCommand(ExePath,[NetstatParams],OutStr,[]) then
begin
debugln(['Hint: [20220108222923] FindProcessListeningOnPortLinux could not run "'+ExePath+' '+NetstatParams+'"']);
exit;
end;
sl:=TStringList.Create;
try
sl.Text:=OutStr;
for i:=0 to sl.Count-1 do
begin
Line:=sl[i];
if (LeftStr(Line,5)='Proto') then
begin
LocalAddrPos:=Pos('Local Address',Line);
ForeignAddrPos:=Pos('Foreign Address',Line);
PIDPos:=Pos('PID/Program name',Line);
end else if (LeftStr(Line,4)='tcp ') or (LeftStr(Line,4)='udp ') then
begin
CurLocalAddr:=Trim(copy(Line,LocalAddrPos,ForeignAddrPos-LocalAddrPos));
p:=Pos(':',CurLocalAddr);
if p<1 then continue;
CurPort:=StrToIntDef(copy(CurLocalAddr,p+1,length(CurLocalAddr)),0);
if CurPort<>aPort then continue;
LocalInAddr:=StrToHostAddr(CurLocalAddr);
if not SameInAddr(LocalInAddr,IPAddr) then continue;
PIDPrg:=Trim(copy(Line,PIDPos,length(Line)));
p:=Pos('/',PIDPrg);
if p<1 then continue;
aPID:=StrToIntDef(LeftStr(PIDPrg,p-1),0);
if aPID>0 then
begin
aDesc:=copy(PIDPrg,p+1,length(PIDPrg));
Result:=true;
end;
break;
end;
end;
if aPID=0 then exit;
finally
sl.Free;
end;
// query ps for command line of PID
ExePath:=FindDefaultExecutablePath('ps');
if ExePath='' then
begin
debugln(['Hint: [20220108230143] FindProcessListeningOnPortLinux "ps" not found in PATH']);
exit;
end;
if not RunCommand(ExePath,['-q',IntToStr(aPID),'-eo','pid,euser,args'],OutStr,[]) then
begin
debugln(['Hint: [20220108230145] FindProcessListeningOnPortLinux could not run "'+ExePath+' -q '+IntToStr(aPID)+' -eo pid,euser,args"']);
exit;
end;
//debugln(['FindProcessListeningOnPortLinux ps OutStr={',OutStr,'}']);
sl:=TStringList.Create;
try
sl.Text:=OutStr;
if sl.Count<2 then
begin
debugln(['Hint: [20220108230953] FindProcessListeningOnPortLinux ps returned no info']);
exit;
end;
Line:=sl[0];
UserPos:=Pos('EUSER',Line);
if UserPos<1 then
begin
debugln(['Hint: [20220108231209] FindProcessListeningOnPortLinux ps returned no euser']);
exit;
end;
ArgsPos:=Pos('COMMAND',Line);
if ArgsPos<1 then
begin
debugln(['Hint: [20220108231236] FindProcessListeningOnPortLinux ps returned no args']);
exit;
end;
Line:=sl[1];
CurUserName:=Trim(copy(Line,UserPos,ArgsPos-UserPos));
CurArgs:=Trim(copy(Line,ArgsPos,length(Line)));
aDesc:='User: '+CurUserName+sLineBreak
+'Args: '+CurArgs;
finally
sl.Free;
end;
end;
function TSimpleWebServerUtility.KillProcessLinux(aPID: integer): boolean;
var
e: LongInt;
begin
if FpKill(aPID,SIGTERM)=0 then exit(true);
e:=fpgeterrno;
IDEMessageDialog('Error',
ViewCaption+':'+sLineBreak
+'Unable to kill pid '+IntToStr(aPID)+sLineBreak
+sys_errlist[e],
mtError,[mbOk]);
Result:=false;
end;
function TSimpleWebServerUtility.FindFreePortLinux(aStartPort: word;
AvoidPorts: TWordDynArray): word;
const NetstatParams = '-nlptu4';
var
ExePath, OutStr, Line, CurLocalAddr: String;
sl: TStringList;
i: Integer;
LocalAddrPos, ForeignAddrPos, p, l: SizeInt;
CurPort: LongInt;
Ports: TWordDynArray;
begin
Result:=0;
// query netstat to find the IPv4 tcp/udp ports
ExePath:=FindDefaultExecutablePath('netstat');
if ExePath='' then
begin
debugln(['Hint: [20220110163919] FindFreePortLinux "netstat" not found in PATH']);
IDEMessageDialog('Error',
ViewCaption+':'+sLineBreak
+'Unable to find netstat utility',mtError,[mbOk]);
exit;
end;
if not RunCommand(ExePath,[NetstatParams],OutStr,[]) then
begin
debugln(['Hint: [20220110163930] FindFreePortLinux could not run "'+ExePath+' '+NetstatParams+'"']);
IDEMessageDialog('Error',
ViewCaption+':'+sLineBreak
+'Could not run "'+ExePath+' '+NetstatParams+'"',mtError,[mbOk]);
exit;
end;
Ports:=copy(AvoidPorts);
sl:=TStringList.Create;
try
sl.Text:=OutStr;
for i:=0 to sl.Count-1 do
begin
Line:=sl[i];
if (LeftStr(Line,5)='Proto') then
begin
LocalAddrPos:=Pos('Local Address',Line);
ForeignAddrPos:=Pos('Foreign Address',Line);
end else if (LeftStr(Line,4)='tcp ') or (LeftStr(Line,4)='udp ') then
begin
CurLocalAddr:=Trim(copy(Line,LocalAddrPos,ForeignAddrPos-LocalAddrPos));
p:=Pos(':',CurLocalAddr);
if p<1 then continue;
CurPort:=StrToIntDef(copy(CurLocalAddr,p+1,length(CurLocalAddr)),0);
if CurPort=0 then continue;
l:=length(Ports);
SetLength(Ports,l+1);
Ports[l]:=CurPort;
end;
end;
finally
sl.Free;
end;
l:=length(Ports);
Result:=aStartPort;
repeat
i:=l-1;
while (i>=0) and (Ports[i]<>Result) do dec(i);
if i<0 then exit;
Result:=GetNextIPPort(Result);
until Result=aStartPort;
Result:=0;
end;
{$ENDIF} // Linux
{$IFDEF MSWindows}
function TSimpleWebServerUtility.FindProcessListeningOnPortWin(
const IPAddr: in_addr; aPort: word; out aDesc: string; out aPID: integer
): boolean;
var
pTCPTable: PMIB_TCPTABLE2;
LocalPort: word;
aSize, r: dword;
LocalAddr: in_addr;
i: Integer;
h: HANDLE;
CurExeName: array[0..MAX_PATH] of WideChar;
begin
Result:=false;
aDesc:='';
aPID:=0;
if aPort=0 then exit;
aSize:=SizeOf(MIB_TCPTABLE2);
pTCPTable:=GetMem(aSize);
if pTCPTable=nil then exit;
try
r:=GetTcpTable2(pTCPTable,aSize,true);
if r=ERROR_INSUFFICIENT_BUFFER then
begin
ReAllocMem(pTCPTable,aSize);
if pTCPTable=nil then exit;
end;
r:=GetTcpTable2(pTCPTable,aSize,true);
if r<>NO_ERROR then exit;
{$R-}
for i:=0 to pTCPTable^.dwNumEntries-1 do
begin
LocalPort:=NToHs(word(pTCPTable^.table[i].dwLocalPort));
if LocalPort<>aPort then continue;
LocalAddr.s_addr:=NToHl(pTCPTable^.table[i].dwLocalAddr);
if not SameInAddr(LocalAddr,IPAddr) then continue;
aPid:=pTCPTable^.table[i].dwOwningPid;
if aPid=0 then continue;
Result:=true;
break;
end;
{$IFDEF RangeChecking}{$R+}{$ENDIF}
finally
if pTCPTable<>nil then
Freemem(pTCPTable);
end;
if not Result then exit;
h:=OpenProcess(PROCESS_QUERY_INFORMATION or PROCESS_VM_READ, WINBOOL(false), aPid);
if h=0 then exit;
try
aSize:=GetModuleFilenameExW(h,0,@CurExeName[0],length(CurExeName));
if aSize>0 then
begin
aDesc:=CurExeName;
end;
finally
CloseHandle(h);
end;
end;
function TSimpleWebServerUtility.KillProcessWin(aPID: integer): boolean;
var
h: HANDLE;
begin
if aPid<=0 then exit(false);
h:=OpenProcess(PROCESS_TERMINATE, WINBOOL(false), aPid);
if h=0 then exit;
try
Result:=TerminateProcess(h,0);
finally
CloseHandle(h);
end;
if not Result then
begin
IDEMessageDialog('Error',
ViewCaption+':'+sLineBreak
+'Unable to kill pid '+IntToStr(aPID),
mtError,[mbOk]);
end;
end;
function TSimpleWebServerUtility.FindFreePortWin(aStartPort: word;
AvoidPorts: TWordDynArray): word;
var
pTCPTable: PMIB_TCPTABLE2;
aSize, r: DWord;
i: Integer;
LocalPort: Word;
Ports: array of Word;
l: SizeInt;
begin
Result:=0;
aSize:=SizeOf(MIB_TCPTABLE2);
pTCPTable:=GetMem(aSize);
if pTCPTable=nil then exit;
try
r:=GetTcpTable2(pTCPTable,aSize,true);
if r=ERROR_INSUFFICIENT_BUFFER then
begin
ReAllocMem(pTCPTable,aSize);
if pTCPTable=nil then exit;
end;
r:=GetTcpTable2(pTCPTable,aSize,true);
if r<>NO_ERROR then exit;
Ports:=copy(AvoidPorts);
{$R-}
for i:=0 to pTCPTable^.dwNumEntries-1 do
begin
LocalPort:=NToHs(word(pTCPTable^.table[i].dwLocalPort));
l:=length(Ports);
SetLength(Ports,l+1);
Ports[l]:=LocalPort;
end;
{$IFDEF RangeChecking}{$R+}{$ENDIF}
finally
if pTCPTable<>nil then
Freemem(pTCPTable);
end;
l:=length(Ports);
Result:=aStartPort;
repeat
i:=l-1;
while (i>=0) and (Ports[i]<>Result) do dec(i);
if i<0 then exit;
Result:=GetNextIPPort(Result);
until Result=aStartPort;
Result:=0;
end;
{$ENDIF} // MSWindows
end.