DATEADD和DATEDIFF函数、其他日期处理方法 、已打开的端口、FORMAT函数

DATEADD和DATEDIFF函数、其他日期处理方法 、已打开的端口、FORMAT函数

DATEADD和DATEDIFF函数、其他日期处理方法 、已打开的端口、Format函数

 

KeyLife富翁笔记  
作者: microtan
标题: SQL 中日期的处理 
关键字: SQL 中日期的处理 
分类: 个人专区 
密级: 公开 
(评分: , 回复: 0, 阅读: 131) »» 
通常，你需要获得当前日期和计算一些其他的日期，例如，你的程序可能需要判断一个月的第一天或者最后一天。你们大部分人大概都知道怎样把日期进行分割（年、月、日等），然后仅仅用分割出来的年、月、日等放在几个函数中计算出自己所需要的日期！在这篇文章里，我将告诉你如何使用DATEADD和DATEDIFF函数来计算出在你的程序中可能你要用到的一些不同日期。   
      在使用本文中的例子之前，你必须注意以下的问题。大部分可能不是所有例子在不同的机器上执行的结果可能不一样，这完全由哪一天是一个星期的第一天这个设置决定。第一天（DATEFIRST）设定决定了你的系统使用哪一天作为一周的第一天。所有以下的例子都是以星期天作为一周的第一天来建立，也就是第一天设置为7。假如你的第一天设置不一样，你可能需要调整这些例子，使它和不同的第一天设置相符合。你可以通过@@DATEFIRST函数来检查第一天设置。   

      为了理解这些例子，我们先复习一下DATEDIFF和DATEADD函数。DATEDIFF函数计算两个日期之间的小时、天、周、月、年等时间间隔总数。DATEADD函数计算一个日期通过给时间间隔加减来获得一个新的日期。要了解更多的DATEDIFF和DATEADD函数以及时间间隔可以阅读微软联机帮助。   

      使用DATEDIFF和DATEADD函数来计算日期，和本来从当前日期转换到你需要的日期的考虑方法有点不同。你必须从时间间隔这个方面来考虑。比如，从当前日期到你要得到的日期之间有多少时间间隔，或者，从今天到某一天（比如1900-1-1）之间有多少时间间隔，等等。理解怎样着眼于时间间隔有助于你轻松的理解我的不同的日期计算例子。   

一个月的第一天   

      第一个例子，我将告诉你如何从当前日期去这个月的最后一天。请注意：这个例子以及这篇文章中的其他例子都将只使用DATEDIFF和DATEADD函数来计算我们想要的日期。每一个例子都将通过计算但前的时间间隔，然后进行加减来得到想要计算的日期。   

      这是计算一个月第一天的SQL  脚本：   
      SELECT  DATEADD(mm,  DATEDIFF(mm,0,getdate()),  0)   

      我们把这个语句分开来看看它是如何工作的。最核心的函数是getdate()，大部分人都知道这个是返回当前的日期和时间的函数。下一个执行的函数DATEDIFF(mm,0,getdate())是计算当前日期和“1900-01-01  00:00:00.000”这个日期之间的月数。记住：时期和时间变量和毫秒一样是从“1900-01-01  00:00:00.000”开始计算的。这就是为什么你可以在DATEDIFF函数中指定第一个时间表达式为“0”。下一个函数是DATEADD，增加当前日期到“1900-01-01”的月数。通过增加预定义的日期“1900-01-01”和当前日期的月数，我们可以获得这个月的第一天。另外，计算出来的日期的时间部分将会是“00:00:00.000”。   

      这个计算的技巧是先计算当前日期到“1900-01-01”的时间间隔数，然后把它加到“1900-01-01”上来获得特殊的日期，这个技巧可以用来计算很多不同的日期。下一个例子也是用这个技巧从当前日期来产生不同的日期。   

   
本周的星期一   

      这里我是用周(wk)的时间间隔来计算哪一天是本周的星期一。   

      SELECT  DATEADD(wk,  DATEDIFF(wk,0,getdate()),  0)   

一年的第一天   

      现在用年(yy)的时间间隔来显示这一年的第一天。   

      SELECT  DATEADD(yy,  DATEDIFF(yy,0,getdate()),  0)   

季度的第一天   

      假如你要计算这个季度的第一天，这个例子告诉你该如何做。   

      SELECT  DATEADD(qq,  DATEDIFF(qq,0,getdate()),  0)   

当天的半夜   

      曾经需要通过getdate()函数为了返回时间值截掉时间部分，就会考虑到当前日期是不是在半夜。假如这样，这个例子使用DATEDIFF和DATEADD函数来获得半夜的时间点。   

      SELECT  DATEADD(dd,  DATEDIFF(dd,0,getdate()),  0)   

深入DATEDIFF和DATEADD函数计算   

      你可以明白，通过使用简单的DATEDIFF和DATEADD函数计算，你可以发现很多不同的可能有意义的日期。   

      目前为止的所有例子只是仅仅计算当前的时间和“1900-01-01”之间的时间间隔数量，然后把它加到“1900-01-01”的时间间隔上来计算出日期。假定你修改时间间隔的数量，或者使用不同的时间间隔来调用DATEADD函数，或者减去时间间隔而不是增加，那么通过这些小的调整你可以发现和多不同的日期。   

      这里有四个例子使用另外一个DATEADD函数来计算最后一天来分别替换DATEADD函数前后两个时间间隔。   

上个月的最后一天   

      这是一个计算上个月最后一天的例子。它通过从一个月的最后一天这个例子上减去3毫秒来获得。有一点要记住，在Sql  Server中时间是精确到3毫秒。这就是为什么我需要减去3毫秒来获得我要的日期和时间。   

      SELECT  dateadd(ms,-3,DATEADD(mm,  DATEDIFF(mm,0,getdate()),  0))   

      计算出来的日期的时间部分包含了一个Sql  Server可以记录的一天的最后时刻(“23:59:59:997”)的时间。   

去年的最后一天   

      连接上面的例子，为了要得到去年的最后一天，你需要在今年的第一天上减去3毫秒。   

      SELECT  dateadd(ms,-3,DATEADD(yy,  DATEDIFF(yy,0,getdate()),  0))   

本月的最后一天   

      现在，为了获得本月的最后一天，我需要稍微修改一下获得上个月的最后一天的语句。修改需要给用DATEDIFF比较当前日期和“1900-01-01”返回的时间间隔上加1。通过加1个月，我计算出下个月的第一天，然后减去3毫秒，这样就计算出了这个月的最后一天。这是计算本月最后一天的SQL脚本。   

      SELECT  dateadd(ms,-3,DATEADD(mm,  DATEDIFF(m,0,getdate())+1,  0))   

本年的最后一天   

      你现在应该掌握这个的做法，这是计算本年最后一天脚本   

      SELECT  dateadd(ms,-3,DATEADD(yy,  DATEDIFF(yy,0,getdate())+1,  0))。   

本月的第一个星期一   

      好了，现在是最后一个例子。这里我要计算这个月的第一个星期一。这是计算的脚本。   

        select  DATEADD(wk,  DATEDIFF(wk,0,                                                           
                              dateadd(dd,6-datepart(day,getdate()),getdate())         
                                                                                                ),  0)                           

      在这个例子里，我使用了“本周的星期一”的脚本，并作了一点点修改。修改的部分是把原来脚本中“getdate()”部分替换成计算本月的第6天，在计算中用本月的第6天来替换当前日期使得计算可以获得这个月的第一个星期一。   

总结   

      我希望这些例子可以在你用DATEADD和DATEDIFF函数计算日期时给你一点启发。通过使用这个计算日期的时间间隔的数学方法，我发现为了显示两个日期之间间隔的有用历法是有价值的。注意，这只是计算出这些日期的一种方法。要牢记，还有很多方法可以得到相同的计算结果。假如你有其他的方法，那很不错，要是你没有，我希望这些例子可以给你一些启发，当你要用DATEADD和DATEDIFF函数计算你程序可能要用到的日期时。   

---------------------------------------------------------------   
附录，其他日期处理方法   

1)去掉时分秒   
declare  @  datetime   
set  @  =  getdate()  --'2003-7-1  10:00:00'   
SELECT  @,DATEADD(day,  DATEDIFF(day,0,@),  0)   

2）显示星期几   
select  datename(weekday,getdate())     

3）如何取得某个月的天数   
declare  @m  int   
set  @m=2  --月份   
select    datediff(day,'2003-'+cast(@m  as  varchar)+'-15'  ,'2003-'+cast(@m+1    as  varchar)+'-15')   
另外，取得本月天数   
select    datediff(day,cast(month(GetDate())  as  varchar)+'-'+cast(month(GetDate())  as  varchar)+'-15'  ,cast(month(GetDate())  as  varchar)+'-'+cast(month(GetDate())+1    as  varchar)+'-15')   
或者使用计算本月的最后一天的脚本，然后用DAY函数区最后一天   
SELECT  Day(dateadd(ms,-3,DATEADD(mm,  DATEDIFF(m,0,getdate())+1,  0)))   

