this slowpoke moves

Domain Name IP Traffic

 Es wird benötigt : 6xButtin, 5xEditBox, 5xLabel, 1xListBox

uses Winsock, ExtCtrls, Math

var
  Form1: TForm1;
  stop_traf: boolean;
  count, trafbitin, trafbitout, trafbitold: integer;

const
  WINSOCK_VERSION=$0101;
  
//

function IPAddrToName(IPAddr: string): string;
var
 SockAddrIn: TSockAddrIn;
 HostEnt: PHostEnt;
 WSAData: TWSAData;
begin
 WSAStartup($101, WSAData);
 SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(IPAddr));
 HostEnt:=GetHostByAddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
 if HostEnt<>nil
 then Result:=StrPas(Hostent^.h_name)
 else Result:='';
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
 Label1.Caption:='Name: '+IPAddrToName(Edit1.Text);
end;

procedure TForm1.Button2Click(Sender: TObject);
var
 OrgVal: string;
 O1,O2,O3,O4: string;
 H1,H2,H3,H4: string;
 HexIP: string;
 XN: array[1..8] of Extended;
 Flt1: Extended;
 Xc: Integer;
begin
 Xn[8]:=IntPower(16,0);Xn[7]:=IntPower(16,1); Xn[6]:=IntPower(16,2);Xn[5]:=IntPower(16,3);
 Xn[4]:=IntPower(16,4);Xn[3]:=IntPower(16,5); Xn[2]:=IntPower(16,6);Xn[1]:=IntPower(16,7);
 OrgVal:=Edit2.Text;
 O1:=Copy(OrgVal,1,Pos('.',OrgVal)-1);Delete(OrgVal,1,Pos('.',OrgVal));
 O2:=Copy(OrgVal,1,Pos('.',OrgVal)-1);Delete(OrgVal,1,Pos('.',OrgVal));
 O3:=Copy(OrgVal,1,Pos('.',OrgVal)-1);Delete(OrgVal,1,Pos('.',OrgVal));
 O4:=OrgVal;
 H1:=IntToHex(StrToInt(O1),2);H2:=IntToHex(StrToInt(O2),2);
 H3:=IntToHex(StrToInt(O3),2);H4:=IntToHex(StrToInt(O4),2);
 HexIP:=H1+H2+H3+H4;
 Flt1:=0;
 for Xc:=1 to 8 do
  begin
    case HexIP[Xc] of
     '0'..'9': Flt1:=Flt1+(StrToInt(HexIP[XC])*Xn[Xc]);
     'A': Flt1:=Flt1+(10*Xn[Xc]);
     'B': Flt1:=Flt1+(11*Xn[Xc]);
     'C': Flt1:=Flt1+(12*Xn[Xc]);
     'D': Flt1:=Flt1+(13*Xn[Xc]);
     'E': Flt1:=Flt1+(14*Xn[Xc]);
     'F': Flt1:=Flt1+(15*Xn[Xc]);
    end;
  end;
 Label4.Caption:='Number: '+FloatToStr(Flt1);
end;

procedure TForm1.Label4DblClick(Sender: TObject);
begin
 Edit2.Text:=Label4.Caption;
end;

procedure TForm1.Label1DblClick(Sender: TObject);
begin
 Edit1.Text:=Label1.Caption;
end;

procedure TForm1.Button3Click(Sender: TObject);
var
 WSAData: TWSAData;
 p: PHostEnt;
begin
 WSAStartup(WINSOCK_VERSION, WSAData);
 p:=GetHostByName(PChar(Edit3.Text));
 Label6.Caption:='IP: '+inet_ntoa(PInAddr(p.h_addr_list^)^);
 WSACleanup;
end;

function LocalIP: string;
type
 TaPInAddr=array [0..10] of PInAddr;
 PaPInAddr=^TaPInAddr;
var
 phe:PHostEnt;
 pptr:PaPInAddr;
 Buffer:array [0..63] of char;
 i:Integer;
 GInitData:TWSADATA;
begin
 WSAStartup($101, GInitData);
 Result:='';
 GetHostName(Buffer, SizeOf(Buffer));
 phe:=GetHostByName(buffer);
 if phe=nil then Exit;
 pptr:=PaPInAddr(Phe^.h_addr_list);
 i:=0;
 while pptr^[i]<>nil do
  begin
   result:=StrPas(inet_ntoa(pptr^[i]^));
   Inc(i);
  end;
 WSACleanup;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
 Label7.Caption:='Local IP: '+LocalIP;
end;

