regunit.pas

DELPHI 下远程控制源码

  RegEditFm.ShowModal;
  if RegEditFm.Tag=100 then
  begin  
   try         
      RegTCPClient.WriteLn('注册表');
      RegTCPClient.WriteLn('注册表值修改'); //发送注册表操作的命令
      RegTCPClient.WriteLn(TheRoot);        //发送根目录名
      RegTCPClient.WriteLn(TheKey);         //发送键名
      RegTCPClient.WriteLn(TheVLI.Caption); //发送值名
      RegTCPClient.WriteLn(RegEditFm.Edit2.Text);//发送新值
      RegTCPClient.WriteLn(TheVLI.SubItems[0]); //发送键值名类型
      
      EchoStr:=RegTCPClient.ReadLn(EOL);  //=============读取信息反馈
      
   except
       Beep;
       SpeedButton2.Down:=True;
       RegTCPClient.Disconnect;
       StatusBar1.Panels[0].Text:='网络断开！';
       StatusBar1.Panels[1].Text:='数据传输错误，网络已经断开！';        
       exit;
   end;     
    Application.MessageBox(PChar(EchoStr),'远程反馈',
                                        MB_OK+MB_ICONINFORMATION);
  end;   
end;
procedure TRegFm.GetRemoteSubNode(TheTV:TTreeView;TheNode:TTreeNode;
                               TheLV:TListView; TheRoot,TheKey:String);
var
    TheNamesSize  :integer;
    TheValuesSize :integer;
    TheNames      :TStringList;
    TheValues     :TStringLIst;
    i,j           :integer;
    TheAddNode    :TTreeNode;
    TheListItem   :TListItem;
begin
   try
      RegTCPClient.WriteLn('注册表');
      RegTCPClient.WriteLn('注册表查询'); //发送注册表操作的命令
      RegTCPClient.WriteLn(TheRoot);    //发送查询根目录名
      RegTCPClient.WriteLn(TheKey);     //发送查询键名
   except
       Beep;
       SpeedButton2.Down:=True;
       RegTCPClient.Disconnect;
       StatusBar1.Panels[0].Text:='网络断开！';
       StatusBar1.Panels[1].Text:='数据传输错误，网络已经断开！';
       exit;
   end;
    StatusBar1.Panels[1].Text:='正在接收数据..';
   try
     TheNames:=TStringList.Create;
     TheValues:=TStringlist.Create;
   except
       Beep;
       SpeedButton2.Down:=True;
       RegTCPClient.Disconnect;
       StatusBar1.Panels[0].Text:='内存不足！';
       StatusBar1.Panels[1].Text:='请重新启动机器后操作，网络已经断开！';
       exit;
   end;
   try
       TheNamesSize :=RegTCPClient.ReadInteger; //读去返回的键名列表
       TheNames.Text:=RegTCPClient.ReadString(TheNamesSize);
       StatusBar1.Panels[1].Text:='正在接收数据... .';
       TheValuesSize:=RegTCPClient.ReadInteger; //读去返回的键值列表
       TheValues.Text:=RegTCPClient.ReadString(TheValuesSize);
   except
       Beep;
       TheNames.Free;
       TheValues.Free;
       SpeedButton2.Down:=True;
       RegTCPClient.Disconnect;
       StatusBar1.Panels[0].Text:='网络断开！';
       StatusBar1.Panels[1].Text:='数据传输错误，网络已经断开！';
       exit;
   end;
       
    StatusBar1.Panels[1].Text:='正在接收数据... .. .';
    TheNode.DeleteChildren;
    StatusBar1.Panels[1].Text:='正在分析数据..';
    for i:=0 to TheNames.Count-1 do  //读取键名列表
    begin
        TheAddNode:=TheTV.Items.AddChild(TheNode,TheNames[i]);
        TheAddNode.ImageIndex   :=2;
        TheAddNode.SelectedIndex:=3;
    end; 
    TheLV.Items.Clear;
    j:=0;
    StatusBar1.Panels[1].Text:='正在分析数据... .. .';
    For i:=0 to TheValues.Count-1 do 
    begin
       j:=j+1;
       if j=1 then
              begin
                 TheListItem:=TheLV.Items.Add;
                 if TheValues[i]='' then 
                      TheListItem.Caption:='(默认)' else
                        TheListItem.Caption:=TheValues[i];
              end;
       if j=2 then
              begin
                 TheListItem.SubItems.Add(TheValues[i]);
                 if TheValues[i]='REG_DWORD' then
                   begin                     
                      TheListItem.ImageIndex:=5;
                      TheListItem.StateIndex:=5;
                   end else
                   if TheValues[i]='REG_BINARY' then
                   begin
                      TheListItem.ImageIndex:=5;
                      TheListItem.StateIndex:=5;
                   end else
                    begin
                       TheListItem.ImageIndex:=4;
                       TheListItem.StateIndex:=4;
                    end;                                  
              end;
       if j=3 then       
              begin
                  TheListItem.SubItems.Add(TheValues[i]);
                  j:=0;  
              end;           
    end;
         
    TheNames.Free;
    TheValues.Free;