4）判断是否闰年：   
SELECT  case  day(dateadd(mm,  2,  dateadd(ms,-3,DATEADD(yy,  DATEDIFF(yy,0,getdate()),  0))))  when  28  then  '平年'  else  '闰年'  end   
或者   
select  case  datediff(day,datename(year,getdate())+'-02-01',dateadd(mm,1,datename(year,getdate())+'-02-01'))   
when  28  then  '平年'  else  '闰年'  end   

5）一个季度多少天   
declare  @m  tinyint,@time  smalldatetime   
select  @m=month(getdate())   
select  @m=case  when  @m  between  1  and  3  then  1   
                      when  @m  between  4  and  6  then  4   
                      when  @m  between  7  and  9  then  7   
                      else  10  end   
select  @time=datename(year,getdate())+'-'+convert(varchar(10),@m)+'-01'   
select  datediff(day,@time,dateadd(mm,3,@time)) 
    



2005-6-15 17:08:00    
 发表评语»»»     

 2005-7-9 13:18:58    IP助手函数，可以检查出所以已经打开的端口 unit IPHelper;

(*
  ==========================
  Delphi IPHelper functions
  ==========================
  Requires : NT4/SP4 or higher, WIN98/WIN98se
  Developed on: D4.03
  Tested on   :  WIN-NT4/SP6, WIN98se, WIN95/OSR1

  ================================================================
                    This software is FREEWARE
                    -------------------------
  If this software works, it was surely written by Dirk Claessens
                   <dirk.claessens16@yucom.be>
               <dirk.claessens.dc@belgium.agfa.com>
  (If it doesn't, I don't know anything about it.)
  ================================================================

  Version: 1.3 2000-12-8

*)

interface

uses
  Windows, Messages, SysUtils, Classes, Dialogs, IpHlpApi;

const
  NULL_IP       = '  0.  0.  0.  0';

//------conversion of well-known port numbers to service names----------------

type
  TWellKnownPort = record
    Prt: DWORD;
    Srv: string[20];
  end;

  PTTcpConnStatus = ^TTcpConnStatus;
  TTcpConnStatus = record
    LocalIP      : string;
    LocalPort    : string;
    RemoteIP     : string;
    RemotePort   : string;
    Status       : string;
  end;


const
    // only most "popular" services...
  WellKnownPorts: array[1..29] of TWellKnownPort
  = (
    ( Prt: 0; Srv: 'LOOPBACK'),
    ( Prt: 7; Srv: 'ECHO' ),    {Ping    }
    ( Prt: 9; Srv: 'DISCRD' ),    { Discard}
    ( Prt: 13; Srv: 'DAYTIM' ),   {DayTime}
    ( Prt: 17; Srv: 'QOTD' ),     {Quote Of The Day}
    ( Prt: 19; Srv: 'CHARGEN' ),  {CharGen}
    ( Prt: 20; Srv: 'FTP ' ),
    ( Prt: 21; Srv: 'FTPC' ),     { File Transfer Control Protocol}
    ( Prt: 23; Srv: 'TELNET' ),   {TelNet}
    ( Prt: 25; Srv: 'SMTP' ),     { Simple Mail Transfer Protocol}
    ( Prt: 37; Srv: 'TIME' ),
    ( Prt: 43; Srv: 'WHOIS'),     { WHO IS service  }
    ( Prt: 53; Srv: 'DNS ' ),     { Domain Name Service }
    ( Prt: 67; Srv: 'BOOTPS' ),   { BOOTP Server }
    ( Prt: 68; Srv: 'BOOTPC' ),   { BOOTP Client }
    ( Prt: 69; Srv: 'TFTP' ),     { Trivial FTP  }
    ( Prt: 70; Srv: 'GOPHER' ),   { Gopher       }
    ( Prt: 79; Srv: 'FING' ),     { Finger       }
    ( Prt: 80; Srv: 'HTTP' ),     { HTTP         }
    ( Prt: 88; Srv: 'KERB' ),     { Kerberos     }
    ( Prt: 109; Srv: 'POP2' ),    { Post Office Protocol Version 2 }
    ( Prt: 110; Srv: 'POP3' ),    { Post Office Protocol Version 3 }
    ( Prt: 119; Srv: 'NNTP' ),    { Network News Transfer Protocol }
    ( Prt: 123; Srv: 'NTP ' ),    { Network Time protocol          }
    ( Prt: 135; Srv: 'LOCSVC'),   { Location Service              }
    ( Prt: 137; Srv: 'NBNAME' ),  { NETBIOS Name service          }
    ( Prt: 138; Srv: 'NBDGRAM' ), { NETBIOS Datagram Service     }
    ( Prt: 139; Srv: 'NBSESS' ),  { NETBIOS Session Service        }
    ( Prt: 161; Srv: 'SNMP' )     { Simple Netw. Management Protocol }
    );


//-----------conversion of ICMP error codes to strings--------------------------
             {taken from www.sockets.com/ms_icmp.c }

const
  ICMP_ERROR_BASE = 11000;
  IcmpErr : array[1..22] of string =
  (
   'IP_BUFFER_TOO_SMALL','IP_DEST_NET_UNREACHABLE', 'IP_DEST_HOST_UNREACHABLE',
   'IP_PROTOCOL_UNREACHABLE', 'IP_DEST_PORT_UNREACHABLE', 'IP_NO_RESOURCES',
   'IP_BAD_OPTION','IP_HARDWARE_ERROR', 'IP_PACKET_TOO_BIG', 'IP_REQUEST_TIMED_OUT',
   'IP_BAD_REQUEST','IP_BAD_ROUTE', 'IP_TTL_EXPIRED_TRANSIT',
   'IP_TTL_EXPIRED_REASSEM','IP_PARAMETER_PROBLEM', 'IP_SOURCE_QUENCH',
   'IP_OPTION_TOO_BIG', 'IP_BAD_DESTINATION','IP_ADDRESS_DELETED',
   'IP_SPEC_MTU_CHANGE', 'IP_MTU_CHANGE', 'IP_UNLOAD'
  );


//----------conversion of diverse enumerated values to strings------------------

  ARPEntryType  : array[1..4] of string = ( 'Other', 'Invalid',
    'Dynamic', 'Static'
    );
  TCPConnState  :
    array[1..12] of string =
    ( 'closed', 'listening', 'syn_sent',
    'syn_rcvd', 'established', 'fin_wait1',
    'fin_wait2', 'close_wait', 'closing',
    'last_ack', 'time_wait', 'delete_tcb'
    );

  TCPToAlgo     : array[1..4] of string =
    ( 'Const.Timeout', 'MIL-STD-1778',
    'Van Jacobson', 'Other' );

  IPForwTypes   : array[1..4] of string =
    ( 'other', 'invalid', 'local', 'remote' );

  IPForwProtos  : array[1..18] of string =
    ( 'OTHER', 'LOCAL', 'NETMGMT', 'ICMP', 'EGP',
    'GGP', 'HELO', 'RIP', 'IS_IS', 'ES_IS',
    'CISCO', 'BBN', 'OSPF', 'BGP', 'BOOTP',
    'AUTO_STAT', 'STATIC', 'NOT_DOD' );


//---------------exported stuff-----------------------------------------------

procedure Get_AdaptersInfo( List: TStrings );
procedure Get_NetworkParams( List: TStrings );
procedure Get_ARPTable( List: TStrings );
procedure Get_TCPTable( List: TStrings );
procedure Get_TCPStatistics( List: TStrings );
procedure Get_UDPTable( List: TStrings );
procedure Get_UDPStatistics( List: TStrings );
procedure Get_IPAddrTable( List: TStrings );
procedure Get_IPForwardTable( List: TStrings );
procedure Get_IPStatistics( List: TStrings );
function Get_RTTAndHopCount( IPAddr: DWORD; MaxHops: Longint;
  var RTT: longint; var HopCount: longint ): integer;
procedure Get_ICMPStats( ICMPIn, ICMPOut: TStrings );
procedure Get_IfTable( List: TStrings );
procedure Get_RecentDestIPs( List: TStrings );

// added functions
procedure Get_OpenConnections( List: TList );



// conversion utils
function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
function IpAddr2Str( IPAddr: DWORD ): string;
function Str2IpAddr( IPStr: string ): DWORD;
function Port2Str( nwoPort: DWORD ): string;
function Port2Wrd( nwoPort: DWORD ): DWORD;
function Port2Svc( Port: DWORD ): string;
function ICMPErr2Str( ICMPErrCode: DWORD) : string;