procedure TForm1.Button4Click(Sender: TObject);
var
 wsdata: TWSAData;
 hostName: array [0..255] of char;
 hostEnt: PHostEnt;
 addr: PChar;
begin
 WSAStartup ($0101, wsdata);
  try
   GetHostName(hostName, sizeof (hostName));
   StrPCopy(hostName,Edit4.Text);
   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
        Label9.Caption:=Format('%d.%d.%d.%d',[byte(addr[0]),
        byte(addr[1]),byte(addr[2]),byte(addr[3])]);
       end;
     end;
  finally
   WSACleanup;
  end;
end;

procedure TForm1.Label6DblClick(Sender: TObject);
begin
 Edit3.Text:=Label6.Caption;
end;

procedure TForm1.Label9DblClick(Sender: TObject);
begin
 Edit4.Text:=Label9.Caption;
end;

function IPAddrToCompName(IPAddr: string): string;
var
 SockAddrIn: TSockAddrIn;
 HostEnt: PHostEnt;
 WSAData: TWSAData;
begin
 WSAStartup($101, WSAData);
 SockAddrIn.sin_addr.s_addr:=inet_addr(PChar(IPAddr));
 HostEnt:=gethostbyaddr(@SockAddrIn.sin_addr.S_addr, 4, AF_INET);
 if HostEnt<>nil
 then Result:=StrPas(Hostent^.h_name)
 else Result:='';
end;

procedure TForm1.Button5Click(Sender: TObject);
begin
 Label11.Caption:='Name: '+IPAddrToCompName(Edit5.Text);
end;

procedure TForm1.Label11DblClick(Sender: TObject);
begin
 Edit5.Text:=Label11.Caption;
end;
type
 TMibIfRow = packed record
  wszName          : array[0..255] of WideChar;
  dwIndex          : DWORD;
  dwType           : DWORD;
  dwMtu            : DWORD;
  dwSpeed          : DWORD; 
  dwPhysAddrLen    : DWORD;
  bPhysAddr        : array[0..7] of Byte; 
  dwAdminStatus    : DWORD;
  dwOperStatus     : DWORD;
  dwLastChange     : DWORD;
  dwInOctets       : DWORD; 
  dwInUcastPkts    : DWORD;
  dwInNUCastPkts   : DWORD;
  dwInDiscards     : DWORD;
  dwInErrors       : DWORD;
  dwInUnknownProtos: DWORD;
  dwOutOctets      : DWORD; 
  dwOutUCastPkts   : DWORD;
  dwOutNUCastPkts  : DWORD;
  dwOutDiscards    : DWORD;
  dwOutErrors      : DWORD;
  dwOutQLen        : DWORD;
  dwDescrLen       : DWORD;
  bDescr           : array[0..255] of Char; 
 end;
 TMibIfArray = array [0..512] of TMibIfRow;
 PMibIfRow = ^TMibIfRow;
 PMibIfArray = ^TMibIfArray;
type
 TMibIfTable = packed record
   dwNumEntries: DWORD;
   Table       : TMibIfArray;
 end;
 PMibIfTable = ^TMibIfTable;
var
 GetIfTable:function(pIfTable: PMibIfTable; pdwSize: PULONG;
                              bOrder: Boolean): DWORD; stdcall;
function WSAIoctl(s: TSocket; cmd: DWORD; lpInBuffer: PCHAR; dwInBufferLen:
 DWORD;
 lpOutBuffer: PCHAR; dwOutBufferLen: DWORD;
 lpdwOutBytesReturned: LPDWORD;
 lpOverLapped: POINTER;
 lpOverLappedRoutine: POINTER): integer; stdcall; external 'WS2_32.DLL';
const
 SIO_GET_INTERFACE_LIST = $4004747F;
 IFF_UP = $00000001;
 IFF_BROADCAST = $00000002;
 IFF_LOOPBACK = $00000004;
 IFF_POINTTOPOINT = $00000008;
 IFF_MULTICAST = $00000010;
type
 sockaddr_gen = packed record
  AddressIn: sockaddr_in;
  filler: packed array [0..7] of char;
end;
type
 INTERFACE_INFO = packed record
  iiFlags: u_long; 
  iiAddress: sockaddr_gen; 
  iiBroadcastAddress: sockaddr_gen;
  iiNetmask: sockaddr_gen; 
end;

function EnumInterfaces(var sInt: string): Boolean;
var
 s: TSocket;
 wsaD: WSADATA;
 NumInterfaces: Integer;
 BytesReturned: u_long;
 pAddrInet: SOCKADDR_IN;
 pAddrString: PChar;
 PtrA: pointer;
 Buffer: array[0..20] of INTERFACE_INFO;
 i: integer;
