unmain.~pas

来自「用DELPHI写的网卡启动禁用程序」· ~PAS 代码 · 共 678 行 · 第 1/2 页

unit unmain;

interface

uses
  Windows, Messages, ExtCtrls, JvComponentBase, JvTrayIcon, ImgList,
  Controls, ezIni, StdCtrls, ComCtrls, JvExStdCtrls, JvCombobox,
  JvListComb, Classes,  Variants,  Graphics,  Forms,SysUtils,
  Dialogs,   IPExport,IPHlpApi, inifiles,Registry,Common,
  Iprtrmib, IpTypes,IPFunctions, JvProgressBar, JvXPProgressBar, JvgListBox,
  Menus;


type
  TAdIni=class
  public
   Name:string;
   AdapDesc:string;
   end;
 TIP=class
 public
  IP:string;
  Mask:string;
 end;
  TAdapter=class
  public
    Name:string;
    AdapterName:string;
    Description:string;
    IP:string;
    index:integer;
    AdType:integer;
    DhcpEnabled:integer;
    IpAddress:string;
    IpMask:string;
    IpMasklist:TStrings;
    CurrDns:TStrings;
    Dnslist:TStrings;
    Gatewaylist:TStrings;
    destructor Destroy;override;
  end;
  
  TfmNetWorkChange = class(TForm)
    PowerEnter1: TPowerEnter;
    AdapterList: TJvImageComboBox;
    ImageList1: TImageList;
    JvTrayIconApp: TJvTrayIcon;
    Panel1: TPanel;
    GroupBox1: TGroupBox;
    GroupBox2: TGroupBox;
    GroupBox3: TGroupBox;
    Panel2: TPanel;
    GroupBox4: TGroupBox;
    FIpTree: TTreeView;
    btnAddNew: TButton;
    BtnDelIni: TButton;
    BtnAppset: TButton;
    Button5: TButton;
    Memodns: TMemo;
    MemoGateWay: TMemo;
    MemoIPMask: TMemo;
    btnActiveNetAdapter: TButton;
    btnRetry: TButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    N3: TMenuItem;
    NIni: TMenuItem;
    Image1: TImage;
    Image2: TImage;
    Label1: TLabel;
    Label2: TLabel;
    Label3: TLabel;
    Label4: TLabel;
    procedure FormShow(Sender: TObject);
    procedure AdapterListChange(Sender: TObject);
    procedure btnAddNewClick(Sender: TObject);
    procedure BtnAppsetClick(Sender: TObject);
    procedure BtnDelIniClick(Sender: TObject);
    procedure btnActiveNetAdapterClick(Sender: TObject);
    procedure btnRetryClick(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure N3Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);
  private
    procedure ItemClick(sender:TObject);
    procedure GetApt;{ Private declarations }
    procedure IniMenuItem;
    procedure Check(AMenuItem:TMenuItem;AList:TJvImageComboBox);
  public
     { Public declarations }
    procedure WriteIniToFile(Name,AdapterName,desc,IP,mask,gateway,dns1,dns2:string);
    function GetAdapterName(Adapter:TAdapter):string;
    procedure ReadIniDataToTreeView(AdapterName:string);
  end;
  

    
var
  fmNetWorkChange: TfmNetWorkChange;
  


implementation

uses Addnew, flashfm, StdConvs, DeviceForm;

{$R *.dfm}

{ TForm1 }
Procedure WinExecAndWait(CommandLine:String);
var ComLineBuffer: array[0..512] of char;
    StartupInfo: TStartupInfo;
    ProcessInfo: TProcessInformation;
    Re:Cardinal;