implementation

var
  RecentIPs     : TStringList;

//--------------General utilities-----------------------------------------------

{ extracts next "token" from string, then eats string }
function NextToken( var s: string; Separator: char ): string;
var
  Sep_Pos       : byte;
begin
  Result := '';
  if length( s ) > 0 then begin
    Sep_Pos := pos( Separator, s );
    if Sep_Pos > 0 then begin
      Result := copy( s, 1, Pred( Sep_Pos ) );
      Delete( s, 1, Sep_Pos );
    end
    else begin
      Result := s;
      s := '';
    end;
  end;
end;

//------------------------------------------------------------------------------
{ concerts numerical MAC-address to ww-xx-yy-zz string }
function MacAddr2Str( MacAddr: TMacAddress; size: integer ): string;
var
  i             : integer;
begin
  if Size = 0 then
  begin
    Result := '00-00-00-00-00-00';
    EXIT;
  end
  else Result := '';
  //
  for i := 1 to Size do
    Result := Result + IntToHex( MacAddr[i], 2 ) + '-';
  Delete( Result, Length( Result ), 1 );
end;

//------------------------------------------------------------------------------
{ converts IP-address in network byte order DWORD to dotted decimal string}
function IpAddr2Str( IPAddr: DWORD ): string;
var
  i             : integer;
begin
  Result := '';
  for i := 1 to 4 do
  begin
    Result := Result + Format( '%3d.', [IPAddr and $FF] );
    IPAddr := IPAddr shr 8;
  end;
  Delete( Result, Length( Result ), 1 );
end;

//------------------------------------------------------------------------------
{ converts dotted decimal IP-address to network byte order DWORD}
function Str2IpAddr( IPStr: string ): DWORD;
var
  i             : integer;
  Num           : DWORD;
begin
  Result := 0;
  for i := 1 to 4 do
  try
    Num := ( StrToInt( NextToken( IPStr, '.' ) ) ) shl 24;
    Result := ( Result shr 8 ) or Num;
  except
    Result := 0;
  end;

end;

//------------------------------------------------------------------------------
{ converts port number in network byte order to DWORD }
function Port2Wrd( nwoPort: DWORD ): DWORD;
begin
  Result := Swap( WORD( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts port number in network byte order to string }
function Port2Str( nwoPort: DWORD ): string;
begin
  Result := IntToStr( Port2Wrd( nwoPort ) );
end;

//------------------------------------------------------------------------------
{ converts well-known port numbers to service ID }
function Port2Svc( Port: DWORD ): string;
var
  i             : integer;
begin
  Result := Format( '%4d', [Port] ); // in case port not found
  for i := Low( WellKnownPorts ) to High( WellKnownPorts ) do
    if Port = WellKnownPorts[i].Prt then
    begin
      Result := WellKnownPorts[i].Srv;
      BREAK;
    end;
end;

//-----------------------------------------------------------------------------
{ general,  fixed network parameters }
procedure Get_NetworkParams( List: TStrings );
var
  InfoSize      : Longint;
  ErrorCode     : DWORD;
  pBuf          : PChar;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  InfoSize := 0;
  ErrorCode := GetNetworkParams( PTFixedInfo(pBuf), @InfoSize );
  GetMem( pBuf, InfoSize );
  ErrorCode := GetNetworkParams( PTFixedInfo(pBuf), @InfoSize );
  if ErrorCode = ERROR_SUCCESS then
    with PTFixedinfo(pBuf)^ do
    begin
      List.Add( 'HOSTNAME          : ' + string( HostName ) );
      List.Add( 'DOMAIN            : ' + string( DomainName ) );
      List.Add( 'SCOPE             : ' + string( ScopeID ) );
      List.Add( 'NETBIOS NODE TYPE : ' + NETBIOSTypes[NodeType] );
      List.Add( 'ROUTING ENABLED   :' + IntToStr( EnableRouting ) );
      List.Add( 'PROXY   ENABLED   :' + IntToStr( EnableProxy ) );
      List.Add( 'DNS     ENABLED   :' + IntToHex( EnableDNS,8 ) );
    end
  else
    List.Add( SysErrorMessage( ErrorCode ) );
  FreeMem(pBuf);
end;

//------------------------------------------------------------------------------
function ICMPErr2Str( ICMPErrCode: DWORD) : string;
var
 i : integer;
begin
   Result := 'UnknownError : ' + IntToStr( ICMPErrCode );
   dec( ICMPErrCode, ICMP_ERROR_BASE );
   if ICMPErrCode in [Low(ICMpErr)..High(ICMPErr)] then
     Result := ICMPErr[ ICMPErrCode];
end;




//------------------------------------------------------------------------------
procedure Get_IfTable( List: TStrings );
var
  IfRow         : TMibIfRow;
  i,
    Error,
    TableSize   : integer;
  pBuf          : PChar;
  NumEntries    : DWORD;
  sDescr,
    Temp        : string;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  TableSize := 0;
   // first call: get memsize needed
  Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
  if Error <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;
  GetMem( pBuf, TableSize );

   // get table pointer
  Error := GetIfTable( PTMibIfTable( pBuf ), @TableSize, false );
  if Error = NO_ERROR then
  begin
    NumEntries := PTMibIfTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( NumEntries ) );
      for i := 1 to NumEntries do
      begin
        IfRow := PTMibIfRow( pBuf )^;
        with IfRow do
        begin
          SetLength( sDescr, dwDescrLen );
          move( bDescr, sDescr[1], Length( sDescr ) );
          sDescr := trim( sDescr );
          List.Add( Format( '%0.8x| %3d| %16s| %8d| %12d| %2d| %2d| %-s',
            [dwIndex, dwType,
            MacAddr2Str( TMacAddress( bPhysAddr ), dwPhysAddrLen )
              , dwMTU, dwSpeed, dwAdminStatus,
              dwOPerStatus, sDescr] )
              );
        end;
        inc( pBuf, SizeOf( IfRow ) );
      end;
    end
    else
      List.Add( 'no entries.' );
  end
  else
    List.Add( SysErrorMessage( GetLastError ) );
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IfRow ) );
  FreeMem( pBuf );
end;



//-----------------------------------------------------------------------------
{ Info on installed adapters }
procedure Get_AdaptersInfo( List: TStrings );
var
  Error,
    BufLen      : DWORD;
  AdapterInfo   : PTIP_ADAPTER_INFO;
  Descr,
    LocalIP,
    GatewayIP,
    DHCPIP      : string;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  BufLen := SizeOf( AdapterInfo^ );
  New( AdapterInfo );
  Error := GetAdaptersInfo( AdapterInfo, @BufLen );
  if Error = NO_ERROR then
  begin
    while ( AdapterInfo <> nil ) do
      with AdapterInfo^ do
      begin
        SetLength( Descr, SizeOf( Description ) );
        Descr := Trim( string( Description ) );
        //
        LocalIP := NULL_IP;
        if IPAddressList.IpAddress[1] <> #0 then
          LocalIP := IPAddressList.IpAddress
        else
          LocalIP := NULL_IP;
        //
        if GateWayList.IPAddress[1] <> #0 then
          GateWayIP := GatewayList.IPAddress
        else
          GateWayIP := NULL_IP;
        //
        if DHCPServer.IPAddress[1] <> #0 then
          DHCPIP := DHCPServer.IPAddress
        else
          DHCPIP := NULL_IP;

        List.Add( Descr );
        List.Add( Format(
          '%8.8x|%6s|%16s|%2d|%16s|%16s|%16s',
          [Index, AdaptTypes[aType],
          MacAddr2Str( TMacAddress( Address ), AddressLength ),
            DHCPEnabled, LocalIP, GatewayIP, DHCPIP] )
            );
        List.Add( '  ' );
        AdapterInfo := Next;
      end
  end
  else
    List.Add( SysErrorMessage( Error ) );
  Dispose( AdapterInfo );
end;

//-----------------------------------------------------------------------------
{ get round trip time and hopcount to indicated IP }
function Get_RTTAndHopCount( IPAddr: DWORD; MaxHops: Longint; var RTT: Longint;
  var HopCount: Longint ): integer;
begin
  if not GetRTTAndHopCount( IPAddr, @HopCount, MaxHops, @RTT ) then
  begin
    Result := GetLastError;
    RTT := -1; // Destination unreachable, BAD_HOST_NAME,etc...
    HopCount := -1;
  end
  else
    Result := NO_ERROR;
end;

