unit Unit1;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, WinSock, ExtCtrls;
type
TForm1 =
class(TForm)
Button2: TButton;
Timer1: TTimer;
CheckBox1: TCheckBox;
procedure Button2Click(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private-Deklarationen }
public
{ Public-Deklarationen }
function DetectHostIP: boolean;
end;
var
Form1: TForm1;
HostIP:String='
Unknown';
implementation
{$R *.dfm}
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;
procedure TForm1.Button2Click(Sender: TObject);
begin
if DetectHostIP=True
then ShowMessage(HostIP);
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
if DetectHostIP=True
then
if HostIP <> '
127.0.0.1'
then
CheckBox1.Checked := True
//CheckBox sagt: Netzwerkkabel steckt
else
CheckBox1.Checked := False;
//oder halt net
end;
end.