Trochę zaadoptowałem powyższy kod dla swoich potrzeb.
Jest oky - nie potrzeba podawać zakresów wew. adresów IP
Automatycznie pobiera zakres w zależności od IP lokalnego usera.
Prosiłbym kolegów o sprawdzenie czy prawidłowo podaje zewnętrzne IP ?
U mnie działa, ale nie wiem jak u innych, bo są rózne topografie sieci.
UNIT modIPdostawca;
INTERFACE
Uses
WinSock,Windows, Classes,SysUtils;
Type
IP_INFO = Packed record
TTL :Byte;
Tos :Byte;
IPflags :Byte;
OptSize :Byte;
Options :Pointer;
end;
pIP_INFO = ^IP_INFO;
ICMP_ECHO = Packed record
Source :Longint;
Status :Longint;
RTtime :Longint;
DataSize :Word;
Reserved :Word;
pData :Pointer;
i_ipinfo :IP_INFO;
end;
FUNCTION GetLokalneIP:String;
FUNCTION IPdostawcy(Adres:String):String;
IMPLEMENTATION
Uses
{unit programu
tymczasowo zadeklarowany by podejrzeć działanie w Memo1}
Unit1;
Function IcmpCreateFile: THandle; stdcall; external 'ICMP.DLL' name 'IcmpCreateFile';
Function IcmpCloseHandle(IcmpHandle: THandle): BOOL; stdcall; external 'ICMP.DLL' name 'IcmpCloseHandle';
Function IcmpSendEcho(IcmpHandle : THandle; DestAddress: Longint; RequestData: Pointer; RequestSize: Word; RequestOptns: pIP_INFO; ReplyBuffer: Pointer; ReplySize, Timeout: DWORD): DWORD;
stdcall; external 'ICMP.DLL' name 'IcmpSendEcho';
Var
TraceHandle :THandle;
DestAddr :in_addr;
{Fukcja pobiera lokalny adres IP}
FUNCTION GetLokalneIP:String;
var
WSAData :TWSAData;
buffor :array [0..255] of char;
hostEnt :PHostEnt;
Begin
Result:= '';
if WSAStartup($0101, WSAData) = 0 then
try
GetHostName(buffor,Length(buffor));
hostEnt:= GetHostByName(buffor);
CopyMemory(@buffor[0], Inet_ntoa(PInAddr(hostEnt^.h_addr_list^)^),Length(buffor));
Result:= buffor;
finally
WSACleanup;
end;
End; //ok. Win 98/XP
{ Obcina końcówkę lokalnego IP }
Function Obetnij(IP :String):String;
var
lista :TStringList;
Begin
lista:= TStringList.Create;
try
//dzielenie IP wg znaku dzielącego "." dla IP będą to 4 części
ExtractStrings(['.'], [],PChar(IP),lista);
//wyswietlenie ze zmiennej List - zdania numer 3
Result:= lista[0]+'.' + lista[1]+'.';
except
Result:= '';
end;
lista.Free;
End; //ok. Win 98/XP
{ Formatuje dane }
FUNCTION GetDottetIP(const IP:Longint):String;
Begin
Result:= Format('%d.%d.%d.%d',[IP and $FF,(IP shr 8)
and $FF,(IP shr 16)
and $FF, (IP shr 24)
and $FF]);
End; //ok. Win 98/XP
{ Wysyła echo }
FUNCTION TraceOute(const Iteration:Byte):Integer;
var
IP :IP_INFO;
ECHO :^ICMP_ECHO;
Error :Integer;
Begin
GetMem(ECHO,SizeOf(ICMP_ECHO));
try
with IP do
begin
TTL:= Iteration;
Tos := 0;
IPflags:= 0;
OptSize:= 0;
Options:= nil;
end;
Error:= IcmpSendEcho(TraceHandle, DestAddr.S_addr,nil,0,@IP,ECHO,SizeOf(ICMP_ECHO),5000);
if Error = 0 then
begin
Result:= -1;
Exit;
end;
Result:= ECHO.Source;
finally
FreeMem(ECHO);
end;
End; //ok. Win 98/XP
{Funkcja śledzi trasę pakietów na podany adres
i wydobywa z niej IP dostawcy mające być IP zewnętrznym usera.
Pobiera kolejne IP występujące po drodze pakietu,
zatrzymując się na pierwszym IP podanym w zakresie,
np: gdy napotkał '192.168.'}
FUNCTION IPdostawcy(Adres:String):String;
const
IterationCount = 30;
var
WSAData :TWSAData;
buffor :array [0..255] of char;
hostEnt :PHostEnt;
i,lp,Res :Integer;
LocalIP :array[0..1] of string;
Begin
Result:= '';
LocalIP[0]:= '127.';
LocalIP[1]:= Obetnij(GetLokalneIP);
Form1.Memo1.Clear; //dodane tymczasowo by podejrzeć w Memo
try
if WSAStartup($101, WSAData) <> 0 then Result:= 'WinSock Error'
else
begin
hostEnt:= GetHostByName( PChar(Adres) );
DestAddr:= PInAddr(hostEnt^.h_addr_list^)^;
Res:= 0;
lp:= 0;
TraceHandle:= IcmpCreateFile;
if TraceHandle <> INVALID_HANDLE_VALUE then
begin
while (Res <> DestAddr.S_addr) and (lp < IterationCount) do
begin
Inc(lp);
Res:= TraceOute(lp);
if (Res <> - 1) then
begin
CopyMemory(@buffor[0], @GetDottetIP(Res)[1], Length(buffor));
i:= Low(LocalIP);
Form1.Memo1.Lines.Add(IntToStr(lp) +') '+ buffor); //podgląd w memo
while i <= High(LocalIP) do
begin
Copy(buffor, 1, Length(LocalIP[i]));
if LocalIP[i] = Copy(buffor, 1, Length(LocalIP[i])) then Break;
Inc(i);
end;
if i > High(LocalIP) then lp:= IterationCount;
end else
{wyjście w przypadku gdy "zgubi" jeden adres IP
- ponieważ tym zgubionym może być IP zewnętrzne,
a wtedy będzie nadal pobierał IP z trasy pakietów, oraz podstawi
ostatnie IP z trasy pakietów}
begin
buffor:= 'Błąd pobrania';
Form1.Memo1.Lines.Add(buffor); //podgląd w memo
Break;
end;
end;
IcmpCloseHandle(TraceHandle);
end;
Result:= buffor;
WSACleanup;
end
except
Result:= 'Błąd połączenia !';
end;
End; //ok. Win 98/XP
{*****************************}
END.
Zastosowanie:
procedure TForm1.Button1Click(Sender: TObject);
Begin
Button1.Enabled:= False;
Label1.Caption:= 'IP lokalne: ' + GetLokalneIP;
Label2.Caption:= 'IP zewnętrzne: ' + IPdostawcy('www.google.pl');
beep;
Button1.Enabled:= True;
End;
PS. z kodu modułu można usunąć linię dotyczącą Memo1 - dałem ją dla sprawdzenia
Mimo wszystko problem załatwiony po częśći :-/
Uzyskuje tylko początkowy adres z puli dostawcy, a nie mój zewnętrzny jaki widoczny jest przykładowo w mailach