//-----------------------------------------------------------------------------
{ ARP-table lists relations between remote IP and remote MAC-address.
 NOTE: these are cached entries ;when there is no more network traffic to a
 node, entry is deleted after a few minutes.
}
procedure Get_ARPTable( List: TStrings );
var
  IPNetRow      : TMibIPNetRow;
  TableSize     : DWORD;
  NumEntries    : DWORD;
  ErrorCode     : DWORD;
  i             : integer;
  pBuf          : PChar;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  // first call: get table length
  TableSize := 0;
  ErrorCode := GetIPNetTable( PTMIBIpNetTable( pBuf ), @TableSize, false );
  //
  if ErrorCode = ERROR_NO_DATA then
  begin
    List.Add( ' ARP-cache empty.' );
    EXIT;
  end;
  // get table
  GetMem( pBuf, TableSize );
  ErrorCode := GetIpNetTable( PTMIBIPNetTable( pBuf ), @TableSize, false );
  if ErrorCode = NO_ERROR then
  begin
    NumEntries := PTMIBIPNetTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then // paranoia striking, but you never know...
    begin
      inc( pBuf, SizeOf( DWORD ) ); // get past table size
      for i := 1 to NumEntries do
      begin
        IPNetRow := PTMIBIPNetRow( PBuf )^;
        with IPNetRow do
          List.Add( Format( '%8x | %12s | %16s| %10s',
                           [dwIndex, MacAddr2Str( bPhysAddr, dwPhysAddrLen ),
                           IPAddr2Str( dwAddr ), ARPEntryType[dwType]
                           ]));
        inc( pBuf, SizeOf( IPNetRow ) );
      end;
    end
    else
      List.Add( ' ARP-cache empty.' );
  end
  else
    List.Add( SysErrorMessage( ErrorCode ) );

  // we _must_ restore pointer!
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPNetRow ) );
  FreeMem( pBuf );

end;


//------------------------------------------------------------------------------
procedure Get_TCPTable( List: TStrings );
var
  TCPRow        : TMIBTCPRow;
  i,
    NumEntries  : integer;
  TableSize     : DWORD;
  ErrorCode     : DWORD;
  DestIP        : string;
  pBuf          : PChar;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  RecentIPs.Clear;
  // first call : get size of table
  TableSize := 0;
  ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
  if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;

  // get required size of memory, call again
  GetMem( pBuf, TableSize );
  // get table
  ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
  if ErrorCode = NO_ERROR then
  begin

    NumEntries := PTMIBTCPTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( DWORD ) ); // get past table size
      for i := 1 to NumEntries do
      begin
        TCPRow := PTMIBTCPRow( pBuf )^; // get next record
        with TCPRow do
        begin
          if dwRemoteAddr = 0 then
            dwRemotePort := 0;
          DestIP := IPAddr2Str( dwRemoteAddr );
          List.Add(
            Format( '%15s : %-7s|%15s : %-7s| %-16s',
            [IpAddr2Str( dwLocalAddr ),
            Port2Svc( Port2Wrd( dwLocalPort ) ),
              DestIP,
              Port2Svc( Port2Wrd( dwRemotePort ) ),
              TCPConnState[dwState]
              ] ) );
         //
            if (not ( dwRemoteAddr = 0 ))
            and ( RecentIps.IndexOf(DestIP) = -1 ) then
               RecentIPs.Add( DestIP );
        end;
        inc( pBuf, SizeOf( TMIBTCPRow ) );
      end;
    end;
  end
  else
    List.Add( SyserrorMessage( ErrorCode ) );
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibTCPRow ) );
  FreeMem( pBuf );
end;


//------------------------------------------------------------------------------
procedure Get_OpenConnections( List: TList );
var
    TCPRow        : TMIBTCPRow;
    i,NumEntries  : integer;
    TableSize     : DWORD;
    ErrorCode     : DWORD;
    DestIP        : string;
    pBuf          : PChar;
    CStat         : PTTcpConnStatus;
begin
    if not Assigned( List ) then EXIT;
    List.Clear;
    //首先取得TCP连接的列表的大小
    TableSize := 0;
    ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
    if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
        EXIT;

    //分配内存
    GetMem( pBuf, TableSize );
    //取得TCP连接的列表
    ErrorCode := GetTCPTable( PTMIBTCPTable( pBuf ), @TableSize, true );
    if ErrorCode = NO_ERROR then
    begin
    NumEntries := PTMIBTCPTable( pBuf )^.dwNumEntries;
        if NumEntries > 0 then
        begin
            inc( pBuf, SizeOf( DWORD ) );
            for i := 1 to NumEntries do
            begin
            TCPRow := PTMIBTCPRow( pBuf )^;//下一个记录
                with TCPRow do
                if dwState in [2,5] then//只取两种状态的连接
                begin
                    New( CStat );
                    CStat^.LocalIP   := IPAddr2Str( dwLocalAddr );
                    CStat^.LocalPort := Port2Svc( Port2Wrd( dwLocalPort ));
                    if dwRemoteAddr <> 0 then
                    begin
                        CStat^.RemoteIP := IPAddr2Str( dwRemoteAddr );
                        CStat^.RemotePort :=
                            Port2Svc( Port2Wrd( dwRemotePort ));
                    end
                    else
                    begin
                        CStat^.RemoteIP   := '...';
                        CStat^.RemotePort := '...';
                    end;
                    CStat^.Status := TCPConnState[dwState];
                    List.Add( CStat );
                end;
                inc( pBuf, SizeOf( TMIBTCPRow ) );
            end;
        end;
    end;
    dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibTCPRow ) );
    FreeMem( pBuf );
end;



//------------------------------------------------------------------------------
procedure Get_TCPStatistics( List: TStrings );
var
  TCPStats      : TMibTCPStats;
  ErrorCode     : DWORD;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  ErrorCode := GetTCPStatistics( @TCPStats );
  if ErrorCode = NO_ERROR then
    with TCPStats do
    begin
      List.Add( 'Retransmission algorithm :' + TCPToAlgo[dwRTOAlgorithm] );
      List.Add( 'Minimum Time-Out         :' + IntToStr( dwRTOMin ) + ' ms' );
      List.Add( 'Maximum Time-Out         :' + IntToStr( dwRTOMax ) + ' ms' );
      List.Add( 'Maximum Pend.Connections :' + IntToStr( dwRTOAlgorithm ) );
      List.Add( 'Active Opens             :' + IntToStr( dwActiveOpens ) );
      List.Add( 'Passive Opens            :' + IntToStr( dwPassiveOpens ) );
      List.Add( 'Failed Open Attempts     :' + IntToStr( dwAttemptFails ) );
      List.Add( 'Established conn. Reset  :' + IntToStr( dwEstabResets ) );
      List.Add( 'Current Established Conn.:' + IntToStr( dwCurrEstab ) );
      List.Add( 'Segments Received        :' + IntToStr( dwInSegs ) );
      List.Add( 'Segments Sent            :' + IntToStr( dwOutSegs ) );
      List.Add( 'Segments Retransmitted   :' + IntToStr( dwReTransSegs ) );
      List.Add( 'Incoming Errors          :' + IntToStr( dwInErrs ) );
      List.Add( 'Outgoing Resets          :' + IntToStr( dwOutRsts ) );
      List.Add( 'Cumulative Connections   :' + IntToStr( dwNumConns ) );
    end
  else
    List.Add( SyserrorMessage( ErrorCode ) );

end;

//------------------------------------------------------------------------------
procedure Get_UDPTable( List: TStrings );
var
  UDPRow        : TMIBUDPRow;
  i,
    NumEntries  : integer;
  TableSize     : DWORD;
  ErrorCode     : DWORD;
  pBuf          : PChar;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;

  // first call : get size of table
  TableSize := 0;
  ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, true );
  if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;

  // get required size of memory, call again
  GetMem( pBuf, TableSize );

  // get table
  ErrorCode := GetUDPTable( PTMIBUDPTable( pBuf ), @TableSize, true );
  if ErrorCode = NO_ERROR then
  begin
    NumEntries := PTMIBUDPTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( DWORD ) ); // get past table size
      for i := 1 to NumEntries do
      begin
        UDPRow := PTMIBUDPRow( pBuf )^; // get next record
        with UDPRow do
          List.Add( Format( '%15s : %-6s',
            [IpAddr2Str( dwLocalAddr ),
            Port2Svc( Port2Wrd( dwLocalPort ) )
              ] ) );
        inc( pBuf, SizeOf( TMIBUDPRow ) );
      end;
    end
    else
      List.Add( 'no entries.' );
  end
  else
    List.Add( SyserrorMessage( ErrorCode ) );
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibUDPRow ) );
  FreeMem( pBuf );
end;