begin
 result:=true;
 sInt:='';
 WSAStartup($0101, wsaD); 
 s:=Socket(AF_INET, SOCK_STREAM, 0); 
 if (s=INVALID_SOCKET)
 then Exit;
 try 
  PtrA:=@bytesReturned;
  if (WSAIoCtl(s, SIO_GET_INTERFACE_LIST, nil, 0, @Buffer,
                          1024, PtrA, nil, nil)<>SOCKET_ERROR)
  then
   begin 
     NumInterfaces:=BytesReturned div SizeOf(INTERFACE_INFO);
     for i:=0 to NumInterfaces-1 do 
      begin
       pAddrInet:=Buffer[i].iiAddress.AddressIn; 
       pAddrString:=inet_ntoa(pAddrInet.sin_addr);
       if pAddrString<>'127.0.0.1'
       then
        begin
         sInt:=sInt+'IP = '+pAddrString+', '+#10#13;
        end
       else sInt:='IP = "localhost"';
      end;
  end;
 except
 end;
 CloseSocket(s);
 WSACleanUp;
 result:=false;
end;

function BytesToString(Value: integer): string;
const
 OneKB=1024;
 OneMB=OneKB*1024;
 OneGB=OneMB*1024;
begin
 if Value<OneKB
 then Result:=FormatFloat('#,##0.00 B',Value)
 else
  if Value<OneMB
  then Result:=FormatFloat('#,##0.00 KB', Value/OneKB)
  else
   if Value<OneGB
   then Result:=FormatFloat('#,##0.00 MB', Value/OneMB)
end;

procedure TForm1.Timer1Timer(Sender: TObject);
type
 TMAC=array [0..7] of Byte;
function GetMAC(Value: TMAC; Length: DWORD): string;
var
 i: integer;
begin
 if Length=0
 then Result:='00-00-00-00-00-00'
 else
  begin
   Result:='';
   for i:=0 to Length-2 do
    Result:=Result+IntToHex(Value[i],2)+'-';
    Result:=Result+IntToHex(Value[Length-1],2);
   end;
end;
var
 FLibHandle: THandle;
 Table: TMibIfTable;
 i, Size: integer;
 s,trafnormin,trafnormout: string;
begin
 Timer1.Enabled:=false; 
 ListBox1.Items.BeginUpdate;
 ListBox1.Items.Clear; 
 FLibHandle:=LoadLibrary('IPHLPAPI.DLL'); 
 if FLibHandle=0
 then Exit;
 @GetIfTable:=GetProcAddress(FLibHandle, 'GetIfTable');
 if not Assigned(GetIfTable)
 then
  begin
   FreeLibrary(FLibHandle);
   Close;
  end;
 Size:=SizeOf(Table);
 if GetIfTable(@Table,@Size,false)=0
 then 
  for i:=0 to Table.dwNumEntries-1 do 
   begin
    with ListBox1.Items do
     begin 
       begin
        Add('Description: '+string(Table.Table[i].bDescr)); 
        Add('MAC-adress: '+string(GetMAC(TMAC(Table.Table[i].bPhysAddr),Table.Table[i].dwPhysAddrLen))); 
        trafbitin:=Table.Table[i].dwInOctets; 
        trafnormin:=BytesToString(trafbitin);
        trafbitout:=Table.Table[i].dwOutOctets;
        trafnormout:=BytesToString(trafbitout);
        if stop_traf=true
        then
         begin
          trafbitold:=trafbitin;
          trafnormin:='0,00 B';
          trafnormout:='0,00 B';
         end;
        if trafbitin>=trafbitold 
        then
         begin
          trafbitin:=trafbitin-trafbitold;
          trafnormin:=BytesToString(trafbitin);
         end
        else  
         begin
          trafbitin:=trafbitold;
          trafnormin:=BytesToString(trafbitin);
         end;
        Add('In (Byte): '+trafnormin); 
        Add('Out (Byte): '+trafnormout); 
        Add('-------------------------------------------------'); 
       end;
     end;
   end;
 EnumInterfaces(s);
 ListBox1.Items.Add(s);
 ListBox1.Items.EndUpdate;
 FreeLibrary(FLibHandle);
 Timer1.Enabled:=true; 
end;

procedure TForm1.Button6Click(Sender: TObject);
begin
 if stop_traf=false then stop_traf:=true
 else stop_traf:=false;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate