u_frmsearchnetip.~pas

扫描IP地址和MAC地址、工作组信息软件

              {Grid}
              I:=SgDispNetIP.RowCount;
              if I=2 then
              begin
                 if trim(SgDispNetIP.Cells[0,1])<>'' then
                 begin
                    Inc(i);
                    SgDispNetIP.RowCount:=I;
                 end;
              end
              else begin
                   Inc(i);
                   SgDispNetIP.RowCount:=I;
              end;
              Dec(i);
              SgDispNetIP.Cells[0,i]:=str_list_IP;//'TP地址'
              SgDispNetIP.Cells[1,i]:=str_list_name;//'计算机名称'
              SgDispNetIP.Cells[2,i]:=str_list_disp;//'计算机描述'
              SgDispNetIP.Cells[3,i]:=str_list_GROUP;//'网络组'
              SgDispNetIP.Cells[4,i]:=str_list_MAC;//'网卡MAC码'
              {
              RichEdit1.Text :=RichEdit1.Text + str_list_IP + ' ' + str_list_name + '  ' +
              str_list_disp + '  ' + str_list_GROUP +'    '  + str_list_MAC+ #13+#10
              }
              setlength(TGroupNet,high(TGroupNet)+2);
              TGroupNet[high(TGroupNet)].IP:=str_list_IP;//'TP地址'
              TGroupNet[high(TGroupNet)].ComputerName :=str_list_name;//'计算机名称'
              TGroupNet[high(TGroupNet)].ComputerDes:=str_list_disp;//'计算机描述'
              TGroupNet[high(TGroupNet)].NetGroup:=str_list_GROUP;//'网络组'
              TGroupNet[high(TGroupNet)].NetMacCode :=str_list_MAC;//'网卡MAC码'

              StrTp:=str_list_IP + '   ' +str_list_name+ '   ' +
                str_list_disp + '   ' + str_list_GROUP + '   ' +
                str_list_MAC;
          end;
          SetEvent(WAIT_ACK_EVENT);//有信号
     end;
end;
{Grid清除 ClearGrid}
procedure TFrmSearchNetIp.ClearGrid;
begin
   SgDispNetIP.RowCount:=2;
   SgDispNetIP.Rows[1].Text:='';
   SgDispNetIP.Cells[0,0]:='TP地址' ;
   SgDispNetIP.Cells[1,0]:='计算机名称' ;
   SgDispNetIP.Cells[2,0]:='计算机描述' ;
   SgDispNetIP.Cells[3,0]:='网络组' ;
   SgDispNetIP.Cells[4,0]:='网卡MAC码' ;
end;

 
{排序}
{
'TP地址'0
'计算机名称'1
'计算机描述' 2
'网络组'3
'网卡MAC码'4
}
procedure TFrmSearchNetIp.MakeGrid(const IntIndex: integer=3);
Var
  X,XCount:integer;
  GroupNet:TtGroupNet;
  IntMin:integer;
    Procedure GetMinTGroupNet();{获取最小TGroupNet}
    Var
       Y:integer;
       NetMinIP, NetIP:integer;
       DWxMin,DWx:Dword;
       str_ip:string;       
    begin
       GroupNet:= tGroupNet[x] ;
       IntMin:=x;
       for Y:=x+1 to XCount do
       begin
         case Intindex of
           0:begin //'TP地址'0

                NetMinIP:=inet_addr(PChar(GroupNet.IP)) ;  // 192.168.0.1 ===>01 00 A8 C0
                str_ip:=inttohex(NetMinIP,8);    //01 00 A8 C0
                str_ip:=copy(str_ip,7,2)+copy(str_ip,5,2)+copy(str_ip,3,2)+copy(str_ip,1,2);   //==> C0 A8 00 01
                DWxMin:=strtoint('$'+str_ip);   {转换成为一个长整形数}

                NetIP:=inet_addr(PChar(tGroupNet[y].IP)) ;  // 192.168.0.1 ===>01 00 A8 C0
                str_ip:=inttohex(NetIP,8);    //01 00 A8 C0
                str_ip:=copy(str_ip,7,2)+copy(str_ip,5,2)+copy(str_ip,3,2)+copy(str_ip,1,2);   //==> C0 A8 00 01
                DWx:=strtoint('$'+str_ip);   {转换成为一个长整形数}

                if DWxMin> DWx then