//------------------------------------------------------------------------------
procedure Get_IPAddrTable( List: TStrings );
var
  IPAddrRow     : TMibIPAddrRow;
  TableSize     : DWORD;
  ErrorCode     : DWORD;
  i             : integer;
  pBuf          : PChar;
  NumEntries    : DWORD;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  TableSize := 0; ;
  // first call: get table length
  ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
  if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;

  GetMem( pBuf, TableSize );
  // get table
  ErrorCode := GetIpAddrTable( PTMibIPAddrTable( pBuf ), @TableSize, true );
  if ErrorCode = NO_ERROR then
  begin
    NumEntries := PTMibIPAddrTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( DWORD ) );
      for i := 1 to NumEntries do
      begin
        IPAddrRow := PTMIBIPAddrRow( pBuf )^;
        with IPAddrRow do
          List.Add( Format( '%8.8x|%15s|%15s|%15s|%8.8d',
            [dwIndex,
            IPAddr2Str( dwAddr ),
              IPAddr2Str( dwMask ),
              IPAddr2Str( dwBCastAddr ),
              dwReasmSize
              ] ) );
        inc( pBuf, SizeOf( TMIBIPAddrRow ) );
      end;
    end
    else
      List.Add( 'no entries.' );
  end
  else
    List.Add( SysErrorMessage( ErrorCode ) );

  // we must restore pointer!
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( IPAddrRow ) );
  FreeMem( pBuf );
end;


//-----------------------------------------------------------------------------
{ gets entries in routing table; equivalent to "Route Print" }
procedure Get_IPForwardTable( List: TStrings );
var
  IPForwRow     : TMibIPForwardRow;
  TableSize     : DWORD;
  ErrorCode     : DWORD;
  i             : integer;
  pBuf          : PChar;
  NumEntries    : DWORD;
begin
  if not Assigned( List ) then EXIT;
  List.Clear;
  TableSize := 0;

  // first call: get table length
  ErrorCode := GetIpForwardTable( PTMibIPForwardTable( pBuf ), @TableSize, true
    );
  if Errorcode <> ERROR_INSUFFICIENT_BUFFER then
    EXIT;

  // get table
  GetMem( pBuf, TableSize );
  ErrorCode := GetIpForwardTable( PTMibIPForwardTable( pBuf ), @TableSize, true
    );
  if ErrorCode = NO_ERROR then
  begin
    NumEntries := PTMibIPForwardTable( pBuf )^.dwNumEntries;
    if NumEntries > 0 then
    begin
      inc( pBuf, SizeOf( DWORD ) );
      for i := 1 to NumEntries do
      begin
        IPForwRow := PTMibIPForwardRow( pBuf )^;
        with IPForwRow do
          List.Add( Format(
            '%15s|%15s|%15s|%8.8x|%7s|   %5.5d|    %7s|        %2.2d',
            [IPAddr2Str( dwForwardDest ),
            IPAddr2Str( dwForwardMask ),
              IPAddr2Str( dwForwardNextHop ),
              dwForwardIFIndex,
              IPForwTypes[dwForwardType],
              dwForwardNextHopAS,
              IPForwProtos[dwForwardProto],
              dwForwardMetric1
              ] ) );
        inc( pBuf, SizeOf( TMibIPForwardRow ) );
      end;
    end
    else
      List.Add( 'no entries.' );
  end
  else
    List.Add( SysErrorMessage( ErrorCode ) );
  dec( pBuf, SizeOf( DWORD ) + NumEntries * SizeOf( TMibIPForwardRow ) );
  FreeMem( pBuf );
end;

//------------------------------------------------------------------------------
procedure Get_IPStatistics( List: TStrings );
var
  IPStats       : TMibIPStats;
  ErrorCode     : integer;
begin
  if not Assigned( List ) then EXIT;
  ErrorCode := GetIPStatistics( @IPStats );
  if ErrorCode = NO_ERROR then
  begin
    List.Clear;
    with IPStats do
    begin
      if dwForwarding = 1 then
        List.add( 'Forwarding Enabled      : ' + 'Yes' )
      else
        List.add( 'Forwarding Enabled      : ' + 'No' );
      List.add( 'Default TTL             : ' + inttostr( dwDefaultTTL ) );
      List.add( 'Datagrams Received      : ' + inttostr( dwInReceives ) );
      List.add( 'Header Errors     (In)  : ' + inttostr( dwInHdrErrors ) );
      List.add( 'Address Errors    (In)  : ' + inttostr( dwInAddrErrors ) );
      List.add( 'Unknown Protocols (In)  : ' + inttostr( dwInUnknownProtos ) );
      List.add( 'Datagrams Discarded     : ' + inttostr( dwInDiscards ) );
      List.add( 'Datagrams Delivered     : ' + inttostr( dwInDelivers ) );
      List.add( 'Requests Out            : ' + inttostr( dwOutRequests ) );
      List.add( 'Routings Discarded      : ' + inttostr( dwRoutingDiscards ) );
      List.add( 'No Routes          (Out): ' + inttostr( dwOutNoRoutes ) );
      List.add( 'Reassemble TimeOuts     : ' + inttostr( dwReasmTimeOut ) );
      List.add( 'Reassemble Requests     : ' + inttostr( dwReasmReqds ) );
      List.add( 'Succesfull Reassemblies : ' + inttostr( dwReasmOKs ) );
      List.add( 'Failed Reassemblies     : ' + inttostr( dwReasmFails ) );
      List.add( 'Succesful Fragmentations: ' + inttostr( dwFragOKs ) );
      List.add( 'Failed Fragmentations   : ' + inttostr( dwFragFails ) );
      List.add( 'Datagrams Fragmented    : ' + inttostr( dwFRagCreates ) );
      List.add( 'Number of Interfaces    : ' + inttostr( dwNumIf ) );
      List.add( 'Number of IP-addresses  : ' + inttostr( dwNumAddr ) );
      List.add( 'Routes in RoutingTable  : ' + inttostr( dwNumRoutes ) );
    end;
  end
  else
    List.Add( SysErrorMessage( ErrorCode ) );
end;

//------------------------------------------------------------------------------
procedure Get_UdpStatistics( List: TStrings );
var
  UdpStats      : TMibUDPStats;
  ErrorCode     : integer;
begin
  if not Assigned( List ) then EXIT;
  ErrorCode := GetUDPStatistics( @UdpStats );
  if ErrorCode = NO_ERROR then
  begin
    List.Clear;
    with UDPStats do
    begin
      List.add( 'Datagrams (In)    : ' + inttostr( dwInDatagrams ) );
      List.add( 'Datagrams (Out)   : ' + inttostr( dwOutDatagrams ) );
      List.add( 'No Ports          : ' + inttostr( dwNoPorts ) );
      List.add( 'Errors    (In)    : ' + inttostr( dwInErrors ) );
      List.add( 'UDP Listen Ports  : ' + inttostr( dwNumAddrs ) );
    end;
  end
  else
    List.Add( SysErrorMessage( ErrorCode ) );
end;

//------------------------------------------------------------------------------
procedure Get_ICMPStats( ICMPIn, ICMPOut: TStrings );
var
  ErrorCode     : DWORD;
  ICMPStats     : PTMibICMPInfo;