begin
  StrPCopy(ComLineBuffer,CommandLine);
  FillChar(StartupInfo, Sizeof(StartupInfo), #0);
  StartupInfo.cb := Sizeof(StartupInfo);
  StartupInfo.dwFlags := STARTF_USESHOWWINDOW;
  StartupInfo.wShowWindow := SW_HIDE;
  if CreateProcess(nil,
                   ComLineBuffer,          { pointer to command line string }
                   nil,                    { pointer to process security attributes }
                   nil,                    { pointer to thread security attributes }
                   True,                   { handle inheritance flag }
                   CREATE_NEW_CONSOLE or   { creation flags }
                   NORMAL_PRIORITY_CLASS,
                   nil,                    { pointer to new environment block }
                   nil,                    { pointer to current directory name, PChar}
                   StartupInfo,            { pointer to STARTUPINFO }
                   ProcessInfo)            { pointer to PROCESS_INF }
     then
  begin
    WaitforSingleObject(ProcessInfo.hProcess, INFINITE);
    GetExitCodeProcess(ProcessInfo.hProcess, Re);
    CloseHandle(ProcessInfo.hProcess);  { to prevent memory leaks }
    CloseHandle(ProcessInfo.hThread);
  end;
end;

procedure TfmNetWorkChange.GetApt;
var
  PAdapter, PMem: PipAdapterInfo;
  PIPAddr: PIpAddrString;
  OutBufLen, OutBufLen2: ULONG;
  pPerAdapter:PIpPerAdapterInfo;
  FAdp:TAdapter;
  s:string;
  i:integer;
  FIp:TIP;
begin
    for i:=0 to AdapterList.Items.Count-1 do TAdapter(AdapterList.Items.Objects[i]).Free;
    AdapterList.Items.Clear;
     try
    VVGetAdaptersInfo(PAdapter,OutBufLen);

    PMem:=PAdapter;

    try
    while PAdapter<>nil do
     with AdapterList do
    begin

       FAdp:=TAdapter.Create;
       FAdp.AdapterName:=PAdapter.AdapterName;
       FAdp.Name:=GetAdapterName(FAdp);
       FAdp.Description:=padapter.Description;
       s:='';
       for i:=0 to PAdapter.AddressLength do  s:=s+Format('%1d', [PAdapter.Address[i]]);
       FAdp.index:=padapter.Index;
       FAdp.AdType:=padapter.Type_;
       FAdp.DhcpEnabled:=padapter.DhcpEnabled;
       if PAdapter.CurrentIpAddress <> nil then
       begin
       FAdp.IpAddress:=padapter.currentIPAddress.IpAddress.S;
       FAdp.IpMask:=padapter.currentIPAddress.IpMask.S;
       end else
       begin
       FAdp.IpAddress:='';
       FAdp.IpMask:='';
       end;
       //IP地址列表
       PIPAddr:=@Padapter.IpAddressList;
       FAdp.IpMasklist:=TStringList.Create;
        repeat
         begin
         FIp:=TIP.Create;
         FIp.IP:=PIPAddr.IpAddress.S;
         FIp.Mask:=PIPAddr.IpMask.S;
         FAdp.IpMasklist.AddObject(FIp.IP+'|'+FIp.Mask,Fip);
         PIPAddr:=PIPAddr.Next;
         end;
        until PIPAddr=nil;
        //DNS列表
        PIPAddr:=@padapter.GatewayList;
        FAdp.Gatewaylist:=TStringList.Create;
        repeat
         begin
          FIp:=TIP.Create;
          Fip.IP:=PIPAddr.IpAddress.S;
          FAdp.Gatewaylist.AddObject(FIP.IP,fip);
          PIPAddr:=PIPAddr.Next;
         end;
         until PIPAddr=nil;
//        Items.AddObject(FAdp.Description+FAdp.IpAddress,FAdp);

        try
         VVGetPerAdapterInfo(padapter.Index,pPerAdapter,OutBufLen2);
         //
         if pPerAdapter<>nil then
         begin
         try
          PIPaddr:=@pPerAdapter.CurrentDnsServer;
          FAdp.CurrDns:=TStringList.Create;
          while Assigned(PIPAddr) do
              begin
                FIp:=TIP.Create;
                FIP.IP:=PIPAddr^.IpAddress.S;
                FIP.mask := PIPAddr^.IpMask.S;
                FAdp.CurrDns.AddObject(FIP.IP,FIP);
                PIPAddr := PIPAddr.Next;
              end;
           PIPAddr := @pPerAdapter.DnsServerList;
           FAdp.Dnslist:=TStringList.Create;
              while Assigned(PIPAddr) do
              begin
                FIp:=TIP.Create;
                FIP.IP:=PIPAddr^.IpAddress.S;
                FIP.mask := PIPAddr^.IpMask.S;
                FAdp.Dnslist.AddObject(FIP.IP,FIP);
                PIPAddr := PIPAddr.Next;
              end;
         finally
           Freemem(pPerAdapter,OutBufLen2);
         end;
         end
        finally
        end;

        Items.AddObject(FAdp.Name+'---'+FAdp.Description,FAdp);
        PAdapter:=PAdapter.Next;


        end;
    finally
      if PAdapter <> nil then
      Freemem(PMem, OutBufLen);
    end;
    Except on  E:EIpHlpError do
            ShowMessage('网卡没有启用');
            end;
end;

procedure TfmNetWorkChange.FormShow(Sender: TObject);
var
 i:integer;
begin
   GetApt;
  for i:=0 to  AdapterList.Items.Count-1 do AdapterList.items[i].ImageIndex:=0;
end;

procedure TfmNetWorkChange.AdapterListChange(Sender: TObject);
var
 i:integer;
begin

if AdapterList.ItemIndex<0 then exit;
  MemoIPMask.Lines.Clear;
  Memodns.Lines.Clear;
  MemoGateWay.Lines.Clear;
   MemoIPMask.Lines.Add('  IP地址    | 掩码 ');
   for i:=0 to TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).IpMasklist.Count-1 do
   begin
      MemoIPMask.Lines.Add(TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).IpMasklist.Strings[i]);
   end;
   //Memodns.Lines.Add('  IP地址 ');
   for i:=0 to TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Dnslist.Count-1 do
   begin
     Memodns.Lines.Add(TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Dnslist.Strings[i]);
   end;
 //  MemoGateWay.Lines.Add('  IP地址 ');
    for i:=0 to TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Gatewaylist.Count-1 do
   begin
     MemoGateWay.Lines.Add(TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Gatewaylist.Strings[i]);
   end;

   ReadIniDataToTreeView(TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Name);
 //ShowMessage(TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).AdapterName);
