home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: SysTools / SysTools.zip / regedt16.zip / REGEDITR.PAS < prev    next >
Pascal/Delphi Source File  |  1998-11-10  |  11KB  |  410 lines
  1. unit Regeditr;
  2.  
  3. interface
  4.  
  5. uses
  6.   SysUtils, WinTypes, WinProcs, Messages, Classes, Graphics, Controls,
  7.   Forms, Dialogs, Grids, Outline, Tabs, ShellAPI, StdCtrls, ExtCtrls, Menus;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     TabSet1: TTabSet;
  12.     Outline1: TOutline;
  13.     Panel1: TPanel;
  14.     EditPath: TEdit;
  15.     EditVal: TEdit;
  16.     Label1: TLabel;
  17.     Label2: TLabel;
  18.     MainMenu1: TMainMenu;
  19.     Edit1: TMenuItem;
  20.     Search1: TMenuItem;
  21.     Addkey1: TMenuItem;
  22.     Deletekey1: TMenuItem;
  23.     Findtext1: TMenuItem;
  24.     FindNext1: TMenuItem;
  25.     N1: TMenuItem;
  26.     Exit1: TMenuItem;
  27.     FindDialog1: TFindDialog;
  28.     Expandall1: TMenuItem;
  29.     View1: TMenuItem;
  30.     Rescan1: TMenuItem;
  31.     PopupMenu1: TPopupMenu;
  32.     Addkey2: TMenuItem;
  33.     Deletekey2: TMenuItem;
  34.     N2: TMenuItem;
  35.     Find1: TMenuItem;
  36.     Findnext2: TMenuItem;
  37.     N3: TMenuItem;
  38.     Rescan2: TMenuItem;
  39.     Expandall2: TMenuItem;
  40.     Saveas1: TMenuItem;
  41.     SaveDialog1: TSaveDialog;
  42.     Saveas2: TMenuItem;
  43.     procedure TabSet1Change(Sender: TObject; NewTab: Integer;
  44.       var AllowChange: Boolean);
  45.     procedure Panel1Resize(Sender: TObject);
  46.     procedure FormCreate(Sender: TObject);
  47.     procedure Outline1Click(Sender: TObject);
  48.     procedure Findtext1Click(Sender: TObject);
  49.     procedure FindDialog1Find(Sender: TObject);
  50.     procedure Deletekey1Click(Sender: TObject);
  51.     procedure FormClose(Sender: TObject; var Action: TCloseAction);
  52.     procedure Exit1Click(Sender: TObject);
  53.     procedure Addkey1Click(Sender: TObject);
  54.     procedure Outline1KeyUp(Sender: TObject; var Key: Word;
  55.       Shift: TShiftState);
  56.     procedure Expandall1Click(Sender: TObject);
  57.     procedure Rescan1Click(Sender: TObject);
  58.     procedure Saveas1Click(Sender: TObject);
  59.   private
  60.     { Private declarations }
  61.   public
  62.     { Public declarations }
  63.     MainKey: HKEY;
  64.     DataIndex : longint;
  65.     InitDelta : integer;
  66.     procedure UpdateDisplay;
  67.     procedure FlushChanges;
  68.   end;
  69.  
  70. var
  71.   Form1: TForm1;
  72.  
  73. implementation
  74.  
  75. {$R *.DFM}
  76.  
  77. uses NewKey;
  78.  
  79. const
  80.   clases : array[0..4] of HKEY =
  81.   (1,$80000000,$80000001,$80000002,$80000003);
  82.   clsname : array[0..4] of PChar = ('HKEY_CLASSES_ROOT',
  83.   'HKEY_CLASSES_ROOT','HKEY_CURRENT_USER','HKEY_LOCAL_MACHINE','HKEY_USERS');
  84. var
  85.   curname : PChar;
  86.  
  87. procedure TForm1.TabSet1Change(Sender: TObject; NewTab: Integer;
  88.   var AllowChange: Boolean);
  89. begin
  90.   FlushChanges;
  91.   MainKey:=clases[NewTab];
  92.   curname:=clsname[NewTab];
  93.   UpdateDisplay;
  94. end;
  95.  
  96. procedure TForm1.UpdateDisplay;
  97.  
  98.   procedure LoadEntries(key : HKEY; idx : longint);
  99.   var
  100.     i,l : longint;
  101.     buf : array[0..127] of char;
  102.     str : string;
  103.     nkey : HKEY;
  104.   begin
  105.     i:=0;
  106.     while RegEnumKey(key,i,buf,sizeof(buf)-1) = ERROR_SUCCESS do begin
  107.       if RegOpenKey(key,buf,nkey) = ERROR_SUCCESS then begin
  108.         str:=StrPas(buf);
  109.         l:=sizeof(buf);
  110.         if (RegQueryValue(nkey,NIL,buf,l) = ERROR_SUCCESS) and (buf[0] <> #0) then
  111.           str:=str+' = '+StrPas(buf);
  112.         LoadEntries(nkey,Outline1.AddChild(idx,str));
  113.         RegCloseKey(nkey);
  114.       end;
  115.       inc(i);
  116.     end;
  117.   end;
  118.  
  119. var
  120.   cr : HCursor;
  121. begin
  122.   cr:=SetCursor(LoadCursor(0,IDC_WAIT));
  123.   Outline1.BeginUpdate;
  124.   Outline1.Clear;
  125.   Outline1.AddChild(0,'');
  126.   LoadEntries(MainKey,0);
  127.   Outline1.EndUpdate;
  128.   SetCursor(cr);
  129. end;
  130.  
  131. procedure TForm1.FlushChanges;
  132. var
  133.   buf1,buf2 : array[byte] of char;
  134.   str : string;
  135.   i : integer;
  136. begin
  137.   if EditVal.Modified then begin
  138.     StrPCopy(buf1,EditPath.Text);
  139.     StrPCopy(buf2,EditVal.Text);
  140.     if RegSetValue(MainKey,buf1+1,REG_SZ,buf2,StrLen(buf2)) <> ERROR_SUCCESS then MessageBeep(MB_ICONHAND)
  141.     else with Outline1 do begin
  142.       str:=Items[DataIndex].Text;
  143.       i:=Pos(' ',str);
  144.       if i <> 0 then System.Delete(str,i,255);
  145.       if EditVal.Text <> '' then str:=str+' = '+EditVal.Text;
  146.       Items[DataIndex].Text:=str;
  147.     end;
  148.   end;
  149.   EditVal.Modified:=FALSE;
  150. end;
  151.  
  152. procedure TForm1.Panel1Resize(Sender: TObject);
  153. begin
  154.   EditPath.Width:=Panel1.Width-InitDelta;
  155.   EditVal.Width:=EditPath.Width;
  156. end;
  157.  
  158. procedure TForm1.FormCreate(Sender: TObject);
  159. begin
  160.   InitDelta:=Panel1.Width-EditPath.Width;
  161.   DataIndex:=0;
  162.   EditVal.Modified:=FALSE;
  163.   MainKey:=clases[TabSet1.TabIndex];
  164.   curname:=clsname[TabSet1.TabIndex];
  165.   UpdateDisplay;
  166. end;
  167.  
  168. procedure TForm1.Outline1Click(Sender: TObject);
  169. var
  170.   onode : TOutlineNode;
  171.   fpath,node : string;
  172.   buf : array[byte] of char;
  173.   key : HKEY;
  174.   buflen : longint;
  175.   i : integer;
  176. begin
  177.   FlushChanges;
  178.   DataIndex:=Outline1.SelectedItem;
  179.   onode:=Outline1.Items[DataIndex];
  180.   fpath:='';
  181.   while Assigned(onode) do begin
  182.     node:=onode.Text;
  183.     if node <> '' then begin
  184.       i:=Pos(' ',node); if i <> 0 then Delete(node,i,255);
  185.       fpath:='\'+node+fpath;
  186.     end;
  187.     onode:=onode.Parent;
  188.   end;
  189.   StrPCopy(buf,fpath);
  190.   if fpath <> '' then begin
  191.     buflen:=sizeof(buf);
  192.     if RegQueryValue(MainKey,buf+1,buf,buflen) <> ERROR_SUCCESS then buf[0]:=#0;
  193.   end
  194.   else fpath:='\';
  195.   EditPath.Text:=fpath;
  196.   EditVal.Text:=StrPas(buf); EditVal.Modified:=FALSE;
  197. end;
  198.  
  199. procedure TForm1.Findtext1Click(Sender: TObject);
  200. begin
  201.   FindDialog1.Execute;
  202. end;
  203.  
  204. procedure TForm1.FindDialog1Find(Sender: TObject);
  205.  
  206.   procedure ExpandAll(onode : TOutlineNode);
  207.  
  208.   begin
  209.     with onode do if (parent <> NIL) and not parent.Expanded then
  210.       ExpandAll(parent);
  211.     onode.Expand;
  212.   end;
  213.  
  214. var
  215.   i : longint;
  216.   p : integer;
  217.   cr : HCursor;
  218.   str1,str2 : string;
  219. begin
  220.   with FindDialog1 do if FindText <> '' then with Outline1 do begin
  221.     cr:=SetCursor(LoadCursor(0,IDC_WAIT));
  222.     str1:=FindText; if not (frMatchCase in FindDialog1.Options) then str1:=UpperCase(str1);
  223.     i:=SelectedItem;
  224.     repeat
  225.       if frDown in FindDialog1.Options then begin
  226.         inc(i);
  227.         if i > ItemCount then i:=1;
  228.       end
  229.       else begin
  230.         dec(i);
  231.         if i < 1 then i:=ItemCount;
  232.       end;
  233.       str2:=Items[i].Text; if not (frMatchCase in FindDialog1.Options) then str2:=UpperCase(str2);
  234.       if frWholeWord in FindDialog1.Options then begin
  235.         p:=Pos(' = ',str2);
  236.         if p <> 0 then begin
  237.           if str1 = Copy(str2,1,p-1) then break;
  238.           System.Delete(str2,1,p+2);
  239.         end;
  240.         if str1=str2 then break;
  241.       end
  242.       else if Pos(str1,str2) <> 0 then break;
  243.     until i = SelectedItem;
  244.     SetCursor(cr);
  245.     if i <> SelectedItem then begin
  246.       ExpandAll(Items[i]);
  247.       SelectedItem:=i;
  248.       Outline1Click(self);
  249.     end
  250.     else MessageDlg('Cannot find'^J+FindText,mtWarning,[mbOK],0);
  251.   end;
  252. end;
  253.  
  254. procedure TForm1.Deletekey1Click(Sender: TObject);
  255. var
  256.   fpath : string;
  257.   buf : array[byte] of char;
  258.   key : HKEY;
  259.   rv : longint;
  260. begin
  261.   key:=MainKey;
  262.   fpath:=EditPath.Text; if Length(fpath) < 2 then Exit;
  263.   Delete(fpath,1,1);
  264.   if MessageDlg('Are you SURE you want to delete'^J+fpath+^J'and all it''s childs ?',
  265.     mtConfirmation,mbOkCancel,0) <> mrOk then Exit;
  266.   StrPCopy(buf,fpath);
  267.   rv:=RegDeleteKey(key,buf);
  268.   if rv = ERROR_SUCCESS then begin
  269.     EditVal.Modified:=FALSE;
  270.     with Outline1 do Delete(SelectedItem);
  271.     Outline1Click(self);
  272.   end
  273.   else MessageBeep(MB_ICONHAND);
  274. end;
  275.  
  276. procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
  277. begin
  278.   FlushChanges;
  279.   FindDialog1.CloseDialog;
  280. end;
  281.  
  282. procedure TForm1.Exit1Click(Sender: TObject);
  283. begin
  284.   Close;
  285. end;
  286.  
  287. procedure TForm1.Addkey1Click(Sender: TObject);
  288. var
  289.   buf : array[byte] of char;
  290.   str : string;
  291.   i : integer;
  292.   nkey : HKEY;
  293. begin
  294.   FlushChanges;
  295.   if NewKeyDlg.ShowModal = mrOK then begin
  296.     str:=NewKeyDlg.Edit1.Text;
  297.     if str = '' then Exit;
  298.     if str[1] = '\' then Delete(str,1,1);
  299.     StrPCopy(buf,str);
  300.     if RegCreateKey(MainKey,buf,nkey) = ERROR_SUCCESS then begin
  301.       StrPCopy(buf,NewKeyDlg.Edit2.Text);
  302.       if RegSetValue(nkey,NIL,REG_SZ,buf,StrLen(buf)) <> ERROR_SUCCESS then MessageBeep(MB_ICONHAND);
  303.       RegCloseKey(nkey);
  304.       UpdateDisplay;
  305.     end
  306.     else MessageBeep(MB_ICONHAND);
  307.   end;
  308. end;
  309.  
  310. procedure TForm1.Outline1KeyUp(Sender: TObject; var Key: Word;
  311.   Shift: TShiftState);
  312. begin
  313.   if Shift = [] then case Key of
  314.     VK_INSERT : Addkey1Click(self);
  315.     VK_DELETE : Deletekey1Click(self);
  316.   end;
  317. end;
  318.  
  319. procedure TForm1.Expandall1Click(Sender: TObject);
  320. var
  321.   cr : HCursor;
  322. begin
  323.   cr:=SetCursor(LoadCursor(0,IDC_WAIT));
  324.   Outline1.FullExpand;
  325.   SetCursor(cr);
  326. end;
  327.  
  328. procedure TForm1.Rescan1Click(Sender: TObject);
  329. begin
  330.   UpdateDisplay;
  331. end;
  332.  
  333. {$I-}
  334.  
  335. procedure TForm1.Saveas1Click(Sender: TObject);
  336. var
  337.   f : System.text;
  338.   value,tmps : string;
  339.   npath,node : string;
  340.   onode : TOutlineNode;
  341.   i : integer;
  342.   l : longint;
  343.   cr : HCursor;
  344.  
  345.   procedure SaveTree(base : string; idx : longint);
  346.   var
  347.     child : longint;
  348.     j : integer;
  349.   begin
  350.     with Outline1 do if idx > 0 then begin
  351.       value:=Items[idx].Text;
  352.       i:=Pos(' = ',value); if i = 0 then i:=256;
  353.       if MainKey = clases[0] then Writeln(f,curname,base,'\',value)
  354.       else begin
  355.         Writeln(f,'[',curname,base,'\',Copy(value,1,i-1),']');
  356.         if i <= 255 then begin
  357.           tmps:='';
  358.           for j:=i+3 to Length(value) do begin
  359.             if value[j] in ['\','"'] then tmps:=tmps+'\';
  360.             tmps:=tmps+value[j];
  361.           end;
  362.           Writeln(f,'@="',tmps,'"');
  363.         end;
  364.         Writeln(f);
  365.       end;
  366.       if Items[idx].HasItems then begin
  367.         System.Delete(value,i,255);
  368.         base:=base+'\'+value;
  369.         child:=Items[idx].GetFirstChild;
  370.         while child > 0 do begin
  371.           SaveTree(base,child);
  372.           child:=Items[idx].GetNextChild(child);
  373.         end;
  374.       end;
  375.     end;
  376.   end;
  377.  
  378. begin
  379.   if (DataIndex <= 0) or (DataIndex > Outline1.ItemCount) then Exit;
  380.   if SaveDialog1.Execute then begin
  381.     AssignFile(f,SaveDialog1.FileName);
  382.     Rewrite(f);
  383.     if IOResult = 0 then with Outline1 do begin
  384.       cr:=SetCursor(LoadCursor(0,IDC_WAIT));
  385.       FlushChanges;
  386.       if MainKey = clases[0] then Writeln(f,'REGEDIT') else Writeln(f,'REGEDIT4');
  387.       Writeln(f);
  388.       onode:=Items[DataIndex].Parent;
  389.       npath:='';
  390.       if DataIndex > 1 then begin
  391.         while Assigned(onode) do begin
  392.           node:=onode.Text;
  393.           if node <> '' then begin
  394.             i:=Pos(' ',node); if i <> 0 then System.Delete(node,i,255);
  395.             npath:='\'+node+npath;
  396.           end;
  397.           onode:=onode.Parent;
  398.         end;
  399.         SaveTree(npath,DataIndex);
  400.       end
  401.       else for l:=2 to ItemCount do if Items[l].Level = 1 then SaveTree('',l);
  402.       SetCursor(cr);
  403.       CloseFile(f);
  404.     end
  405.     else Application.MessageBox('Cannot create file',NIL,MB_OK or MB_ICONSTOP);
  406.   end;
  407. end;
  408.  
  409. end.
  410.