begin
  if ( ICMPIn = nil ) or ( ICMPOut = nil ) then EXIT;
  ICMPIn.Clear;
  ICMPOut.Clear;
  New( ICMPStats );
  ErrorCode := GetICMPStatistics( ICMPStats );
  if ErrorCode = NO_ERROR then
  begin
    with ICMPStats.InStats do
    begin
      ICMPIn.Add( 'Messages received    : ' + IntToStr( dwMsgs ) );
      ICMPIn.Add( 'Errors               : ' + IntToStr( dwErrors ) );
      ICMPIn.Add( 'Dest. Unreachable    : ' + IntToStr( dwDestUnreachs ) );
      ICMPIn.Add( 'Time Exceeded        : ' + IntToStr( dwTimeEcxcds ) );
      ICMPIn.Add( 'Param. Problems      : ' + IntToStr( dwParmProbs ) );
      ICMPIn.Add( 'Source Quench        : ' + IntToStr( dwSrcQuenchs ) );
      ICMPIn.Add( 'Redirects            : ' + IntToStr( dwRedirects ) );
      ICMPIn.Add( 'Echo Requests        : ' + IntToStr( dwEchos ) );
      ICMPIn.Add( 'Echo Replies         : ' + IntToStr( dwEchoReps ) );
      ICMPIn.Add( 'Timestamp Requests   : ' + IntToStr( dwTimeStamps ) );
      ICMPIn.Add( 'Timestamp Replies    : ' + IntToStr( dwTimeStampReps ) );

      ICMPIn.Add( 'Addr. Masks Requests : ' + IntToStr( dwAddrMasks ) );
      ICMPIn.Add( 'Addr. Mask Replies   : ' + IntToStr( dwAddrReps ) );
    end;
     //
    with ICMPStats^.OutStats do
    begin
      ICMPOut.Add( 'Messages sent        : ' + IntToStr( dwMsgs ) );
      ICMPOut.Add( 'Errors               : ' + IntToStr( dwErrors ) );
      ICMPOut.Add( 'Dest. Unreachable    : ' + IntToStr( dwDestUnreachs ) );
      ICMPOut.Add( 'Time Exceeded        : ' + IntToStr( dwTimeEcxcds ) );
      ICMPOut.Add( 'Param. Problems      : ' + IntToStr( dwParmProbs ) );
      ICMPOut.Add( 'Source Quench        : ' + IntToStr( dwSrcQuenchs ) );
      ICMPOut.Add( 'Redirects            : ' + IntToStr( dwRedirects ) );
      ICMPOut.Add( 'Echo Requests        : ' + IntToStr( dwEchos ) );
      ICMPOut.Add( 'Echo Replies         : ' + IntToStr( dwEchoReps ) );
      ICMPOut.Add( 'Timestamp Requests   : ' + IntToStr( dwTimeStamps ) );
      ICMPOut.Add( 'Timestamp Replies    : ' + IntToStr( dwTimeStampReps ) );
      ICMPOut.Add( 'Addr. Masks Requests : ' + IntToStr( dwAddrMasks ) );
      ICMPOut.Add( 'Addr. Mask Replies   : ' + IntToStr( dwAddrReps ) );
    end;
  end
  else
    IcmpIn.Add( SysErrorMessage( ErrorCode ) );
  Dispose( ICMPStats );
end;

//------------------------------------------------------------------------------
procedure Get_RecentDestIPs( List: TStrings );
begin
  if Assigned( List ) then
    List.Assign( RecentIPs )
end;

initialization

  RecentIPs := TStringList.Create;

finalization

  RecentIPs.Free;

end.

{ List of Fixes & Additions

v1.1
-----
Fix :  wrong errorcode reported in GetNetworkParams()
Fix :  RTTI MaxHops 20 > 128
Add :  ICMP -statistics
Add :  Well-Known port numbers
Add :  RecentIP list
Add :  Timer update

v1.2
----
Fix :  Recent IP's correct update
ADD :  ICMP-error codes translated

}  


来自：xmcccc, 时间：2005-6-30 15:05:52, ID：3119579
unit IPHLPAPI;

//------------------------------------------------------------------------------
//     Partial translation of  IPHLPAPI.DLL ( IP-Helper API )
//     D. Claessens <dirk.claessens16@yucom.be>
//------------------------------------------------------------------------------

interface
uses
  Windows, winsock;
const

  VERSION       = '1.2';

//------------- headers from Microsoft IPTYPES.H--------------------------------

const
  ANY_SIZE      = 1;
  MAX_ADAPTER_DESCRIPTION_LENGTH = 128; // arb.
  MAX_ADAPTER_NAME_LENGTH = 256; // arb.
  MAX_ADAPTER_ADDRESS_LENGTH = 8; // arb.
  DEFAULT_MINIMUM_ENTITIES = 32; // arb.
  MAX_HOSTNAME_LEN = 128; // arb.
  MAX_DOMAIN_NAME_LEN = 128; // arb.
  MAX_SCOPE_ID_LEN = 256; // arb.

 // Node Types ( NETBIOS)
  BROADCAST_NODETYPE = 1;
  PEER_TO_PEER_NODETYPE = 2;
  MIXED_NODETYPE = 4;
  HYBRID_NODETYPE = 8;

  NETBIOSTypes  : array[0..8] of string[20] =
    ( 'UNKNOWN', 'BROADCAST', 'PEER_TO_PEER', '', 'MIXED', '', '', '', 'HYBRID'
      );

 // Adapter Types
  IF_OTHER_ADAPTERTYPE = 0;
  IF_ETHERNET_ADAPTERTYPE = 1;
  IF_TOKEN_RING_ADAPTERTYPE = 2;
  IF_FDDI_ADAPTERTYPE = 3;
  IF_PPP_ADAPTERTYPE = 4;
  IF_LOOPBACK_ADAPTERTYPE = 5;
  IF_SLIP_ADAPTERTYPE = 6;
 //
  AdaptTypes    : array[0..6] of string[10] =
    ( 'other', 'ethernet', 'tokenring', 'FDDI', 'PPP', 'loopback', 'SLIP' );

