Ip program

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, Winsock;

type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    function DetectHostIP: Boolean;
  end;

const
  HostIP: String = \'Unknown\';

var
  Form1: TForm1;

implementation

{$R *.DFM}

procedure TForm1.Button1Click(Sender: TObject);
begin
  DetectHostIP;
end;

//Detect own TCP/IP address
function TForm1.DetectHostIP: Boolean;
var
  wsdata : TWSAData;
  hostName : array [0..255] of char;
  hostEnt : PHostEnt;
  addr : PChar;
begin
  WSAStartup ($0101, wsdata);
  try
    gethostname (hostName, sizeof (hostName));
    hostEnt := gethostbyname (hostName);
    if Assigned (hostEnt) then
      if Assigned (hostEnt^.h_addr_list) then begin
        addr := hostEnt^.h_addr_list^;
        if Assigned (addr) then begin
          HostIP := Format (\'%d.%d.%d.%d\', [byte (addr [0]),
          byte (addr [1]), byte (addr [2]), byte (addr [3])]);
          Result := True;
        end
        else
          Result := False;
      end
      else
        Result := False
    else begin
      MessageDlg(Format (\'Winsock error %d\', [WSAGetLastError]), mtError, [mbOk], 0);
      Result := False;
    end;
  finally
    WSACleanup;
  end
end;

uses Winsock;

function GetIPFromHost
(var HostName, IPaddr, WSAErr: string): Boolean;
type
  Name = array[0..100] of Char;
  PName = ^Name;
var
  HEnt: pHostEnt;
  HName: PName;
  WSAData: TWSAData;
  i: Integer;
begin
  Result := False;   
  if WSAStartup($0101, WSAData) <> 0 then begin
    WSAErr := \'Winsock is not responding.\"\';
    Exit;
  end;
  IPaddr := \'\';
  New(HName);
  if GetHostName(HName^, SizeOf(Name)) = 0 then
  begin
    HostName := StrPas(HName^);
    HEnt := GetHostByName(HName^);
    for i := 0 to HEnt^.h_length - 1 do
    IPaddr :=
      Concat(IPaddr,
      IntToStr(Ord(HEnt^.h_addr_list^[i])) + \'.\');
    SetLength(IPaddr, Length(IPaddr) - 1);
    Result := True;
  end
  else begin
  case WSAGetLastError of
    WSANOTINITIALISED:WSAErr:=\'WSANotInitialised\';
    WSAENETDOWN      :WSAErr:=\'WSAENetDown\';
    WSAEINPROGRESS  :WSAErr:=\'WSAEInProgress\';
  end;
  end;
  Dispose(HName);
  WSACleanup;
end;



procedure TForm1.Button1Click(Sender: TObject);
var
  Host, IP, Err: string;
begin
  if GetIPFromHost(Host, IP, Err) then begin
    Edit1.Text := Host;
    Edit2.Text := IP;
  end
  else
    MessageDlg(Err, mtError, [mbOk], 0);
end;

/ZIRON

kan ikke få det til at virke

jeg har lavet et lille eks. til dig, hent det på:

http://ziron.myip.org/find_ip_og_hostname.zip

/ZIRON