//                if inet_addr(PChar(GroupNet.IP))> inet_addr(PChar(tGroupNet[y].IP)) then
                begin
                  IntMin:=y;
                  GroupNet:=tGroupNet[IntMin];
                end;
             end;
           1:begin //'计算机名称'1
                if GroupNet.ComputerName > tGroupNet[y].ComputerName then
                begin
                  IntMin:=y;
                  GroupNet:=tGroupNet[IntMin];
                end;
             end;
           2:begin //'计算机描述' 2
                if GroupNet.ComputerDes > tGroupNet[y].ComputerDes then
                begin
                  IntMin:=y;
                  GroupNet:=tGroupNet[IntMin];
                end;
             end;
           3:begin //'网络组'3
                if GroupNet.NetGroup > tGroupNet[y].NetGroup then
                begin
                  IntMin:=y;
                  GroupNet:=tGroupNet[IntMin];
                end;
             end;
           4:begin //'网卡MAC码'4
                if GroupNet.NetMacCode > tGroupNet[y].NetMacCode then
                begin
                  IntMin:=y;
                  GroupNet:=tGroupNet[IntMin];
                end;
             end;
         end;{case}
       end;{For}
    end;
    Procedure MakeGrid();{重写Grid}
    Var
      Y:integer;
      StrTp:string;
    begin
       SgDispNetIP.RowCount:=Xcount+2;
       StrTp:='';
       For y:=0 to Xcount do
       begin
         SgDispNetIP.Cells[0,Y+1]:=TGroupNet[y].IP;//'TP地址' ;
         SgDispNetIP.Cells[1,Y+1]:=tGroupNet[y].ComputerName;//'计算机名称' ;
         SgDispNetIP.Cells[2,Y+1]:=tGroupNet[y].ComputerDes;//'计算机描述' ;
         SgDispNetIP.Cells[3,Y+1]:=tGroupNet[y].NetGroup;//'网络组' ;
         SgDispNetIP.Cells[4,Y+1]:=tGroupNet[y].NetMacCode;//'网卡MAC码' ;
         StrTp:=TGroupNet[y].IP + '   ' +tGroupNet[y].ComputerName+ '   ' +
                tGroupNet[y].ComputerDes + '   ' + tGroupNet[y].NetGroup + '   ' +
                tGroupNet[y].NetMacCode;
       end;{for}
    end;
begin
    XCount:=high(TGroupNet);
    if XCount<0 then exit;
    {清除Grid}
    ClearGrid;
    for x:=0 to XCount do
    begin
        GetMinTGroupNet();
        if x<>IntMin then
        begin
           GroupNet:=TGroupNet[x];
           TGroupNet[x]:=TGroupNet[IntMin];
           TGroupNet[IntMin]:=GroupNet;
        end;
    end;{for}
    MakeGrid();{重写Grid}
end;

procedure TFrmSearchNetIp.SgDispNetIPSelectCell(Sender: TObject; ACol,
  ARow: Integer; var CanSelect: Boolean);
begin
    IntGridCol:=ACol;
end;

//高速排序函数（在StringGrid里加上5000行试试就知道它的效率了） 
procedure Quicksort(Grid:TStringGrid; var List:array of integer;
   min, max,sortcol,datatype: Integer);
{List is a list of rownumbers in the grid being sorted}
var
 med_value : integer;
 hi, lo, i : Integer;

 function compare(val1,val2:string):integer;
 var
   int1,int2:integer;
   float1,float2:extended;
   errcode:integer;
 begin
   case datatype of
     0: result:=ANSIComparetext(val1,val2);
     1: begin
          int1:=strtointdef(val1,0);
          int2:=strtointdef(val2,0);
          if int1>int2 then result:=1
          else if int1<int2 then result:=-1
          else result:=0;
        end;

     2: begin
          val(val1,float1,errcode);
          if errcode<>0 then float1:=0;
          val(val2,float2,errcode);
          if errcode<>0 then float2:=0;
          if float1>float2 then result:=1
          else if float1<float2 then result:=-1
          else result:=0;
        end;
      else result:=0;
   end;
end;