end;
procedure TRegFm.DoBinaryValueCreate(TheRoot,TheKey:String);
var
   Reg          : TRegistry; 
   TheNewName   : String;
   TheBuffer    : array[1..1024] of byte;   
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, False) then //打开键
    begin
       TheNewName:=InputBox('请输入二进制值名：','新建名称：    ','新值名#3');
       Reg.WriteBinaryData(TheNewName,TheBuffer,Sizeof(TheBuffer));
       Reg.CloseKey;
    end;
  finally      
     Reg.Free;
  end;
end;
procedure TRegFm.DoDWordValueCreate(TheRoot,TheKey:String);
var
   Reg          : TRegistry; 
   TheNewName   : String;   
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, False) then //打开键
    begin
       TheNewName:=InputBox('请输入双字节值名：','新建名称：    ','新值名#2');
       Reg.WriteInteger(TheNewName,0);
       Reg.CloseKey;
    end;
  finally      
     Reg.Free;
  end;
end;
procedure TRegFm.DoStringValueCreate(TheRoot,TheKey:String);
var
   Reg          : TRegistry; 
   TheNewName   : String;   
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, False) then //打开键
    begin
       TheNewName:=InputBox('请输入新字符串值名：','新建名称：  ','新值名#1');
       Reg.WriteString(TheNewName,'---尚未赋值---');
       Reg.CloseKey;
    end;
  finally      
     Reg.Free;
  end;
end;
procedure TRegFm.DoNameCreate(TheRoot,TheKey:String);
var
   Reg          : TRegistry;
   TheNewName   : String;    
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;

    TheNewName:=InputBox('请输入新键名：','新键键名：  ','新键名#0');
    Reg.Access:=KEY_ALL_ACCESS;
    if Not Reg.OpenKey(TheKey+'\'+TheNewName,false) then
    if Reg.CreateKey(TheKey+'\'+TheNewName) then
      StatusBar2.Panels[1].Text:='新建键名成功。' else
              StatusBar2.Panels[1].Text:='新建键名失败！！！';
    Reg.CloseKey;
  finally      
     Reg.Free;
  end;                                                    
end;  
procedure TRegFm.DoNameRename(TheRoot,TheKey,TheName:String);
var
   Reg          : TRegistry;
   TheNewName   : String;    
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;

    TheNewName:=InputBox('请输入新名：','键名改为',TheKey);
    Reg.Access:=KEY_ALL_ACCESS;
    Reg.MoveKey(TheKey,TheNewName,True);

  finally      
     Reg.Free;
  end;
end;  
procedure TRegFm.DoNameDelete(TheRoot,TheKey:String);
var
   Reg          : TRegistry;    
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, False) then //打开键
    begin
       if Reg.DeleteKey(TheKey) then
       StatusBar2.Panels[1].Text:='成功删除！' else
              StatusBar2.Panels[1].Text:='删除失败！';
       Reg.CloseKey;
    end;
  finally      
     Reg.Free;
  end;
end;  
procedure TRegFm.DoValueRename(TheRoot,TheKey,TheValues:String);
var
   Reg          : TRegistry; 
   TheNewName   : String;   
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, False) then //打开键
    begin
       TheNewName:=InputBox('请输入新名：','键值改名',TheValues);
       Reg.RenameValue(TheValues,TheNewName); 
       Reg.CloseKey;
    end;
  finally      
     Reg.Free;
  end;
end;
procedure TRegFm.DoValueDelete(TheRoot,TheKey,TheValues:String);
var
   Reg          : TRegistry;    
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, False) then //打开键
    begin
       Reg.Access:=KEY_ALL_ACCESS;
       if Reg.DeleteValue(TheValues) then
       StatusBar2.Panels[1].Text:='成功删除！' else
         StatusBar2.Panels[1].Text:='删除失败！';
       Reg.CloseKey;
    end;
  finally      
     Reg.Free;
  end;
