Получение ip - внешний

-=Virus=- · #1 11.04.2011, 16:35

Помогите получать ip внешний. Дело в том что я сколько искал так и не мог найти рабочий код. Особенности пишу программу которая проверяет сколько средств на счету, нужна возможность получать внешний ip. С локальным ip нет проблем, но не получается получить внешний.

Assistant · #2 11.04.2011, 21:03

реализация от одного из участника форума, смысл думаю понятен будет:

Код:

procedure TMainForm.Button1Click(Sender: TObject);
var
  site: string;
  n1,n2: integer;
begin
  site:=IdHTTP1.Get('http://www.myip.ru/get_ip.php?loc=');
  n1:=pos('<TD bgcolor=white align=center valign=middle>',site);
  n2:=pos('</TABLE></TD></TR>',site);
  Edit1.text:=copy(site,n1+45,n2-n1-56);
end;

Mr.Frales · #3 13.04.2011, 08:16

Может исходник этой темы тебе поможет
http://www.delphisources.ru/forum/sh...ad.php?t=15932

-=Virus=- · #4 13.04.2011, 15:56

Цитата:

Сообщение от Assistant

реализация от одного из участника форума, смысл думаю понятен будет:
procedure TMainForm.Button1Click(Sender: TObject);

Код:

var
  site: string;
  n1,n2: integer;
begin
  site:=IdHTTP1.Get('http://www.myip.ru/get_ip.php?loc=');
  n1:=pos('<TD bgcolor=white align=center valign=middle>',site);
  n2:=pos('</TABLE></TD></TR>',site);
  Edit1.text:=copy(site,n1+45,n2-n1-56);
end;

Всё бы хорошо, но а если интернет не доступен, надо вывести сетевой ник.

Assistant · #5 13.04.2011, 18:12

что есть "сетевой ник"?

-=Virus=- · #6 13.04.2011, 22:13

Цитата:

Сообщение от Assistant

что есть "сетевой ник"?

Тфу. Отвлекли меня когда писал, сетевой ip

NumLock · #7 14.04.2011, 09:03

1:

Код:

function ip: String;
var
  WSAData: TWSAData;
  name: array [0..$ff] of Char;
  HostEnt: PHostEnt;
begin
  Result:='';
  if WSAStartup(MakeWord(2, 2), WSAData)<>0 then Exit;
  if gethostname(name, Length(name))=0 then
  begin
    HostEnt:=gethostbyname(name);
    if HostEnt<>nil then Result:=inet_ntoa(PInAddr(HostEnt^.h_addr_list^)^);
  end;
  WSACleanup;
end;

2:

Код:

function ips: String;
type
  TArrPInAddr = array [0..7] of PInAddr;
  PArrPInAddr = ^TArrPInAddr;
var
  WSAData: TWSAData;
  name: array [0..$ff] of Char;
  HostEnt: PHostEnt;
  ArrPInAddr: PArrPInAddr;
  i: Integer;
begin
  Result:='';
  if WSAStartup(MakeWord(1, 1), WSAData)<>0 then Exit;
  if gethostname(name, Length(name))=0 then
  begin
    HostEnt:=gethostbyname(name);
    if HostEnt<>nil then
    begin
      ArrPInAddr:=PArrPInAddr(HostEnt^.h_addr_list);
      i:=0;
      while ArrPInAddr^[i]<>nil do
      begin
        Result:=Result+StrPas(inet_ntoa(ArrPInAddr^[i]^))+';';
        Inc(i);
      end;
    end;
  end;
  WSACleanup;
end;

-=Virus=- · #8 14.04.2011, 20:37

Цитата:

Сообщение от NumLock

1:

Код:

function ip: String;
var
  WSAData: TWSAData;
  name: array [0..$ff] of Char;
  HostEnt: PHostEnt;
begin
  Result:='';
  if WSAStartup(MakeWord(2, 2), WSAData)<>0 then Exit;
  if gethostname(name, Length(name))=0 then
  begin
    HostEnt:=gethostbyname(name);
    if HostEnt<>nil then Result:=inet_ntoa(PInAddr(HostEnt^.h_addr_list^)^);
  end;
  WSACleanup;
end;

2:

Код:

function ips: String;
type
  TArrPInAddr = array [0..7] of PInAddr;
  PArrPInAddr = ^TArrPInAddr;
var
  WSAData: TWSAData;
  name: array [0..$ff] of Char;
  HostEnt: PHostEnt;
  ArrPInAddr: PArrPInAddr;
  i: Integer;
begin
  Result:='';
  if WSAStartup(MakeWord(1, 1), WSAData)<>0 then Exit;
  if gethostname(name, Length(name))=0 then
  begin
    HostEnt:=gethostbyname(name);
    if HostEnt<>nil then
    begin
      ArrPInAddr:=PArrPInAddr(HostEnt^.h_addr_list);
      i:=0;
      while ArrPInAddr^[i]<>nil do
      begin
        Result:=Result+StrPas(inet_ntoa(ArrPInAddr^[i]^))+';';
        Inc(i);
      end;
    end;
  end;
  WSACleanup;
end;

Какие модули нужно подключать, что бы компилятор не выдавал ошибки?

Assistant · #9 14.04.2011, 22:24

смотря какие ошибки он выдает

P.S: вообще-то для сокетов нужно Winsock

-=Virus=- · #10 14.04.2011, 22:53

Первый код он определяет ip сетевухи. А второй ip сетевухи и как я понял он dnc ещё определяет. А мне нужно если есть доступ в интернет узнать ip внешний, если подключения к интернету нет то определить адрес сетевухи.

NumLock · #11 15.04.2011, 08:50

-=Virus=-, как получить внешний ip тебе уже выдали. могу лишь подкинуть адрес еще одного xml-сервиса http://www.domaintools.com/research/my-ip/myip.xml

Код:

<?xml version="1.0" encoding="utf-8" ?>
<dnstools>
    <service_provider>DomainTools</service_provider>
    <provider_url>http://www.domaintools.com/</provider_url>
    <date>Fri, 15 Apr 2011 04:54:13 GMT</date>
    <unix_time>1302843253</unix_time>
    <ip_address>92.101.72.142</ip_address>
    <hostname>ip-142-072-101-092.pools.atnet.ru</hostname>
    <blacklist_status>Clear</blacklist_status>
    <remote_port>42037</remote_port>
    <protocol>HTTP/1.1</protocol>
    <connection>TE, keep-alive</connection>
    <keep_alive></keep_alive>
    <country>Russian Federation(RU)</country>
    <country_flag>http://img.domaintools.com/flags/ru.gif</country_flag>
    <city>St. Petersburg</city>
    <region>St. Petersburg City</region>
    <isp>Jsc North-west Telecom Arkhangelsk Branch</isp>
    <proxy>1.1 v1-akamaitech.net(ghost) (AkamaiGHost), 1.1 v1-akamaitech.net(ghost) (AkamaiGHost), 1.1 akamai.net(ghost) (AkamaiGHost)</proxy>
    <proxy_type>Transparent</proxy_type>
    <proxy_ip>192.80.13.52</proxy_ip>
    <proxy_blacklist_status>Clear</proxy_blacklist_status>
    <proxy_country>United States(US)</proxy_country>
    <proxy_country_flag>http://img.domaintools.com/flags/us.gif</proxy_country_flag>
    <proxy_city>Englewood</proxy_city>
    <proxy_region>Colorado</proxy_region>
    <proxy_isp>Ntt America Inc</proxy_isp>
    <user_agent>Opera/9.80 (Windows NT 6.1; U; ru) Presto/2.8.131 Version/11.10</user_agent>
    <language>ru,en;q=0.9,ru-RU;q=0.8</language>
    <accepted_types>text/html, application/xml;q=0.9, application/xhtml+xml, image/png, image/webp, image/jpeg, image/gif, image/x-xbitmap, */*;q=0.1</accepted_types>
    <accepted_encodings>gzip</accepted_encodings>
    <accepted_charsets></accepted_charsets>
    <referer></referer>
</dnstools>

тут хоть через Pos/Copy, хоть через Microsoft.XMLHTTP/IXMLDOMDocument/IXMLDOMElement/IXMLDOMNode.
плюс я написал как можно получить локальные ip. первый способ выдает ip сетевушки, второй ip адреса всех сетевых соединений, разделенных ";".
поэтому:

Цитата:

Сообщение от -=Virus=-

А мне нужно если есть доступ в интернет узнать ip внешний, если подключения к интернету нет то определить адрес сетевухи.

меня вводит в ступор)

программа получения информации о внешнем ip:
http://narod.ru/disk/10203748001/IPinfo.exe.html

StarFox · #12 04.05.2011, 10:43

Простой способ: кидаешь на форму компонент idHTTP, а дальше так:
Edit1:=idHTTP1.Get('http://www.whatismyip.com/automation/n09230945.asp');

~TB~ · #13 04.05.2011, 11:46

1) Получаешь список локальных адресов:
uses IdStack;

Код:

procedure ... (var IPList: TStringList);
begin
  TIdStack.IncUsage;
  try
    GStack.AddLocalAddressesToList(IPList);
  finally
    TIdStack.DecUsage;
  end;
end;

2) Узнаешь внешний IP по способу который посоветовал, товарищь Assistant

3) Если получаемая строка по способу предложенному Assistant'ом непохожа на IP адрес, то одно из 2-х:
а) предложить пользователю выбрать IP из IPList
б) выбрать IP из IPList случайно

Все просто.

NumLock · #14 04.05.2011, 12:05

вот всего 66,5 Кб (с upx 31,5 Кб) exe - никаких VCL и вообще uses отсутствуют

:

Код:

program XMLHttpRequest;

{$APPTYPE CONSOLE}

type
  IXMLHttpRequest = interface(IDispatch)
    ['{ED8C108D-4349-11D2-91A4-00C04F7969E8}']
    procedure open(const bstrMethod: WideString; const bstrUrl: WideString; varAsync: OleVariant;
                   bstrUser: OleVariant; bstrPassword: OleVariant); safecall;
    procedure setRequestHeader(const bstrHeader: WideString; const bstrValue: WideString); safecall;
    function  getResponseHeader(const bstrHeader: WideString): WideString; safecall;
    function  getAllResponseHeaders: WideString; safecall;
    procedure send(varBody: OleVariant); safecall;
    procedure abort; safecall;
    function  Get_status: Integer; safecall;
    function  Get_statusText: WideString; safecall;
    function  Get_responseXML: IDispatch; safecall;
    function  Get_responseText: WideString; safecall;
    function  Get_responseBody: OleVariant; safecall;
    function  Get_responseStream: OleVariant; safecall;
    function  Get_readyState: Integer; safecall;
    procedure Set_onreadystatechange(const Param1: IDispatch); safecall;
    property status: Integer read Get_status;
    property statusText: WideString read Get_statusText;
    property responseXML: IDispatch read Get_responseXML;
    property responseText: WideString read Get_responseText;
    property responseBody: OleVariant read Get_responseBody;
    property responseStream: OleVariant read Get_responseStream;
    property readyState: Integer read Get_readyState;
    property onreadystatechange: IDispatch write Set_onreadystatechange;
  end;

const
  CLASS_XMLHTTPRequest: TGUID = '{ED8C108E-4349-11D2-91A4-00C04F7969E8}';
  CLSCTX_INPROC_SERVER     = 1;
  CLSCTX_LOCAL_SERVER      = 4;

function CoInitialize(pvReserved: Pointer): HResult; stdcall; external 'ole32.dll';
function CoCreateInstance(const clsid: TGUID; unkOuter: IUnknown;
  dwClsContext: Longint; const iid: TGUID; out pv): HResult; stdcall; external 'ole32.dll';
procedure CoUninitialize; stdcall; external 'ole32.dll';

function GetIP: String;
var
  xml: IXMLHttpRequest;
begin
  CoCreateInstance(CLASS_XMLHTTPRequest, nil, CLSCTX_INPROC_SERVER or CLSCTX_LOCAL_SERVER, IUnknown, xml);
  xml.open('GET', 'http://www.whatismyip.com/automation/n09230945.asp', False, '', '');
  xml.send('');
  if xml.status=200 then Result:=xml.responseText else Result:='';
end;

begin
  CoInitialize(nil);
  Writeln(GetIP);
  Readln;
  CoUninitialize;
end.

striker-rbw · #15 20.12.2011, 09:28

Добрый день !

StarFox
Прохожий Регистрация: 18.02.2009
Сообщения: 10
Репутация: 10

Простой способ: кидаешь на форму компонент idHTTP, а дальше так:
Edit1:=idHTTP1.Get('http://www.whatismyip.com/automation/n09230945.asp');
__________________

А как записать полученные значения с ип адресом с сайта в тхт файл ??

За ранние спасибо

Опции темы	Поиск в этой теме
Версия для печати Отправить на Email	Поиск в этой теме: Расширенный поиск
Опции просмотра
Линейный вид Комбинированный вид Древовидный вид

	Сайт	Форум	FAQ	Соглашения	Прочее
	Новости Исходники Компоненты Статьи Добавить исходник Поиск	Правила Поиск Сообщения за сегодня Пользователи Кто на форуме?	Delphi FAQ - 5000 статей DRKB - 4500 статей (ZIP-архив) Справочник функций и процедур Delphi Delphi Programming Guide Indy in Depth. Глубины Indy	Конфиденциальность Соглашение пользователя Правила обработки cookie	О сайте Donate Контакты