end;

procedure TfmNetWorkChange.WriteIniToFile(Name,AdapterName,desc,IP, mask, gateway, dns1, dns2: string);
var
 ifile:TIniFile;
 FName:string;
 fhand:integer;
 F:TextFile;
begin
   FName:=ExtractFilePath(Application.ExeName)+'net.ini';
   if not FileExists(FName) then begin
   fhand:=FileCreate(FName);

   CloseHandle(fhand);
   end;
   AssignFile(f,fname);
   Append(f);
  if Name<>'' then Writeln(f,'['+Name+']');
  if AdapterName<>'' then Writeln(f,'Name='+AdapterName);
  if Desc<>'' then Writeln(f,'Desc='+Desc);
  if IP<>'' then Writeln(f,'IP='+IP);
  if mask<>'' then writeln(f,'Mask='+Mask);
  if gateway<>'' then Writeln(f,'GateWay='+gateway);
  if dns1<>'' then Writeln(f,'Dns1='+dns1);
  if dns2<>'' then Writeln(f,'Dns2='+dns2);
   CloseFile(f);

end;

procedure TfmNetWorkChange.btnAddNewClick(Sender: TObject);
begin
 if fmAddNew=nil then fmAddNew:=TfmAddNew.Create(Application);
 fmAddNew.EditApaterName.Text:=TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Name;
 if fmAddNew.ShowModal=mrOk then
 begin
 WriteIniToFile(fmAddNew.edtIniName.Text,fmAddNew.EditApaterName.Text,TAdapter(AdapterList.Items.Objects[AdapterList.ItemIndex]).Description,
                fmAddNew.edtIP.Text,fmAddNew.edtMask.Text,
                fmAddNew.edtGateWay.Text,
                fmAddNew.EdtDns1.Text,
                fmAddNew.edtDns2.Text);
 ReadIniDataToTreeView(fmAddNew.EditApaterName.Text);
 end;
end;

function TfmNetWorkChange.GetAdapterName(Adapter: TAdapter): string;
var
 Rg:TRegistry;
begin