end;
procedure TRegFm.DoValueModify(TheRoot,TheKey,TheValues:String);
var
   Reg          : TRegistry;
   TheValueInfo :TRegDataInfo;
begin
  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, True) then //打开键
    begin
       if TheValues='(默认)' then 
       begin
          RegEditFm.Edit1.Text:=TheValues;
          RegEditFm.Edit2.Text:=Reg.ReadString('');
          RegEditFm.Tag:=0;
          RegEditFm.Caption:='编辑默认值';
          RegEditFm.ShowModal;
          if RegEditFm.Tag=100 then
          begin           
            Reg.WriteString('',RegEditFm.Edit2.Text);            
          end;
          Reg.CloseKey;
          exit;
       end;
       
       Reg.GetDataInfo(TheValues,TheValueInfo);
       
       if TheValueInfo.RegData=rdString then
       begin
          RegEditFm.Edit1.Text:=TheValues;
          RegEditFm.Edit2.Text:=Reg.ReadString(TheValues);
          RegEditFm.Tag:=0;
          RegEditFm.Caption:='编辑字符串值';
          RegEditFm.ShowModal;
          if RegEditFm.Tag=100 then
          begin
            Reg.WriteString(TheValues,RegEditFm.Edit2.Text);             
          end; 
          Reg.CloseKey; 
          exit;           
       end;
       if TheValueInfo.RegData=rdExpandString then
       begin
          RegEditFm.Edit1.Text:=TheValues;
          RegEditFm.Edit2.Text:=Reg.ReadString(TheValues);
          RegEditFm.Tag:=0;
          RegEditFm.Caption:='编辑字符串值';
          RegEditFm.ShowModal;
          if RegEditFm.Tag=100 then
          begin
            Reg.WriteString(TheValues,RegEditFm.Edit2.Text);             
          end; 
          Reg.CloseKey; 
          exit;             
       end;
       if TheValueInfo.RegData=rdInteger then
       begin
          RegEditFm.Edit1.Text:=TheValues;
          RegEditFm.Edit2.Text:=IntToStr(Reg.ReadInteger(TheValues));
          RegEditFm.Tag:=0;
          RegEditFm.Caption:='编辑双字节值';
          RegEditFm.ShowModal;
          if RegEditFm.Tag=100 then
          begin
            Reg.WriteInteger(TheValues,StrToInt(RegEditFm.Edit2.Text));             
          end;
          Reg.CloseKey; 
          exit;              
       end;
    end;
  finally      
     Reg.Free;
  end;
end;
procedure TRegFm.GetSubTreeNode(TheTV:TTreeView;TheNode:TTreeNode;
                             TheLV:TListView; TheRoot,TheKey:String);
var
  Reg        : TRegistry;
  TheKeyNames: TStringList;
  TheNameValues:TStringList;
  TheNewNode  : TTreeNode;
  TheNewItem : TListItem;
  TheValueInfo:TRegDataInfo;
  i: integer;
begin
  TheKeyNames:=TStringList.Create;
  TheNameValues:=TStringList.Create;

  Reg := TRegistry.Create;
  try //设置根路径
    if TheRoot='HKEY_CLASSES_ROOT' then Reg.RootKey:=HKEY_CLASSES_ROOT;
    if TheRoot='HKEY_CURRENT_USER' then Reg.RootKey:=HKEY_CURRENT_USER;
    if TheRoot='HKEY_LOCAL_MACHINE' then Reg.RootKey:=HKEY_LOCAL_MACHINE;
    if TheRoot='HKEY_USERS' then Reg.RootKey:=HKEY_USERS;
    if TheRoot='HKEY_CURRENT_CONFIG' then Reg.RootKey:=HKEY_CURRENT_CONFIG;
    
    if Reg.OpenKey(TheKey, True) then //打开键
    begin
       Reg.GetKeyNames(TheKeyNames);  //读取键名列表
       TheNode.DeleteChildren;         
       For i:=0 To TheKeyNames.Count-1 do
       begin
           StatusBar2.Panels[0].Text:='转换数据:'
                                 +IntToStr((i+1)*100 div TheKeyNames.Count)+'%';
           StatusBar2.Update;
           TheNewNode:=TheTV.Items.AddChild(TheNode,TheKeyNames[i]);
           TheNewNode.ImageIndex:=2;
           TheNewNode.SelectedIndex:=3;
       end;
       Reg.GetValueNames(TheNameValues); //读取键值列表
       TheLV.Clear;
       //================================
         TheNewItem:=TheLV.Items.Add;