home *** CD-ROM | disk | FTP | other *** search
/ Chip 2001 September / Chip_2001-09_cd1.bin / zkuste / delphi / kompon / d2345 / MSYSINFO.ZIP / Source / MSI_Network.pas < prev    next >
Pascal/Delphi Source File  |  2001-05-21  |  19KB  |  553 lines
  1.  
  2. {*******************************************************}
  3. {                                                       }
  4. {       MiTeC System Information Component              }
  5. {               Network Detection Part                  }
  6. {           version 5.4 for Delphi 3,4,5                }
  7. {                                                       }
  8. {       Copyright ⌐ 1997,2001 Michal Mutl               }
  9. {                                                       }
  10. {*******************************************************}
  11.  
  12. {$INCLUDE MITEC_DEF.INC}
  13.  
  14. unit MSI_Network;
  15.  
  16. interface
  17.  
  18. uses
  19.   SysUtils, Windows, Classes, WinSock;
  20.  
  21. type
  22.   TWinsock = class(TPersistent)
  23.   private
  24.     FDesc: string;
  25.     FStat: string;
  26.     FMajVer: word;
  27.     FMinVer: word;
  28.   public
  29.     procedure GetInfo;
  30.   published
  31.     property Description: string read FDesc write FDesc stored False;
  32.     property MajorVersion: word read FMajVer write FMajVer stored False;
  33.     property MinorVersion: word read FMinVer write FMinVer stored False;
  34.     property Status: string read FStat write FStat stored False;
  35.   end;
  36.  
  37.   TNetwork = class(TPersistent)
  38.   private
  39.     FAdapter: TStrings;
  40.     FWinsock: TWinsock;
  41.     FIPAddress: TStrings;
  42.     FMACAddress: TStrings;
  43.     FCli: TStrings;
  44.     FServ: TStrings;
  45.     FProto: TStrings;
  46.     FNCAI: integer;
  47.     function GetLocalIP :string;
  48.   public
  49.     constructor Create;
  50.     destructor Destroy; override;
  51.     procedure GetInfo;
  52.     procedure Report(var sl :TStringList);
  53.   published
  54.     property IPAddresses: TStrings read FIPAddress write FIPAddress stored false;
  55.     property MACAddresses: TStrings read FMACAddress write FMACAddress stored False;
  56.     property Adapters :TStrings read FAdapter write FAdapter stored false;
  57.     property CardAdapterIndex: integer read FNCAI write FNCAI stored False;
  58.     property Protocols :TStrings read FProto write FProto stored False;
  59.     property Services :TStrings read FServ write FServ stored False;
  60.     property Clients :TStrings read FCli write FCli stored False;
  61.     property WinSock: TWinsock read FWinsock write FWinsock;
  62.   end;
  63.  
  64. implementation
  65.  
  66. uses Registry, MiTeC_Routines, MSI_Devices;
  67.  
  68. const
  69.   NBNAMESIZE    = 16;
  70.   MAXLANAS      = 254;
  71.   NCB_ASYNC     = $80;   { asynch command bit to be or-ed into command }
  72.   NCB_CALL      = $10;   { open a session }
  73.   NCB_LISTEN    = $11;   { wait for a call }
  74.   NCB_HANGUP    = $12;   { end session }
  75.   NCB_SEND      = $14;   { send data }
  76.   NCB_RECV      = $15;   { receive data }
  77.   NCB_RECVANY   = $16;   { receive data on any session }
  78.   NCB_CHAINSEND = $17;   { chain send data }
  79.   NCB_DGSEND    = $20;   { send a datagram }
  80.   NCB_DGRECV    = $21;   { receive datagram }
  81.   NCB_DGSENDBC  = $22;   { send broadcast datagram }
  82.   NCB_DGREVCBC  = $23;   { receive broadcast datagram }
  83.   NCB_ADDNAME   = $30;   { add unique name to local table }
  84.   NCB_DELNAME   = $31;   { delete name from local table }
  85.   NCB_RESET     = $32;   { reset adapter }
  86.   NCB_ADPSTAT   = $33;   { adapter status }
  87.   NCB_SSTAT     = $34;   { session status }
  88.   NCB_CANCEL    = $35;   { cancel NCB request }
  89.   NCB_ADDGRPNAME= $36;   { add group name to local table }
  90.   NCB_ENUM      = $37;   { enum adapters }
  91.   NCB_UNLINK    = $70;   { unlink remote boot code }
  92.   NCB_SENDNA    = $71;   { send, don't wait for ACK }
  93.   NCB_CHAINSENDNA=$72;   { chain send, but don't wait for ACK }
  94.   NCB_LANSTALERT= $73;   { lan status alert }
  95.   NCB_ACTION    = $77;   { enable extensions }
  96.   NCB_FINDNAME  = $78;   { search for name on the network }
  97.   NCB_TRACE     = $79;   { activate / stop tracing }
  98.   NRC_GOODRET     = $00;    { good return
  99.   NRC_BUFLEN      = $01;    { illegal buffer length                      }
  100.   NRC_ILLCMD      = $03;    { illegal command                            }
  101.   NRC_CMDTMO      = $05;    { command timed out                          }
  102.   NRC_INCOMP      = $06;    { message incomplete, issue another command  }
  103.   NRC_BADDR       = $07;    { illegal buffer address                     }
  104.   NRC_SNUMOUT     = $08;    { session number out of range                }
  105.   NRC_NORES       = $09;    { no resource available                      }
  106.   NRC_SCLOSED     = $0a;    { session closed                             }
  107.   NRC_CMDCAN      = $0b;    { command cancelled                          }
  108.   NRC_DUPNAME     = $0d;    { duplicate name                             }
  109.   NRC_NAMTFUL     = $0e;    { name table full                            }
  110.   NRC_ACTSES      = $0f;    { no deletions, name has active sessions     }
  111.   NRC_LOCTFUL     = $11;    { local session table full                   }
  112.   NRC_REMTFUL     = $12;    { remote session table full                  }
  113.   NRC_ILLNN       = $13;    { illegal name number                        }
  114.   NRC_NOCALL      = $14;    { no callname                                }
  115.   NRC_NOWILD      = $15;    { cannot put * in NCB_NAME                   }
  116.   NRC_INUSE       = $16;    { name in use on remote adapter              }
  117.   NRC_NAMERR      = $17;    { name deleted                               }
  118.   NRC_SABORT      = $18;    { session ended abnormally                   }
  119.   NRC_NAMCONF     = $19;    { name conflict detected                     }
  120.   NRC_IFBUSY      = $21;    { interface busy, IRET before retrying       }
  121.   NRC_TOOMANY     = $22;    { too many commands outstanding, retry later }
  122.   NRC_BRIDGE      = $23;    { ncb_lana_num field invalid                 }
  123.   NRC_CANOCCR     = $24;    { command completed while cancel occurring   }
  124.   NRC_CANCEL      = $26;    { command not valid to cancel                }
  125.   NRC_DUPENV      = $30;    { name defined by anther local process       }
  126.   NRC_ENVNOTDEF   = $34;    { environment undefined. RESET required      }
  127.   NRC_OSRESNOTAV  = $35;    { required OS resources exhausted            }
  128.   NRC_MAXAPPS     = $36;    { max number of applications exceeded        }
  129.   NRC_NOSAPS      = $37;    { no saps available for netbios              }
  130.   NRC_NORESOURCES = $38;    { requested resources are not available      }
  131.   NRC_INVADDRESS  = $39;    { invalid ncb address or length > segment    }
  132.   NRC_INVDDID     = $3B;    { invalid NCB DDID                           }
  133.   NRC_LOCKFAIL    = $3C;    { lock of user area failed                   }
  134.   NRC_OPENERR     = $3f;    { NETBIOS not loaded                         }
  135.   NRC_SYSTEM      = $40;    { system error                               }
  136.   NRC_PENDING     = $ff;    { asynchronous command is not yet finished   }
  137.   ALL_TRANSPORTS = 'M'#$00#$00#$00;
  138.   MS_NBF         = 'MNBF';
  139.   NAME_FLAGS_MASK = $87;
  140.   GROUP_NAME      = $80;
  141.   UNIQUE_NAME     = $00;
  142.  
  143. type
  144. { Netbios Name }
  145.   TNBName = array[0..(NBNAMESIZE - 1)] of byte;
  146.  
  147.  { MAC address }
  148.   TMacAddress = array[0..5] of byte;
  149.  
  150.   PNCB = ^TNCB;
  151.  
  152.  { Netbios Control Block }
  153.  
  154.  {$IFDEF WIN32}
  155.   TNCBPostProc = procedure(P: PNCB);
  156.  {$ENDIF}
  157.  
  158.   TNCB = packed record        { Netbios Control Block }
  159.     Command:  byte;      { command code                       }
  160.     RetCode:  byte;      { return code                        }
  161.     LSN:      byte;      { local session number               }
  162.     Num:      byte;      { name number                        }
  163.     Buf:      ^byte;     { data buffer                        }
  164.     Length:   word;      { data length                        }
  165.     CallName: TNBName;   { name to call                       }
  166.     Name:     TNBName;   { our own name                       }
  167.     RTO:      byte;      { receive time-out                   }
  168.     STO:      byte;      { send time-out                      }
  169.   {$IFNDEF WIN32}
  170.     Post_Offs:word;      { asynch notification routine offset }
  171.     Post_Seg: word;      { asynch notification routine segment}
  172.   {$ELSE}
  173.     PostPrc:  TNCBPostProc;{ asynch notification routine (nb30) }
  174.   {$ENDIF}
  175.     Lana_Num: byte;     { adapter number                     }
  176.     Cmd_Cplt: byte;     { command completion flag            }
  177.   {$IFDEF WIN32}
  178.     Reserved: array[0..9] of byte;  { Reserverd for Bios use }
  179.     Event:    THandle;  { WIN32 event handle to be signalled }
  180.                         { for asynch cmd completion          }
  181.   {$ELSE}
  182.     Reserved: array[0..13] of byte;  { Reserved }
  183.   {$ENDIF}
  184.   end;
  185.  
  186.  
  187. { Netbios Name Info record }
  188.   PNameInfo = ^TNameInfo;
  189.   TNameInfo = packed record  { name info record }
  190.     Name:   TNBName;       { netbios name }
  191.     NameNum:byte;          { name number  }
  192.     NameSt: byte;          { name status  }
  193.   end;
  194.  
  195. { Netbios adapter status }
  196.   PAdpStat = ^TAdpStat;
  197.   TAdpStat = packed record    { adapter status record}
  198.     ID:       TMacAddress;   { adapter mac address           }
  199.     VMajor:   byte;          { software version major number }
  200.     Resvd0:   byte;
  201.     AdpType:  byte;          { adapter type                  }
  202.     VMinor:   byte;          { software version minor number }
  203.     RptTime:  word;          { reporting time period         }
  204.     RcvCRC:   word;          { receive crc errors            }
  205.     RcvOth:   word;          { receive other errors          }
  206.     TxmCol:   word;          { transmit collisions           }
  207.     TxmOth:   word;          { transmit other errors         }
  208.     TxmOK:    LongInt;       { successfull transmissions     }
  209.     RcvOK:    LongInt;       { successfull receives          }
  210.     TxmRetr:  word;          { transmit retries              }
  211.     NoRcvBuf: word;          { number of 'no receive buffer' }
  212.     T1_tmo:   word;          { t1 time-outs                  }
  213.     Ti_tmo:   word;          { ti time_outs                  }
  214.     Resvd1:   LongInt;
  215.     Free_Ncbs:word;          { number of free ncb's          }
  216.     Cfg_Ncbs: word;          { number of configured ncb's    }
  217.     max_Ncbs: word;          { max ncb's used                }
  218.     NoTxmBuf: word;          { number of 'no transmit buffer'}
  219.     MaxDGSize:word;          { max. datagram size            }
  220.     Pend_Ses: word;          { number of pending sessions    }
  221.     Cfg_Ses:  word;          { number of configured sessions }
  222.     Max_Ses:  word;          { max sessions used             }
  223.     Max_SPSz: word;          { max. session packet size      }
  224.     nNames:   word;          { number of names in local table}
  225.     Names:    array[0..15] of TnameInfo; { local name table  }
  226.   end;
  227.  
  228. {
  229.    Structure returned to the NCB command NCBSSTAT is SESSION_HEADER followed
  230.    by an array of SESSION_BUFFER structures. If the NCB_NAME starts with an
  231.    asterisk then an array of these structures is returned containing the
  232.    status for all names.
  233. }
  234.  
  235. { session header }
  236.   PSession_Header = ^TSession_Header;
  237.   TSession_Header = packed record
  238.     sess_name:            byte;
  239.     num_sess:             byte;
  240.     rcv_dg_outstanding:   byte;
  241.     rcv_any_outstanding:  byte;
  242.   end;
  243.  
  244. { session buffer }
  245.   PSession_Buffer = ^TSession_Buffer;
  246.   TSession_Buffer = packed record
  247.     lsn:                  byte;
  248.     state:                byte;
  249.     local_name:           TNBName;
  250.     remote_name:          TNBName;
  251.     rcvs_outstanding:     byte;
  252.     sends_outstanding:    byte;
  253.   end;
  254.  
  255. {
  256.    Structure returned to the NCB command NCBENUM.
  257.  
  258.    On a system containing lana's 0, 2 and 3, a structure with
  259.    length =3, lana[0]=0, lana[1]=2 and lana[2]=3 will be returned.
  260. }
  261.   PLana_Enum = ^TLana_Enum;
  262.   TLANA_ENUM = packed record
  263.     length:   byte;         {  Number of valid entries in lana[] }
  264.     lana:     array[0..(MAXLANAS - 1)] of byte;
  265.   end;
  266.  
  267. {
  268.    Structure returned to the NCB command NCBFINDNAME is FIND_NAME_HEADER followed
  269.    by an array of FIND_NAME_BUFFER structures.
  270.  }
  271.  
  272.   PFind_Name_Header = ^TFind_Name_Header;
  273.   TFind_Name_Header = packed record
  274.     node_count:    word;
  275.     reserved:      byte;
  276.     unique_group:  byte;
  277.   end;
  278.  
  279.   PFind_Name_Buffer = ^TFind_Name_Buffer;
  280.   TFind_Name_Buffer = packed record
  281.     length:          byte;
  282.     access_control:  byte;
  283.     frame_control:   byte;
  284.     destination_addr:TMacAddress;
  285.     source_addr:     TMacAddress;
  286.     routing_info:    array[0..17] of byte;
  287.   end;
  288.  
  289. {
  290.    Structure provided with NCBACTION. The purpose of NCBACTION is to provide
  291.    transport specific extensions to netbios.
  292.  }
  293.  
  294.   PAction_Header = ^TAction_Header;
  295.   TAction_Header = packed record
  296.     transport_id: LongInt;
  297.     action_code:  Word;
  298.     reserved:     Word;
  299.   end;
  300.  
  301. {$IFDEF WIN32}
  302. function Netbios(P: PNCB): Char; stdcall; external 'netapi32.dll' name 'Netbios';
  303. {$ENDIF}
  304.  
  305. function NetbiosCmd(var NCB: TNCB): Word;
  306. begin
  307. {$IFNDEF WIN32}
  308.   asm
  309.     push bp                   { save bp }
  310.     push ss                   { save ss }
  311.     push ds                   { save ds }
  312.     les  bx, NCB              { get segment/offset address of NCB }
  313.     call NetBiosCall;         { 16 bit Windows Netbios call }
  314.     xor  ah,ah
  315.     mov  @Result, ax          { store return code }
  316.     pop  ds                   { restore ds }
  317.     pop  ss                   { restore ss }
  318.     pop  bp                   { restore bp }
  319.   end;
  320. {$ELSE}
  321.   Result:=Word(Netbios(PNCB(@NCB)));
  322. {$ENDIF}
  323. end;
  324.  
  325. function NbLanaEnum: TLana_Enum;
  326. var
  327.   NCB: TNCB;
  328.   L_Enum: TLana_Enum;
  329.   RetCode: Word;
  330. begin
  331. {$IFDEF WIN32}
  332.   FillChar(NCB, SizeOf(NCB),0);
  333.   FillChar(L_Enum, SizeOf(TLana_Enum),0);
  334.   NCB.Command:=NCB_ENUM;
  335.   NCB.Buf:=@L_Enum;
  336.   NCB.Length:=Sizeof(L_Enum);
  337.   RetCode:=NetBiosCmd(NCB);
  338.   if RetCode<>NRC_GOODRET then begin
  339.     L_Enum.Length:=0;
  340.     L_Enum.Lana[0]:=Byte(RetCode);
  341.   end;
  342. {$ELSE}
  343.   L_Enum.Length:=1;
  344.   L_Enum.Lana[0]:=0;
  345. {$ENDIF}
  346.   Result:=L_Enum;
  347. end;
  348.  
  349. function NbReset(l: Byte): Word;
  350. var
  351.   NCB: TNCB;
  352. begin
  353. {$IFNDEF WIN32}
  354.   Result:=NRC_GOODRET;
  355. {$ELSE}
  356.   FillChar(NCB,SizeOf(NCB),0);
  357.   NCB.Command:=NCB_RESET;
  358.   NCB.Lana_Num:=l;
  359.   Result:=NetBiosCmd(NCB);
  360. {$ENDIF}
  361. end;
  362.  
  363. function NbGetMacAddr(LanaNum: Integer): String;
  364. var
  365.   NCB: TNCB;
  366.   AdpStat: TAdpStat;
  367.   RetCode: Word;
  368. begin
  369.   FillChar(NCB,SizeOf(NCB),0);
  370.   FillChar(AdpStat,SizeOf(AdpStat),0);
  371.   NCB.Command:=NCB_ADPSTAT;
  372.   NCB.Buf:=@AdpStat;
  373.   NCB.Length:=Sizeof(AdpStat);
  374.   FillChar(NCB.CallName,Sizeof(TNBName),$20);
  375.   NCB.CallName[0]:=Byte('*');
  376.   NCB.Lana_Num:=LanaNum;
  377.   RetCode:=NetBiosCmd(NCB);
  378.   if RetCode=NRC_GOODRET then begin
  379.     Result:=Format('%2.2x:%2.2x:%2.2x:%2.2x:%2.2x:%2.2x',
  380.                    [AdpStat.ID[0],
  381.                    AdpStat.ID[1],
  382.                    AdpStat.ID[2],
  383.                    AdpStat.ID[3],
  384.                    AdpStat.ID[4],
  385.                    AdpStat.ID[5]
  386.                    ]);
  387.   end else
  388.     Result:='??:??:??:??:??:??';
  389. end;
  390.  
  391. { TWinsock }
  392.  
  393. procedure TWinsock.GetInfo;
  394. var
  395.   GInitData :TWSADATA;
  396. begin
  397.   try
  398.     if wsastartup($101,GInitData)=0 then begin
  399.       FDesc:=GInitData.szDescription;
  400.       FStat:=GInitData.szSystemStatus;
  401.       FMajVer:=Hi(GInitData.wHighVersion);
  402.       FMinVer:=Lo(GInitData.wHighVersion);
  403.       wsacleanup;
  404.     end else
  405.       FStat:='Winsock cannot be initialized.';
  406.   except
  407.     on e:Exception do begin
  408.       MessageBox(0,PChar(e.message),'TWinsock.GetInfo',MB_OK or MB_ICONERROR);
  409.     end;
  410.   end;
  411. end;
  412.  
  413. { TNetwork }
  414.  
  415. function TNetwork.GetLocalIP: string;
  416. type
  417.   TaPInAddr = array [0..255] of PInAddr;
  418.   PaPInAddr = ^TaPInAddr;
  419. var
  420.   phe  :PHostEnt;
  421.   pptr :PaPInAddr;
  422.   Buffer :array [0..63] of char;
  423.   i :integer;
  424.   GInitData :TWSADATA;
  425. begin
  426.   wsastartup($101,GInitData);
  427.   result:='';
  428.   GetHostName(Buffer,SizeOf(Buffer));
  429.   phe:=GetHostByName(buffer);
  430.   if not assigned(phe) then
  431.     exit;
  432.   pptr:=PaPInAddr(Phe^.h_addr_list);
  433.   i:=0;
  434.   while pptr^[I]<>nil do begin
  435.     result:=Result+StrPas(inet_ntoa(pptr^[I]^))+',';
  436.     inc(i);
  437.   end;
  438.   Delete(Result,Length(Result),1);
  439.   wsacleanup;
  440. end;
  441.  
  442. procedure TNetwork.GetInfo;
  443. var
  444.   L_Enum: TLana_Enum;
  445.   RetCode: Word;
  446.   i: integer;
  447.   ck,dv: string;
  448. const
  449.   rkNetworkNT = {HKEY_LOCAL_MACHINE\}'SOFTWARE\Microsoft\Windows NT\CurrentVersion\NetworkCards';
  450.   rkNetwork2K = {HKEY_LOCAL_MACHINE\}'SYSTEM\CurrentControlSet\Control\Network';
  451.  
  452.   rvNetworkNT = 'Description';
  453.  
  454.   rvProtoClass = 'NetTrans';
  455.   rvServClass = 'NetService';
  456.   rvCliClass = 'NetClient';
  457. begin
  458.   try
  459.  
  460.   FWinSock.GetInfo;
  461.   FIPAddress.CommaText:=GetLocalIP;
  462.   FAdapter.Clear;
  463.   FNCAI:=-1;
  464.  
  465.   with TDevices.Create do begin
  466.     GetInfo;
  467.     for i:=0 to DeviceCount-1 do
  468.       if Devices[i].DeviceClass=dcNet then begin
  469.         if Devices[i].FriendlyName='' then
  470.           ck:=Devices[i].Description
  471.         else
  472.           ck:=Devices[i].FriendlyName;
  473.         FAdapter.Add(ck);
  474.         if (Devices[i].Location<>'') and (FNCAI=-1) then
  475.           FNCAI:=FAdapter.Count-1;
  476.       end;
  477.     Free;
  478.   end;
  479.  
  480.   if Is2K then begin
  481.     ck:=rkNetwork2K;
  482.     dv:=rvNetworkNT;
  483.   end else begin
  484.     ck:=ClassKey;
  485.     dv:=DescValue;
  486.   end;
  487.   GetClassDevices(ck,rvProtoClass,dv,FProto);
  488.   GetClassDevices(ck,rvServClass,dv,FServ);
  489.   GetClassDevices(ck,rvCliClass,dv,FCli);
  490.  
  491.   FMACAddress.Clear;
  492.   L_Enum:=NbLanaEnum;
  493.   if L_Enum.Length<>0 then
  494.     for i:=0 to (L_Enum.Length-1) do begin
  495.       RetCode:=NbReset(L_Enum.Lana[i]);
  496.       if RetCode=NRC_GOODRET then begin
  497.         ck:=NbGetMacAddr(L_Enum.Lana[i]);
  498.         if FMacAddress.IndexOf(ck)=-1 then
  499.           FMacAddress.Add(ck);
  500.       end;
  501.     end;
  502.  
  503.   except
  504.     on e:Exception do begin
  505.       MessageBox(0,PChar(e.message),'TNetwork.GetInfo',MB_OK or MB_ICONERROR);
  506.     end;
  507.   end;
  508. end;
  509.  
  510. constructor TNetwork.Create;
  511. begin
  512.   inherited;
  513.   FWinsock:=TWinsock.Create;
  514.   FAdapter:=TStringList.Create;
  515.   FIPAddress:=TStringList.Create;
  516.   FMACAddress:=TStringList.Create;
  517.   FProto:=TStringList.Create;
  518.   FServ:=TStringList.Create;
  519.   FCli:=TStringList.Create;
  520. end;
  521.  
  522. destructor TNetwork.Destroy;
  523. begin
  524.   FWinsock.Free;
  525.   FAdapter.Free;
  526.   FMACAddress.Free;
  527.   FIPAddress.Free;
  528.   FProto.Free;
  529.   FCli.Free;
  530.   FServ.Free;
  531.   inherited;
  532. end;
  533.  
  534. procedure TNetwork.Report(var sl: TStringList);
  535. begin
  536.   with sl do begin
  537.     Add('[Network]');
  538.     StringsToRep(Adapters,'Count','Adapter',sl);
  539.     StringsToRep(Protocols,'ProtoCount','Protocol',sl);
  540.     StringsToRep(Services,'ServiceCount','Service',sl);
  541.     StringsToRep(Clients,'ClientCount','Client',sl);
  542.     StringsToRep(IPAddresses,'IPCount','IPAddress',sl);
  543.     StringsToRep(MACAddresses,'MACCount','MACAddress',sl);
  544.     Add('[Winsock]');
  545.     Add(Format('Description=%s',[Winsock.Description]));
  546.     Add(Format('Version=%d.%d',[Hi(Winsock.MajorVersion),Lo(Winsock.MinorVersion)]));
  547.     Add(Format('Status=%s',[Winsock.Status]));
  548.   end;
  549. end;
  550.  
  551.  
  552. end.
  553.