//-------------from other MS header files---------------------------------------

  MAX_INTERFACE_NAME_LEN = 256; { mrapi.h }
  MAXLEN_PHYSADDR = 8; { iprtrmib.h }
  MAXLEN_IFDESCR = 256; { --"---     }

//------------------------------------------------------------------------------

type
  TMacAddress = array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;

//------IP address structures---------------------------------------------------

  PTIP_ADDRESS_STRING = ^TIP_ADDRESS_STRING;
  TIP_ADDRESS_STRING = array[0..15] of char; //  IP as string
  //
  PTIP_ADDR_STRING = ^TIP_ADDR_STRING;
  TIP_ADDR_STRING = packed record // for use in linked lists
    Next: PTIP_ADDR_STRING;
    IpAddress: TIP_ADDRESS_STRING;
    IpMask: TIP_ADDRESS_STRING;
    Context: DWORD;
  end;

//----------Fixed Info STRUCTURES---------------------------------------------

  PTFixedInfo = ^TFixedInfo;
  TFixedInfo = packed record
    HostName: array[0..MAX_HOSTNAME_LEN + 4] of char;
    DomainName: array[0..MAX_DOMAIN_NAME_LEN + 4] of char;
    CurrentDNSServer: PTIP_ADDR_STRING;
    DNSServerList: TIP_ADDR_STRING;
    NodeType: UINT;
    ScopeID: array[0..MAX_SCOPE_ID_LEN + 4] of char;
    EnableRouting: UINT;
    EnableProxy: UINT;
    EnableDNS: UINT;
  end;

//----------INTERFACE STRUCTURES-------------------------------------------------

  PTMibIfRow = ^TMibIfRow;
  TMibIfRow = packed record
    wszName: array[1..MAX_INTERFACE_NAME_LEN] of WCHAR;
    dwIndex: DWORD;
    dwType: DWORD;
    dwMTU: DWORD;
    dwSpeed: DWORD;
    dwPhysAddrLen: DWORD;
    bPhysAddr: array[1..MAXLEN_PHYSADDR] 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[1..MAXLEN_IFDESCR] of char; //byte;
  end;

 //
  PTMibIfTable = ^TMIBIfTable;
  TMibIfTable = packed record
    dwNumEntries: DWORD;
    Table: array[0..ANY_SIZE - 1] of TMibIfRow;
  end;

//------ADAPTER INFO STRUCTURES-------------------------------------------------

  TTIME_T = array[1..325] of byte; // hack! MS time.h missing!

  PTIP_ADAPTER_INFO = ^TIP_ADAPTER_INFO;
  TIP_ADAPTER_INFO = packed record
    Next: PTIP_ADAPTER_INFO;
    ComboIndex: DWORD;
    AdapterName: array[1..MAX_ADAPTER_NAME_LENGTH + 4] of char;
    Description: array[1..MAX_ADAPTER_DESCRIPTION_LENGTH + 4] of char;
    AddressLength: UINT;
    Address: array[1..MAX_ADAPTER_ADDRESS_LENGTH] of byte;
    Index: DWORD;
    aType: UINT;
    DHCPEnabled: UINT;
    CurrentIPAddress: PTIP_ADDR_STRING;
    IPAddressList: TIP_ADDR_STRING;
    GatewayList: TIP_ADDR_STRING;
    DHCPServer: TIP_ADDR_STRING;
    HaveWINS: BOOL;
    PrimaryWINSServer: TIP_ADDR_STRING;
    SecondaryWINSServer: TIP_ADDR_STRING;
    LeaseObtained: TTIME_T; //??
    LeaseExpires: TTIME_T; //??
  end;

//----------------TCP STRUCTURES------------------------------------------------

  PTMibTCPRow = ^TMibTCPRow;
  TMibTCPRow = packed record
    dwState: DWORD;
    dwLocalAddr: DWORD;
    dwLocalPort: DWORD;
    dwRemoteAddr: DWORD;
    dwRemotePort: DWORD;
  end;
  //
  PTMibTCPTable = ^TMibTCPTable;
  TMibTCPTable = packed record
    dwNumEntries: DWORD;
    Table: array[0..0] of TMibTCPRow;
  end;
  //
  PTMibTCPStats = ^TMibTCPStats;
  TMibTCPStats = packed record
    dwRTOAlgorithm: DWORD;
    dwRTOMin: DWORD;
    dwRTOMax: DWORD;
    dwMaxConn: DWORD;
    dwActiveOpens: DWORD;
    dwPassiveOpens: DWORD;
    dwAttemptFails: DWORD;
    dwEstabResets: DWORD;
    dwCurrEstab: DWORD;
    dwInSegs: DWORD;
    dwOutSegs: DWORD;
    dwRetransSegs: DWORD;
    dwInErrs: DWORD;
    dwOutRsts: DWORD;
    dwNumConns: DWORD;
  end;

//---------UDP STRUCTURES-------------------------------------------------------

  PTMibUDPRow = ^TMibUDPRow;
  TMibUDPRow = packed record
    dwLocalAddr: DWORD;
    dwLocalPort: DWORD;
  end;
 //
  PTMibUDPTable = ^TMIBUDPTable;
  TMIBUDPTable = packed record
    dwNumEntries: DWORD;
    UDPTable: array[0..ANY_SIZE - 1] of TMibUDPRow;
  end;
 //
  PTMibUdpStats = ^TMIBUdpStats;
  TMIBUdpStats = packed record
    dwInDatagrams: DWORD;
    dwNoPorts: DWORD;
    dwInErrors: DWORD;
    dwOutDatagrams: DWORD;
    dwNumAddrs: DWORD;
  end;

//-----------IP STRUCTURES------------------------------------------------------

 //
  PTMibIPNetRow = ^TMibIPNetRow;
  TMibIPNetRow = packed record
    dwIndex: DWord;
    dwPhysAddrLen: DWord;
    bPhysAddr: TMACAddress;
    dwAddr: DWord;
    dwType: DWord;
  end;
  //
  PTMibIPNetTable = ^TMibIPNetTable;
  TMibIPNetTable = packed record
    dwNumEntries: DWORD;
    Table: array[0..ANY_SIZE - 1] of TMibIPNetRow;
  end;
  //
  PTMibIPStats = ^TMibIPStats;
  TMibIPStats = packed record
    dwForwarding: DWORD;
    dwDefaultTTL: DWORD;
    dwInReceives: DWORD;
    dwInHdrErrors: DWORD;
    dwInAddrErrors: DWORD;
    dwForwDatagrams: DWORD;
    dwInUnknownProtos: DWORD;
    dwInDiscards: DWORD;
    dwInDelivers: DWORD;
    dwOutRequests: DWORD;
    dwRoutingDiscards: DWORD;
    dwOutDiscards: DWORD;
    dwOutNoRoutes: DWORD;
    dwReasmTimeOut: DWORD;
    dwReasmReqds: DWORD;
    dwReasmOKs: DWORD;
    dwReasmFails: DWORD;
    dwFragOKs: DWORD;
    dwFragFails: DWORD;
    dwFragCreates: DWORD;
    dwNumIf: DWORD;
    dwNumAddr: DWORD;
    dwNumRoutes: DWORD;
  end;
  //
  PTMibIPAddrRow = ^TMibIPAddrRow;
  TMibIPAddrRow = packed record
    dwAddr: DWORD;
    dwIndex: DWORD;
    dwMask: DWORD;
    dwBCastAddr: DWORD;
    dwReasmSize: DWORD;
    Unused1,
      Unused2: WORD;
  end;
  //
  PTMibIPAddrTable = ^TMibIPAddrTable;
  TMibIPAddrTable = packed record
    dwNumEntries: DWORD;
    Table: array[0..ANY_SIZE - 1] of TMibIPAddrRow;
  end;

  //
  PTMibIPForwardRow = ^TMibIPForwardRow;
  TMibIPForwardRow = packed record
    dwForwardDest: DWORD;
    dwForwardMask: DWORD;
    dwForwardPolicy: DWORD;
    dwForwardNextHop: DWORD;
    dwForwardIFIndex: DWORD;
    dwForwardType: DWORD;
    dwForwardProto: DWORD;
    dwForwardAge: DWORD;
    dwForwardNextHopAS: DWORD;
    dwForwardMetric1: DWORD;
    dwForwardMetric2: DWORD;
    dwForwardMetric3: DWORD;
    dwForwardMetric4: DWORD;
    dwForwardMetric5: DWORD;
  end;
  //
  PTMibIPForwardTable = ^TMibIPForwardTable;
  TMibIPForwardTable = packed record
    dwNumEntries: DWORD;
    Table: array[0..ANY_SIZE - 1] of TMibIPForwardRow;
  end;

//--------ICMP-STRUCTURES------------------------------------------------------

  PTMibICMPStats = ^TMibICMPStats;
  TMibICMPStats = packed record
    dwMsgs: DWORD;
    dwErrors: DWORD;
    dwDestUnreachs: DWORD;
    dwTimeEcxcds: DWORD;
    dwParmProbs: DWORD;
    dwSrcQuenchs: DWORD;
    dwRedirects: DWORD;
    dwEchos: DWORD;
    dwEchoReps: DWORD;
    dwTimeStamps: DWORD;
    dwTimeStampReps: DWORD;
    dwAddrMasks: DWORD;
    dwAddrReps: DWORD;
  end;

  PTMibICMPInfo = ^TMibICMPInfo;
  TMibICMPInfo = packed record
    InStats: TMibICMPStats;
    OutStats: TMibICMPStats;
  end;

//------------------imports from IPHLPAPI.DLL-----------------------------------

function GetAdaptersInfo( pAdapterInfo: PTIP_ADAPTER_INFO;
  pOutBufLen: PULONG ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetNetworkParams( FixedInfo: PTFixedInfo; pOutPutLen: PULONG ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetTcpTable( pTCPTable: PTMibTCPTable; pDWSize: PDWORD;
  bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetTcpStatistics( pStats: PTMibTCPStats ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetUdpTable( pUdpTable: PTMibUDPTable; pDWSize: PDWORD;
  bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetUdpStatistics( pStats: PTMibUdpStats ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpStatistics( pStats: PTMibIPStats ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpNetTable( pIpNetTable: PTMibIPNetTable;
  pdwSize: PULONG;
  bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpAddrTable( pIpAddrTable: PTMibIPAddrTable;
  pdwSize: PULONG;
  bOrder: BOOL ): DWORD;
stdcall; external 'IPHLPAPI.DLL';

function GetIpForwardTable( pIPForwardTable: PTMibIPForwardTable;
  pdwSize: PULONG;
  bOrder: BOOL ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

function GetIcmpStatistics( pStats: PTMibICMPInfo ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

function GetRTTAndHopCount( DestIPAddress: DWORD; HopCount: PULONG;
  MaxHops: ULONG; RTT: PULONG ): BOOL;
stdCall; external 'IPHLPAPI.DLL';

function GetIfTable( pIfTable: PTMibIfTable; pdwSize: PULONG;
  bOrder: boolean ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

function GetIfEntry( pIfRow: PTMibIfRow ): DWORD;
stdCall; external 'IPHLPAPI.DLL';

implementation

end.    

 
 2005-7-10 10:14:32    delphi中的Format函数详解Format是一个很常用，却又似乎很烦的方法，本人试图对这个方法的帮助进行一些翻译，让它有一个完整的概貌，以供大家查询之用：

首先看它的声明：
function Format(const Format: string; const Args: array of const): string; overload;

事实上Format方法有两个种形式，另外一种是三个参数的，主要区别在于它是线程安全的，
但并不多用，所以这里只对第一个介绍：
function Format(const Format: string; const Args: array of const): string; overload;
 
Format参数是一个格式字符串，用于格式化Args里面的值的。Args又是什么呢，
它是一个变体数组，即它里面可以有多个参数，而且每个参数可以不同。
如以下例子：

Format('my name is %6s',['wind']);
返回后就是my name is wind

现在来看Format参数的详细情况：
Format里面可以写普通的字符串，比如'my name is',但有些格式指令字符具有特殊意义，比如"%6s"格式指令具有以下的形式：
"%" [index ":"] ["-"] [width] ["." prec] type
它是以"%"开始,而以type结束，type表示一个具体的类型。中间是用来
格式化type类型的指令字符，是可选的。

先来看看type,type可以是以下字符：
d 十制数，表示一个整型值
u 和d一样是整型值，但它是无符号的，而如果它对应的值是负的，则返回时是一个2的32次方减去这个绝对值的数,如：
Format('this is %u',[－2]);
返回的是：this is 4294967294

f 对应浮点数
e 科学表示法，对应整型数和浮点数，比如
Format('this is %e',[-2.22]);
返回的是：this is -2.22000000000000E+000,等一下再说明如果将数的精度缩小

g 这个只能对应浮点型，且它会将值中多余的数去掉,比如
Format('this is %g',[02.200]);
返回的是：this is 2.2

n 只能对应浮点型，将值转化为号码的形式。看一个例子就明白了
Format('this is %n',[4552.2176]);
返回的是this is 4,552.22

  注意有两点，一是只表示到小数后两位，等一下说怎么消除这种情况, 二是，即使小数没有被截断，它也不会也像整数部分一样有逗号来分开的

m钱币类型，但关于货币类型有更好的格式化方法，这里只是简单的格式化,另外它只对应于浮点值
Format('this is %m',[9552.21]);
返回：this is ￥9,552.21

p 对应于指针类型，返回的值是指针的地址，以十六进制的形式来表示
  例如：
var X:integer;
p:^integer;
begin
  X:=99;
  p:=@X;
  Edit1.Text:=Format('this is %p',[p]);
end;
Edit1的内容是：this is 0012F548

s 对应字符串类型，不用多说了吧
x 必须是一个整形值，以十六进制的形式返回
Edit1.Text:=Format('this is %X',[15]);
返回是：this is F

类型讲述完毕，下面介绍格式化Type的指令：
[index ":"]这个要怎么表达呢，看一个例子
Format('this is %d %d',[12,13]);
其中第一个%d的索引是0，第二个%d是1，所以字符显示的时候是这样 this is 12 13

而如果你这样定义：
Format('this is %1:d %0:d',[12,13]);
那么返回的字符串就变成了this is 13 12。现在明白了吗，[index ":"] 中的index指示Args中参数显示的顺序还有一种情况，如果这样
Format('%d %d %d %0:d %d', [1, 2, 3, 4])
将返回1 2 3 1 2。

如果你想返回的是1 2 3 1 4，必须这样定：
Format('%d %d %d %0:d %3:d', [1, 2, 3, 4])

但用的时候要注意，索引不能超出Args中的个数，不然会引起异常如
Format('this is %2:d %0:d',[12,13]);
由于Args中只有12 13 两个数，所以Index只能是0或1，这里为2就错了[width] 指定将被格式化的值占的宽度，看一个例子就明白了

Format('this is %4d',[12]);
输出是：this is   12,这个是比较容易，不过如果Width的值小于参数的长度，则没有效果。
如：

Format('this is %1d',[12]);
输出是：this is 12

["-"]这个指定参数向左齐，和[width]合在一起最可以看到效果：
Format('this is %-4d,yes',[12]);
输出是：this is 12   ,yes

["." prec] 指定精度，对于浮点数效果最佳：
Format('this is %.2f',['1.1234]);
输出 this is 1.12
Format('this is %.7f',['1.1234]);
输出了 this is 1.1234000

而对于整型数，如果prec比如整型的位数小，则没有效果反之比整形值的位数大，则会在整型值的前面以0补之
Format('this is %.7d',[1234]);
输出是：this is 0001234]
          
对于字符型，刚好和整型值相反，如果prec比字符串型的长度大则没有效果，反之比字符串型的长度小，则会截断尾部的字符
Format('this is %.2s',['1234']);
输出是 this is 12,而上面说的这个例子：

Format('this is %e',[-2.22]);
返回的是：this is -2.22000000000000E+000,怎么去掉多余的0呢，这个就行啦

Format('this is %.2e',[-2.22]);
     
好了，第一个总算讲完了，应该对他的应用很熟悉了吧

///////////////////////////////////////////////////////////////
二 FormatDateTime的用法
他的声明为：

function FormatDateTime(const Format: string; DateTime: TDateTime): string; 
overload;

当然和Format一样还有一种，但这里只介绍常用的第一种,Format参数是一个格式化字符串。DateTime是时间类型。返回值是一种格式化后的字符串,重点来看Format参数中的指令字符

c 以短时间格式显示时间，即全部是数字的表示
FormatdateTime('c',now);
输出为：2004-8-7 9:55:40

d 对应于时间中的日期，日期是一位则显示一位，两位则显示两位
FormatdateTime('d',now);
输出可能为1～31

dd 和d的意义一样，但它始终是以两位来显示的
FormatdateTime('dd',now);
输出可能为01～31

ddd 显示的是星期几
FormatdateTime('ddd',now);
输出为: 星期六

dddd 和ddd显示的是一样的。 但上面两个如果在其他国家可能不一样。ddddd 以短时间格式显示年月日 
FormatdateTime('ddddd',now);
输出为：2004-8-7

dddddd 以长时间格式显示年月日
FormatdateTime('dddddd',now); 
输出为：2004年8月7日

e/ee/eee/eeee 以相应的位数显示年
FormatdateTime('ee',now); 
输出为：04  （表示04年）

m/mm/mmm/mmmm 表示月
FormatdateTime('m',now);
输出为：8
FormatdateTime('mm',now);
输出为  08
FormatdateTime('mmm',now);
输出为  八月
FormatdateTime('mmmm',now); 
输出为  八月

 和ddd/dddd 一样，在其他国家可能不同yy/yyyy 表示年
FormatdateTime('yy',now);
输出为 04
FormatdateTime('yyyy',now);
输出为 2004,

h/hh,n/nn,s/ss,z/zzz 分别表示小时，分，秒,毫秒

t  以短时间格式显示时间
FormatdateTime('t',now);
输出为 10:17

tt 以长时间格式显示时间
FormatdateTime('tt',now);
输出为10:18:46

ampm 以长时间格式显示上午还是下午
FormatdateTime('ttampm',now);
输出为：10:22:57上午

大概如此，如果要在Format中加普通的字符串，可以用双引号隔开那些特定义的字符，这样普通字符串中如果含特殊的字符就不会被显示为时间格式啦：
FormatdateTime('"today is" c',now);
 输出为：today is 2004-8-7 10:26:58

时间中也可以加"-"或"\"来分开日期：
FormatdateTime('"today is" yy-mm-dd',now);
FormatdateTime('"today is" yy\mm\dd',now);
输出为： today is 04-08-07

也可以用":"来分开时间  
FormatdateTime('"today is" hh:nn:ss',now);
输出为：today is 10:32:23

/////////////////////////////////////////////////////////////////
三.FormatFloat的用法

常用的声明：
function FormatFloat(const Format: string; Value: Extended): string; overload;

和上面一样Format参数为格式化指令字符，Value为Extended类型为什么是这个类型，因为它是所有浮点值中表示范围最大的，如果传入该方法的参数比如Double或者其他，则可以保存不会超出范围。

关键是看Format参数的用法
0  这个指定相应的位数的指令。
   比如：
FormatFloat('000.000',22.22);
输出的就是022.220
 
注意一点，如果整数部分的0的个数小于Value参数中整数的位数，则没有效果如：
FormatFloat('0.00',22.22);
输出的是：22.22

但如果小数部分的0小于Value中小数的倍数，则会截去相应的小数和位数如：
FormatFloat('0.0',22.22);
输出的是：22.2
   
也可以在整数0中指定逗号，这个整数位数必须大于3个，才会有逗号出句
FormatFloat('0,000.0',2222.22);
输出是：2,222.2

如果这样
FormatFloat('000,0.0',2222.22);
它的输出还是：2,222.2

注意它的规律,#和0的用法一样，目前我还没有测出有什么不同。

FormatFloat('##.##',22.22);
输出是：22.00

E  科学表示法，看几个例子大概就明白了
FormatFloat('0.00E+00',2222.22);
输出是 2.22E+03
FormatFloat('0000.00E+00',2222.22);
输出是 2222.22E+00
FormatFloat('00.0E+0',2222.22);
 22.2E+2
明白了吗，全靠E右边的0来支配的。
   
这个方法并不难，大概就是这样子了。

上面三个方法是很常用的，没有什么技巧，只要记得这些规范就行了。

总结一下Format的用法:

Format('x=%d',[12]);//'x=12'//最普通
Format('x=%3d',[12]);//'x=12'//指定宽度
Format('x=%f',[12.0]);//'x=12.00'//浮点数
Format('x=%.3f',[12.0]);//'x=12.000'//指定小数
Format('x=%8.2f'[12.0])//'x=12.00';
Format('x=%.*f',[5,12.0]);//'x=12.00000'//动态配置
Format('x=%.5d',[12]);//'x=00012'//前面补充0
Format('x=%.5x',[12]);//'x=0000C'//十六进制
Format('x=%1:d%0:d',[12,13]);//'x=1312'//使用索引
Format('x=%p',[nil]);//'x=00000000'//指针
Format('x=%1.1e',[12.0]);//'x=1.2E+001'//科学记数法
Format('x=%%',[]);//'x=%'//得到"%"
S:=Format('%s%d',[S,I]);//S:=S+StrToInt(I);//连接字符串