begin
 {If the list has <= 1 element, it's sorted}
 if (min >= max) then Exit;
 {Pick a dividing item randomly}
 i := min + Trunc(Random(max - min + 1));
 med_value := List[i];
 List[i] := List[min]; { Swap it to the front so we can find it easily}
 {Move the items smaller than this into the left
  half of the list. Move the others into the right}
 lo := min;
 hi := max;
 while (True) do
 begin
   // Look down from hi for a value < med_value.
   while compare(Grid.cells[sortcol,List[hi]]
                        ,grid.cells[sortcol,med_value])>=0 do
   (*ANSIComparetext(Grid.cells[sortcol,List[hi]]
                        ,grid.cells[sortcol,med_value])>=0 do*)
   begin
       hi := hi - 1;
       if (hi <= lo) then Break;
   end;
   if (hi <= lo) then
   begin {We're done separating the items}
     List[lo] := med_value;
     Break;
   end;

   // Swap the lo and hi values.
   List[lo] := List[hi];
   inc(lo); {Look up from lo for a value >= med_value}
   while Compare(grid.cells[sortcol,List[lo]],
            grid.cells[sortcol,med_value])<0 do
   begin
       inc(lo);
       if (lo >= hi) then break;
   end;
   if (lo >= hi) then
   begin  {We're done separating the items}
     lo := hi;
     List[hi] := med_value;
     break;
   end;
   List[hi] := List[lo];
 end;
 {Sort the two sublists}
 Quicksort(Grid,List, min, lo - 1,sortcol,datatype);
 Quicksort(Grid,List, lo + 1, max,sortcol,datatype);
end;

//datatype 0：按字符排序  1：按整型排序  2：按浮点型排序
procedure Sortgrid(Grid : TStringGrid; sortcol,datatype:integer);
var
  i : integer;
  tempgrid:tstringGrid;
  list:array of integer;
begin
 screen.cursor:=crhourglass;
 tempgrid:=TStringgrid.create(nil);
 with tempgrid do
 begin
   rowcount:=grid.rowcount;
   colcount:=grid.colcount;
   fixedrows:=grid.fixedrows;
 end;
 with Grid do
 begin
   setlength(list,rowcount-fixedrows);
   for i:= fixedrows to rowcount-1 do
   begin
     list[i-fixedrows]:=i;
     tempgrid.rows[i].assign(grid.rows[i]);
   end;
   quicksort(Grid, list,0,rowcount-fixedrows-1,sortcol,datatype);
   for i:=0 to rowcount-fixedrows-1 do
   begin
     rows[i+fixedrows].assign(tempgrid.rows[list[i]])
   end;
   row:=fixedrows;
 end;
 tempgrid.free;
 setlength(list,0);
 screen.cursor:=crdefault;
end;

  //保存为html文件
procedure SaveToHtml(StringGrid:TStringGrid;const FileName : string;const Title : string);
var
 Txt : TextFile;
 i,ii: integer;
 Value:string;
 BgColor:TColor;
 function GetColor(Color: TColor): String;
 var s: String;
 begin
   if Color = clNone then
     s := '000000'
   else
     s := IntToHex(ColorToRGB(Color), 6);
   Result := Copy(s, 5, 2) + Copy(s, 3, 2) + Copy(s, 1, 2);
 end;
begin
 BgColor := clWhite;
 AssignFile(Txt,FileName);
 Rewrite(Txt);
 WriteLn(Txt,'<Title>' + Title + '</Title>');
 WriteLn(Txt,'<TABLE WIDTH=100% border="1" cellpadding="0" cellspacing="0" style="border-collapse: collapse" bordercolor="#111111">');

 for i := 0 to StringGrid.RowCount - 1 do
 begin
   WriteLn(Txt,'<TR>');
   for ii := 0 to StringGrid.ColCount - 1 do
   begin
     Value := StringGrid.Cells[ii,i];
     if Value = '' then Value := '&nbsp;';
     if (ii < StringGrid.FixedCols) or (i < StringGrid.FixedRows) then
       BgColor := StringGrid.FixedColor
     else
       BgColor := StringGrid.Color;
     WriteLn(Txt,'<TD BGCOLOR="#' + GetColor(BgColor) + '"><font color="#' +
       GetColor(StringGrid.Font.Color) + '">' + Value + '</font></TD>')
   end;
   WriteLn(Txt,'</TR>');
 end;
 WriteLn(Txt,'</TABLE>');
 CloseFile(Txt);
end;


procedure TFrmSearchNetIp.SgDispNetIPDblClick(Sender: TObject);
begin
   MakeGrid(IntGridCol);
end;

procedure TFrmSearchNetIp.BitBtn1Click(Sender: TObject);
begin
  SaveToHtml(SgDispNetIP,'1.html','标题');
  ShellExecute(handle,nil,'1.html',nil,nil,SW_SHOWNORMAL); 
end;

procedure TFrmSearchNetIp.SgDispNetIPMouseUp(Sender: TObject;
  Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
var
 c:integer;
 w:integer;
 Grid:TStringGrid;
begin
 Grid := Sender as TStringGrid;
 with Grid do
 if y<=rowheights[0] then
 begin
   c:=0;
   w:=colwidths[0];
   while (c<colcount) and (w<=x) do
   begin
     inc(c);
     w:=w+colwidths[c]+gridlinewidth;
   end;
   sortgrid(Grid,c,0);
  end;
end;

end.