diff options
| author | murphy <murphy@rubychan.de> | 2006-07-11 05:45:00 +0000 |
|---|---|---|
| committer | murphy <murphy@rubychan.de> | 2006-07-11 05:45:00 +0000 |
| commit | f52bf8ab02dfe021e415adb17fb01ea9b1d388f1 (patch) | |
| tree | f69ef9b8323175f8fbb0b0d11d8f8d3fea53ea4c /test/delphi/pluto.in.pas | |
| parent | 7bb2aef0553091a10c197e302475c9f14de8a860 (diff) | |
| download | coderay-f52bf8ab02dfe021e415adb17fb01ea9b1d388f1.tar.gz | |
Totally revamped test system. Nitro will be fixed soon.
A bunch of new tests. Delphi and XML are now tested, too.
bench/example.dump deleted (depends on Ruby version, OS, whatever. Nothing for the repo.)
Diffstat (limited to 'test/delphi/pluto.in.pas')
| -rw-r--r-- | test/delphi/pluto.in.pas | 10829 |
1 files changed, 10829 insertions, 0 deletions
diff --git a/test/delphi/pluto.in.pas b/test/delphi/pluto.in.pas new file mode 100644 index 0000000..b7aaad7 --- /dev/null +++ b/test/delphi/pluto.in.pas @@ -0,0 +1,10829 @@ +unit FindTH;
+
+interface
+
+uses
+ Classes, windows, Dialogs, ComCtrls, CompEx, SysUtils, YTools, YTypes,
+ clock, plutoconst, StdCtrls, Masks, Forms, XReg;
+
+const
+ RegMoleVersion = '1.1';
+
+type
+ TFindThreadProgress = (fpNone, fpEvery512th, fpEach);
+
+ TRegFindThread = class(TThread)
+ private
+ SearchText: string;
+ SearchFor: TSearchOptions;
+ Progress: TFindThreadProgress;
+ FindNodeText: string;
+ TimeElapsed: Double;
+ syncIcon: Integer;
+ syncStatusText: string;
+ CurrentPath: string;
+ KeysScanned: Integer;
+ Mask: TMask;
+ dwordVal: DWORD;
+ SearchForValues: Boolean;
+
+ procedure Find;
+
+ //Synchronizers
+ procedure Start;
+ procedure Add;
+ procedure UpdateStatus;
+ procedure Finish;
+ protected
+ procedure Execute; override;
+ public
+ SpecialPath: string;
+ FindNode: TTreeNode;
+ ListTV: TTreeView;
+ ObjectsFound, KeysFound, ValuesFound, DataFound: Integer;
+ Ranges: TRanges;
+ destructor Destroy; override;
+ constructor CreateIt(PriorityLevel: TThreadPriority; s: string;
+ SearchFor: TSearchOptions; Progress: TFindThreadProgress);
+ end;
+
+implementation
+
+uses
+ ValuesU, StrUtils;
+
+{ TRegFindThread }
+
+procedure TRegFindThread.Add;
+var
+ Node: TTreeNode;
+begin
+ with ListTV do begin
+ //Items.BeginUpdate;
+ Node := TTreeNode.Create(Items);
+ SetTNImage(Node, syncIcon);
+ Items.AddNode(Node, FindNode, Copy(CurrentPath, 1, 255), nil,
+ naAddChildFirst);
+ if not FindNode.Expanded and (FindNode.Count = 1) then //First Node
+ FindNode.Expand(False);
+ //Items.EndUpdate;
+ end;
+end;
+
+constructor TRegFindThread.CreateIt(PriorityLevel: TThreadPriority; s: string;
+ SearchFor: TSearchOptions; Progress: TFindThreadProgress);
+begin
+ inherited Create(True); // Create thread suspended
+ Priority := PriorityLevel; // Set Priority Level
+ FreeOnTerminate := True; // Thread Free Itself when terminated
+
+ SearchText := s;
+ Ranges := nil;
+ Self.SearchFor := SearchFor;
+ Self.Progress := Progress;
+end;
+
+destructor TRegFindThread.Destroy;
+begin
+ if Assigned(FindNode) then
+ FindNode.Data := nil;
+ inherited;
+end;
+
+procedure TRegFindThread.Execute;
+begin
+ Synchronize(Start);
+ Find;
+ Synchronize(Finish);
+end;
+
+procedure TRegFindThread.Find;
+var
+ SpecialKey: HKEY;
+
+ procedure Add(const Path: string; const Icon: Integer);
+ var
+ zCurrentPath: string;
+ begin
+ zCurrentPath := CurrentPath;
+
+ CurrentPath := Path;
+ syncIcon := Icon;
+ Synchronize(Self.Add);
+
+ CurrentPath := zCurrentPath;
+ end;
+
+ procedure AddValueName(const ValueName: string; Typ: TRegDataType);
+ begin
+ Add(CurrentPath + '\\' + ValueName, IconOfDataType(Typ));
+ end;
+
+ procedure AddValueData(const ValueName: string; Context: TRegContext);
+ begin
+ Add(CurrentPath + '\\' + ValueName + ' = ' + DataPreviewOfContext(Context),
+ IconOfDataType(Context.Typ));
+ end;
+
+ function FoundInStr(const Data: string): Boolean;
+ begin
+ Result := False;
+ if SearchText = '' then
+ Exit;
+
+ if (Data = '') and not (sfWildCards in SearchFor) then
+ Exit;
+
+ if sfWildCards in SearchFor then begin
+ if Assigned(Mask) then
+ Result := Mask.Matches(Data);
+ end else begin
+ {if not (sfFileNames in SearchFor) then begin
+ if TextBegin(SearchText, UntilChar(Data, '~')) and FileExists(Data) then
+ Result := SameFileName(SearchText, GetFileNew(Data));
+ Exit;
+ end; }
+
+ if [sfParts, sfIgnoreCase] <= SearchFor then
+ if SfUseLocales in SearchFor then
+ Result := 0<PosEx(SearchText, AnsiLowerCase(Data))
+ else
+ Result := 0<PosExText(SearchText, Data)
+ else if sfParts in SearchFor then
+ Result := 0<PosEx(SearchText, Data)
+ else if sfIgnoreCase in SearchFor then
+ if SfUseLocales in SearchFor then
+ Result := (AnsiLowerCase(Data) = SearchText)
+ else
+ Result := SameText(Data, SearchText)
+ else
+ Result := (SearchText = Data);
+ end;
+ end;
+
+ function FoundInByteA(const Data: TByteA): Boolean;
+ begin
+ Result := FoundInStr(StrOfByteA(Data));
+ end;
+
+ procedure ScanValues(Key: HKEY; Info: TRegKeyInfo);
+ var
+ i: Integer;
+ MaxLen, NameLen, Len, Typ: Cardinal;
+ Buffer: PByte;
+ ValueName: PChar;
+
+ procedure ScanValue(const ValueName: string; const Typ: TRegDataType;
+ const Data: string);
+ begin
+ if (sfSpecialTypes in SearchFor) and not InRanges(Ranges, Typ) then
+ Exit;
+
+ case Typ of
+ rdString, rdExpandString: if sfString in SearchFor then begin
+ if FoundInStr(Data) then begin
+ Inc(DataFound);
+ AddValueData(ValueName,
+ RegContext(Typ, TByteA(Copy(Data, 1, Length(Data)-1))));
+ end;
+ end;
+
+ rdCardinal, rdCardBigEndian: if sfDWord in SearchFor then begin
+ if (Length(Data) >= SizeOf(Cardinal)) and
+ (dwordVal = PCardinal(Copy(Data, 1, SizeOf(Cardinal)))^) then begin
+ Inc(DataFound);
+ AddValueData(ValueName,
+ RegContext(Typ, ByteAOfStr(Data)));
+ end;
+ end;
+
+ else
+ if sfOtherTypes in SearchFor then begin
+ if FoundInStr(Data) then begin
+ Inc(DataFound);
+ AddValueData(ValueName,
+ RegContext(Typ, ByteAOfStr(Data)));
+ end;
+ end;
+ end;
+ end;
+
+ begin
+ MaxLen := Info.MaxValueLen + 1; //Include Nullbyte
+
+ Buffer := nil;
+ if sfValueData in SearchFor then
+ GetMem(Buffer, Info.MaxDataLen);
+
+ GetMem(ValueName, MaxLen);
+ for i := 0 to Info.NumValues-1 do begin
+ NameLen := MaxLen;
+ Len := Info.MaxDataLen;
+ if not Success(RegEnumValue(Key, i, ValueName, NameLen, nil, @Typ,
+ Buffer, @Len)) then
+ Continue;
+
+ if sfValueNames in SearchFor then
+ if FoundInStr(ValueName) then begin
+ Inc(ValuesFound);
+ AddValueName(ValueName, Typ);
+ end;
+
+ if sfValueData in SearchFor then
+ ScanValue(ValueName, Typ, string(Copy(TByteA(Buffer), 0, Len)));
+ end;
+
+ FreeMem(ValueName, MaxLen);
+ if sfValueData in SearchFor then
+ FreeMem(Buffer, Info.MaxDataLen);
+ end;
+
+ procedure ScanKey(Key: HKEY; const KeyName: string = '');
+ var
+ p: PChar;
+ i, z: Integer;
+ l, Len: DWORD;
+ NewKey: HKEY;
+ Info: TRegKeyInfo;
+ begin
+ if Terminated then Exit;
+
+ Inc(KeysScanned);
+ if Progress <> fpNone then
+ if (Progress = fpEach) or
+ ((Progress = fpEvery512th) and ((KeysScanned and $1FF) = 0)) then begin
+ syncStatusText := '(' + IntToStr(KeysScanned) + ' k) ' + CurrentPath;
+ Synchronize(UpdateStatus);
+ end;
+
+ with Info do
+ if not Success(RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys,
+ @MaxSubKeyLen, nil, @NumValues, @MaxValueLen, @MaxDataLen,
+ nil, nil)) then
+ Exit;
+
+ if (Info.NumValues > 0) and SearchForValues then
+ ScanValues(Key, Info);
+
+ if Info.NumSubKeys <= 0 then
+ Exit;
+
+ Len := Info.MaxSubKeyLen + 1;
+ GetMem(p, Len);
+
+ for i := 0 to Info.NumSubKeys-1 do begin
+ l := Len;
+ RegEnumKeyEx(Key, i, p, l, nil, nil, nil, nil);
+ if sfKeys in SearchFor then
+ if FoundInStr(p) then begin
+ Inc(KeysFound);
+ Add(CurrentPath + '\' + p, iconKeyMiddle);
+ end;
+
+ if Success(RegOpenKey(Key, p, NewKey)) then begin
+ z := Length(CurrentPath);
+ CurrentPath := CurrentPath + '\' + p;
+
+ try
+ ScanKey(NewKey, p);
+ finally
+ RegCloseKey(NewKey);
+ end;
+
+ SetLength(CurrentPath, z);
+ end;
+
+ if Terminated then Break;
+ end;
+
+ FreeMem(p, Len);
+ end;
+
+begin
+ with TClock.Create do begin
+ FindNode.Text := FindNodeText + ': ';
+
+ try
+ if sfHKU in SearchFor then begin
+ CurrentPath := 'HKU';
+ ScanKey(HKEY_USERS);
+ end;
+ if sfHKLM in SearchFor then begin
+ CurrentPath := 'HKLM';
+ ScanKey(HKEY_LOCAL_MACHINE);
+ end;
+ if sfHKDD in SearchFor then begin
+ CurrentPath := 'HKDD';
+ ScanKey(HKEY_DYN_DATA);
+ end;
+
+ if SpecialPath <> '' then begin
+ if Success(RegOpenKey(HKEYOfStr(ExRegRoot(SpecialPath)),
+ PChar(ExRegKey(SpecialPath)), SpecialKey)) then begin
+ CurrentPath := LWPSolve(SpecialPath);
+ ScanKey(SpecialKey);
+ RegCloseKey(SpecialKey);
+ end else
+ ShowMessage('Could not open' + EOL +
+ Quote(SpecialPath));
+ end;
+ except
+ syncStatusText := '(' + IntToStr(KeysScanned) + ' k) ' + CurrentPath +
+ 'Error --> Terminated.';
+ Synchronize(UpdateStatus);
+ Sleep(1000);
+ end;
+
+ TimeElapsed := SecondsPassed;
+ Free; end;
+end;
+
+function StrOfSearchOptions(const Options: TSearchOptions): string;
+
+ procedure Add(const s: string);
+ begin
+ Result := Result + s;
+ end;
+
+ procedure AddOption(const Option: string; const Flag: TSearchVar;
+ const Optional: Boolean = False);
+ begin
+ if Flag in Options then
+ Add(Option)
+ else
+ if not Optional then
+ Add('^' + Option);
+ end;
+
+begin
+ Result := '';
+
+ Add('[');
+ AddOption('H', sfAsHex, True);
+ AddOption('W ', sfWildcards, True);
+
+ AddOption('C', sfIgnoreCase);
+ AddOption('L', sfUseLocales);
+ AddOption('P ', sfParts);
+
+ AddOption('K', sfKeys);
+ AddOption('N', sfValueNames);
+ AddOption('D ', sfValueData);
+
+ AddOption('S', sfString);
+ AddOption('D', sfDWORD);
+ AddOption('O', sfOtherTypes);
+ AddOption('?', sfSpecialTypes);
+
+ Add('] [');
+
+ if [sfHKU, sfHKLM, sfHKDD] <= Options then
+ Add('ALL')
+ else begin
+ AddOption('HKU ', sfHKU, True);
+ AddOption('HKLM ', sfHKLM, True);
+ AddOption('HKDD ', sfHKDD, True);
+ Result := TrimRight(Result);
+ end;
+
+ Add(']');
+end;
+
+procedure TRegFindThread.Start;
+begin
+ Mask := nil;
+ KeysFound := 0;
+ ValuesFound := 0;
+ DataFound := 0;
+ KeysScanned := 0;
+
+ //Prepare for options
+ if sfAsHex in SearchFor then begin
+ SearchText := string(ByteAOfHex(SearchText));
+ SearchFor := SearchFor - [sfDWord, sfIgnoreCase];
+ end else begin
+ if SfUseLocales in SearchFor then
+ SearchText := AnsiLowerCase(SearchText);
+
+ dwordVal := 0;
+ if sfDWord in SearchFor then
+ if IsValidInteger(SearchText) then
+ dwordVal := StrToInt(SearchText)
+ else
+ Exclude(SearchFor, sfDWord);
+
+ if sfWildCards in SearchFor then
+ try
+ Mask := TMask.Create(SearchText);
+ except
+ Mask.Free;
+ Mask := nil;
+ end;
+ end;
+
+ SearchForValues := (sfValueNames in SearchFor)
+ or (sfValueData in SearchFor);
+
+ FindNodeText := 'Find ' + Quote(FriendlyStr(SearchText)) + ' ' +
+ StrOfSearchOptions(SearchFor);
+
+ with ListTV.Items do begin
+ BeginUpdate;
+ FindNode := AddChildObject(nil, FindNodeText + '...', nil);
+ FindNode.Data := Self;
+ SetTNImage(FindNode, iconHostReg);
+ EndUpdate;
+ end;
+end;
+
+procedure TRegFindThread.UpdateStatus;
+begin
+ FindNode.Text := FindNodeText + ' ' + syncStatusText;
+end;
+
+procedure TRegFindThread.Finish;
+var
+ Found: string;
+begin
+ ObjectsFound := KeysFound + ValuesFound + DataFound;
+
+ Found := StrNumerus(ObjectsFound, 'object', 'objects', 'No');
+ if ObjectsFound < 2 then
+ Found := Found + ' found.'
+ else begin
+ Found := Found + ' found: ';
+ if KeysFound > 0 then
+ Found := Found + StrNumerus(KeysFound, 'KeyName, ', 'KeyNames, ', 'No');
+ if ValuesFound > 0 then
+ Found := Found + StrNumerus(ValuesFound, 'ValueName, ', 'ValueNames, ',
+ 'No');
+ if DataFound > 0 then
+ Found := Found + StrNumerus(DataFound, 'Data', 'Datas', 'No');
+
+ if RightStr(Found, 2) = ', ' then
+ Delete(Found, Length(Found) - 1, 2);
+ end;
+
+ FindNode.Text := FindNodeText + Format(' OK (%0.1f s) %s',
+ [TimeElapsed, Found]);
+end;
+
+end.
+unit FindWinU;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ ComCtrls, StdCtrls, ExtCtrls, Clipbrd, NewPanels, plutoconst, FindTH, YTools,
+ PrefTools, Menus, XReg, RangeEdit;
+
+type
+ TFindWin = class(TForm)
+ ListTV: TTreeView;
+ FindP: TPanel;
+ FindE: TEdit;
+ ColorPanel1: TColorPanel;
+ ResultsPopup: TPopupMenu;
+ Copy1: TMenuItem;
+ ColorPanel2: TColorPanel;
+ FindPrefP: TPanel;
+ CommonGB: TGroupBox;
+ Label4: TLabel;
+ SfWildCardsCB: TCheckBox;
+ SfPartsCB: TCheckBox;
+ SfIgnoreCaseCB: TCheckBox;
+ SfAsHexCB: TCheckBox;
+ SfAsDWord: TCheckBox;
+ SfUseLocalesCB: TCheckBox;
+ FindGB: TGroupBox;
+ SfHKUCB: TCheckBox;
+ SfHKLMCB: TCheckBox;
+ SfHKDDCB: TCheckBox;
+ SfRootKeyRB: TRadioButton;
+ SfCurKeyRB: TRadioButton;
+ SfCLSIDCB: TCheckBox;
+ SfInterfaceCB: TCheckBox;
+ SfKeysCb: TCheckBox;
+ SfValuesCB: TCheckBox;
+ SfDataCB: TCheckBox;
+ SfStringCB: TCheckBox;
+ SfOtherCB: TCheckBox;
+ SfDWordCB: TCheckBox;
+ Panel2: TPanel;
+ GroupBox1: TGroupBox;
+ Label1: TLabel;
+ ThreadPriorityComB: TComboBox;
+ ProgressRG: TRadioGroup;
+ Panel5: TPanel;
+ BorderPanel1: TBorderPanel;
+ MoleLogoI: TImage;
+ TypeRangeE: TRangeEdit;
+ SfTypesCB: TCheckBox;
+ Panel1: TPanel;
+ TransparentCB: TPrefCheckBox;
+ StayOnTopCB: TPrefCheckBox;
+ FindB: TButton;
+ FindPrefB: TButton;
+ procedure FindBClick(Sender: TObject);
+ procedure ListTVKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FindEKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure ActivateIt(Sender: TObject);
+ procedure DeActivateIt(Sender: TObject);
+ procedure FormDeactivate(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure SfWildCardsCBClick(Sender: TObject);
+ procedure StayOnTopCBClick(Sender: TObject);
+ procedure SfRootKeysUpdate(Sender: TObject);
+ procedure FindPrefBClick(Sender: TObject);
+
+ procedure CloseFindPrefP;
+ procedure OpenFindPrefP;
+ procedure FindEChange(Sender: TObject);
+ procedure SfDataCBClick(Sender: TObject);
+ procedure ListTVDblClick(Sender: TObject);
+ procedure SfAsHexCBClick(Sender: TObject);
+ procedure Copy1Click(Sender: TObject);
+ procedure SfIgnoreCaseCBClick(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure SfTypesCBClick(Sender: TObject);
+ end;
+
+const
+ fpbOpen = 0;
+ fpbCloseCaption = 'Params &<<';
+
+ fpbClosed = 1;
+ fpbOpenCaption = 'Params &>>';
+
+var
+ FindWin: TFindWin;
+
+implementation
+
+uses plutomain, PrefU, ValuesU;
+
+{$R *.DFM}
+
+procedure TFindWin.FindBClick(Sender: TObject);
+var
+ SearchFor: TSearchOptions;
+ FindThread: TRegFindThread;
+
+ procedure AddOption(CheckBox: TCustomCheckBox; Flag: TSearchVar);
+ begin
+ with CheckBox as TCheckBox do
+ if Enabled and Checked then
+ Include(SearchFor, Flag);
+ end;
+
+begin
+ SearchFor := [];
+
+ AddOption(SfKeysCB, sfKeys);
+
+ AddOption(SfValuesCB, sfValueNames);
+ AddOption(SfDataCB, sfValueData);
+
+ AddOption(SfStringCB, sfString);
+ AddOption(SfDWordCB, sfDWord);
+ AddOption(SfOtherCB, sfOtherTypes);
+
+ if SfRootKeyRB.Checked then begin
+ AddOption(SfHKUCB, sfHKU);
+ AddOption(SfHKLMCB, sfHKLM);
+ AddOption(SfHKDDCB, sfHKDD);
+ end;
+
+ AddOption(SfAsHexCB, sfAsHex);
+ AddOption(SfWildCardsCB, sfWildCards);
+ AddOption(SfPartsCB, sfParts);
+ AddOption(SfIgnoreCaseCB, sfIgnoreCase);
+ AddOption(SfUseLocalesCB, sfUseLocales);
+
+ {AddOption(SfCLSIDCB, sfCLSID);
+ AddOption(SfInterfaceCB, sfInterface);}
+
+ if SfTypesCB.Checked and not TypeRangeE.RangeMaximal then
+ Include(SearchFor, sfSpecialTypes);
+
+ FindThread := TRegFindThread.CreateIt(
+ TThreadPriority(ThreadPriorityComB.ItemIndex), FindE.Text, SearchFor,
+ TFindThreadProgress(ProgressRG.ItemIndex));
+
+ FindThread.ListTV := ListTV;
+
+ if sfSpecialTypes in SearchFor then
+ FindThread.Ranges := TypeRangeE.Value;
+
+ if SfCurKeyRB.Checked then
+ FindThread.SpecialPath :=
+ LWPSolve(StrOfRegPath(CurKey(uhNonSystemShortcuts)));
+
+ FindThread.Resume;
+ CloseFindPrefP;
+end;
+
+procedure TFindWin.ListTVKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+var
+ Node: TTreeNode;
+
+ procedure TerminateFindThread;
+ var
+ FindThread: TRegFindThread;
+ begin
+ if (Node.Level = 0) then begin
+ FindThread := TRegFindThread(Node.Data);
+ if not Assigned(FindThread) then
+ Node.Delete
+ else
+ try
+ FindThread.Terminate;
+ except
+ Node.Text := 'Error: couldn''t terminate thread!';
+ end;
+ end else
+ Node.Delete;
+ end;
+
+begin
+ Node := ListTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ case Key of
+ VK_F12: if Assigned(Node.Parent) then
+ Node.Parent.AlphaSort;
+
+ VK_RETURN: ListTVDblClick(Sender);
+
+ VK_DELETE: TerminateFindThread;
+ end;
+end;
+
+procedure TFindWin.FindEKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_RETURN then
+ FindBClick(Sender);
+
+ if Key = VK_UP then begin
+ CloseFindPrefP;
+ Key := 0;
+ end else if Key = VK_Down then begin
+ OpenFindPrefP;
+ Key := 0;
+ end;
+end;
+
+procedure TFindWin.ActivateIt(Sender: TObject);
+begin
+ ActivateThis(Sender);
+end;
+
+procedure TFindWin.DeActivateIt(Sender: TObject);
+begin
+ DeActivateThis(Sender);
+end;
+
+procedure TFindWin.FormDeactivate(Sender: TObject);
+begin
+ if Assigned(ActiveControl) and (ActiveControl.Tag = EditControlFlag) then
+ DeActivateThis(ActiveControl);
+
+ AlphaBlend := TransparentCB.Checked;
+end;
+
+procedure TFindWin.FormActivate(Sender: TObject);
+begin
+ if Assigned(ActiveControl) and (ActiveControl.Tag = EditControlFlag) then
+ ActivateThis(ActiveControl);
+
+ AlphaBlend := False;
+end;
+
+procedure TFindWin.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_ESCAPE then
+ Close;
+ MainWin.FormKeyDown(Sender, Key, Shift);
+end;
+
+procedure TFindWin.SfWildCardsCBClick(Sender: TObject);
+begin
+ SfPartsCB.Enabled := not SfWildcardsCB.Checked;
+ SfIgnoreCaseCB.Enabled := not SfWildcardsCB.Checked;
+ SfUseLocalesCB.Enabled := SfIgnoreCaseCB.Checked and not SfWildcardsCB.Checked;
+end;
+
+procedure TFindWin.StayOnTopCBClick(Sender: TObject);
+begin
+ if StayOnTopCB.Checked then
+ FormStyle := fsStayOnTop
+ else
+ FormStyle := fsNormal;
+end;
+
+procedure TFindWin.SfRootKeysUpdate(Sender: TObject);
+begin
+ with SfRootKeyRB do begin
+ SfHKLMCB.Enabled := Checked;
+ SfHKUCB.Enabled := Checked;
+ SfHKDDCB.Enabled := Checked;
+ end;
+end;
+
+procedure TFindWin.FindPrefBClick(Sender: TObject);
+begin
+ case FindPrefB.Tag of
+ fpbOpen:
+ CloseFindPrefP;
+ fpbClosed:
+ OpenFindPrefP;
+ else
+ ShowMessage('Fehler: FindPrefB hat unbekanntes Tag');
+ end;
+end;
+
+procedure TFindWin.CloseFindPrefP;
+begin
+ with FindPrefB do begin
+ Tag := fpbClosed;
+ Caption := fpbOpenCaption;
+ end;
+ FindPrefP.Visible := False;
+ ListTV.Repaint;
+end;
+
+procedure TFindWin.OpenFindPrefP;
+begin
+ with FindPrefB do begin
+ Tag := fpbOpen;
+ Caption := fpbCloseCaption;
+ end;
+ FindPrefP.Visible := True;
+ ListTV.Repaint;
+end;
+
+procedure TFindWin.FindEChange(Sender: TObject);
+begin
+ if IsValidInteger(FindE.Text) then
+ SfDWORDCB.Caption := 'D&WORD OK'
+ else
+ SfDWORDCB.Caption := 'D&WORD ??';
+
+ SfAsHexCB.Enabled := (FindE.Text <> '')
+ and not CharIn(FindE.Text, AllChars - HexadecimalChars - [' ']);
+ SfAsDWord.Enabled := SfAsHexCB.Enabled and (Length(TrimAll(FindE.Text)) < 8);
+end;
+
+procedure TFindWin.SfDataCBClick(Sender: TObject);
+begin
+ with SfDataCB do begin
+ SfStringCB.Enabled := Checked;
+ SfDWordCB.Enabled := Checked;
+ SfOtherCB.Enabled := Checked;
+ end;
+end;
+
+procedure TFindWin.ListTVDblClick(Sender: TObject);
+var
+ Node: TTreeNode;
+begin
+ Node := ListTV.Selected;
+ if not Assigned(Node) or (Node.Level = 0) then
+ Exit;
+
+ MainWin.GotoKey(UntilLastChar(Node.Text, '='))
+end;
+
+procedure TFindWin.SfAsHexCBClick(Sender: TObject);
+begin
+ with SfAsHexCB do begin
+ SfIgnoreCaseCB.Enabled := Checked;
+ SfWildCardsCB.Enabled := Checked;
+ end;
+end;
+
+procedure TFindWin.Copy1Click(Sender: TObject);
+var
+ Node: TTreeNode;
+begin
+ Node := ListTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ Clipboard.AsText := Node.Text;
+end;
+
+procedure TFindWin.SfIgnoreCaseCBClick(Sender: TObject);
+begin
+ SfUseLocalesCB.Enabled := SfIgnoreCaseCB.Checked;
+end;
+
+procedure TFindWin.FormCreate(Sender: TObject);
+var
+ ImageFile: string;
+begin
+ Caption := 'Pluto.RegMole ' + RegMoleVersion +
+ ' - The fastest registry search engine for Win9x';
+
+ ImageFile := PlutoDir + 'mole.bmp';
+ if FileExists(ImageFile) then
+ MoleLogoI.Picture.LoadFromFile(ImageFile);
+
+ Width := Screen.WorkAreaWidth - 100;
+
+ CloseFindPrefP;
+end;
+
+procedure TFindWin.FormShow(Sender: TObject);
+begin
+ Top := Screen.WorkAreaHeight - 450;
+ Height := Screen.WorkAreaHeight - Top;
+ Left := (Screen.WorkAreaWidth - Width) div 2;
+end;
+
+procedure TFindWin.SfTypesCBClick(Sender: TObject);
+begin
+ TypeRangeE.Enabled := SfTypesCB.Checked;
+end;
+
+end.
+unit Plutoconst;
+
+interface
+
+uses ComCtrls, Classes, XReg, UniKey, YTools;
+
+var
+ Started: Boolean = False;
+ MurphyMode: Boolean = False;
+ PlutoKey: TUniKey;
+
+const
+ Version = '1.6 -nium Alpha';
+ Overnight = True;
+ Codename = 'Phoenix';
+ //Generation.Version-Release-Beta
+ // GG.VVRRBB
+ VersionNum: Double = 1.600000;
+ //Must be Double!
+
+const
+ iconKey = 0;
+
+ iconFirstHKEY = 2;
+ iconHKLM = iconFirstHKEY;
+ iconHKU = iconFirstHKEY + 2;
+
+ iconFirstShortcut = iconFirstHKEY + 4;
+ iconHKCC = iconFirstShortcut;
+ iconHKCU = iconFirstShortcut + 2;
+ iconHKCR = iconFirstShortcut + 4;
+ iconHKDD = iconFirstShortcut + 6;
+ iconHKPD = iconFirstShortcut + 8;
+ iconHKWM = iconFirstShortcut + 10;
+ iconHKWU = iconFirstShortcut + 12;
+ iconShortcut = iconFirstShortcut + 14;
+ nHKeyIcons = 16;
+
+ iconFirstType = iconFirstShortcut + nHKeyIcons;
+ iconNone = iconFirstType + 0;
+ iconString = iconFirstType + 1;
+ iconExpandString =iconFirstType + 2;
+ iconBinary = iconFirstType + 3;
+ iconCardinal = iconFirstType + 4;
+ iconCardBigEndian=iconFirstType + 5;
+ iconLink = iconFirstType + 6;
+ iconMultiString = iconFirstType + 7;
+ iconResList = iconFirstType + 8;
+ iconFullResDesc = iconFirstType + 9;
+ iconResReqList = iconFirstType + 10;
+ iconUnknownType = iconFirstType + 11;
+ nTypeIcons = 12;
+
+ iconFirstValue = iconFirstType + nTypeIcons;
+ iconValueElse = iconFirstValue;
+ iconValueEdit = iconFirstValue + 1;
+ iconValueEditBinary = iconFirstValue + 2;
+ iconValueZeromize = iconFirstValue + 3;
+ iconValueDublicate = iconFirstValue + 4;
+ iconMainValue = iconFirstValue + 5;
+ iconTakeAsMainValue = iconFirstValue + 6;
+ nValueIcons = 7;
+
+ iconFirstKey = iconFirstValue + nValueIcons;
+ iconKeyInfos = iconFirstKey;
+ iconSubKey = iconFirstKey + 1;
+ iconKeyDublicate = iconFirstKey + 2;
+ iconKeyFind = iconFirstKey + 3;
+ iconKeyTrace = iconFirstKey + 4;
+ nKeyIcons = 5;
+
+ iconFirstContextMenues = iconFirstKey + nKeyIcons;
+ iconRename = iconFirstContextMenues;
+ iconDelete = iconFirstContextMenues + 1;
+ nContextMenuesIcon = 2;
+
+ iconFirstIni = iconFirstContextMenues + nContextMenuesIcon;
+ iconIniSection = iconFirstIni;
+ nIniIcons = 1;
+
+ iconFirstHost = iconFirstIni + nIniIcons;
+ iconHostReg = iconFirstHost;
+ iconHostIni = iconFirstHost + 1;
+ iconHostUni = iconFirstHost + 2;
+ iconHostUni2 = iconFirstHost + 3;
+ nHostIcons = 4;
+
+ iconFirstOther = iconFirstHost + nHostIcons;
+
+ iconSortArrowAsc = iconFirstOther + 0;
+ iconSortArrowDesc = iconFirstOther + 1;
+ iconKeyMiddle = iconFirstOther + 2;
+ iconLock = iconFirstOther + 3;
+
+ //iconDefect = iconFirstOther;
+
+ { WorkWin.ChangeImages }
+ iconFirstChange = 0;
+ iconCKeyPlus = iconFirstChange;
+ iconCKeyMinus = iconFirstChange + 1;
+ iconCValuePlus = iconFirstChange + 2;
+ iconCValueMinus = iconFirstChange + 3;
+ iconCContext = iconFirstChange + 4;
+ iconOldContext = iconFirstChange + 5;
+ iconNewContext = iconFirstChange + 6;
+ iconGroup = iconFirstChange + 7;
+ iconGroupBlinking = iconFirstChange + 8;
+ nChangeIcons = 7;
+
+ DefaultValueFlag = Pointer(1);
+ MultiEditFlag = Pointer(2);
+
+ NoValueCaption = '[No Value]';
+
+ EditControlFlag = 100;
+
+ MaxPreviewLen = 255;
+ RegMaxDataSize = $FFFF; //64 KB
+
+const
+ BoolStrFileName = 'Boolean Strings.txt';
+ ShortcutsFileName = 'Shortcuts.ini';
+ StandardShortcutsFileName = 'StandardShortcuts.ini';
+ SisyFilterFileName = 'sisy filter.txt';
+
+ clDarkGray = $00404040;
+ clBrightRed = $00BBBBFF;
+ clVeryBrightRed = $00DDDDFF;
+ clBrightBlue = $00FFBBBB;
+ clBrightGreen = $00BBFFBB;
+ clCyan = $00FFFF44;
+ clBrightCyan = $00FFFFBB;
+ clVeryBrightCyan = $00FFFFDD;
+ clBrightYellow = $00BBFFFF;
+ clVeryBrightYellow = $00DDFFFF;
+ clBrightPurple = $00FFBBFF;
+ clBrightSilver = $00DDDDDD;
+ clGold = $0055CCEE;
+
+ clVeryBrightBlue = $00FFDDDD;
+
+type
+ TValueListColumn = (vlcName, vlcSize, vlcType, vlcData);
+
+const
+ ValueListColumnRange = [Low(TValueListColumn)..High(TValueListColumn)];
+
+type
+ TSearchVar = (sfKeys, sfValueNames, sfValueData,
+ sfAsHex, sfAsDWord,
+ sfWildCards, sfParts, sfIgnoreCase, SfUseLocales,
+ sfHKU, sfHKLM, sfHKDD,// sfCLSID, sfInterface,
+ sfString, sfDWord, sfOtherTypes, sfSpecialTypes);
+
+ TSearchOptions = set of TSearchVar;
+
+ //be carefull: used in with!
+ TKeyShortcut = record
+ Alias: string;
+ RealPath: string;
+ Node: TTreeNode;
+ end;
+ PKeyShortcut = ^TKeyShortcut;
+ TShortcutA = array of TKeyShortcut;
+
+ TOpenNode = function (Reg: TXRegistry; Node: TTreeNode): Boolean;
+ TCheckNode = procedure (Node: TTreeNode; OnlyOnce: Boolean = True);
+
+ //NodeInfo System
+ TNodeFlag = (nfDefect, nfReadOnly, nfChecked,
+ nfCopy, nfCut, nfPaste);
+ TNodeFlags = set of TNodeFlag;
+
+ TUniHostType = (uhNone,
+ uhReg, uhIni, uhRegFile,
+ uhUserShortcut, uhStandardShortcut, uhSystemShortcut);
+ TUniHostTypes = set of TUniHostType;
+
+const
+ uhShortcuts = [uhUserShortcut, uhStandardShortcut, uhSystemShortcut];
+ uhNonSystemShortcuts = [uhUserShortcut, uhStandardShortcut];
+
+ NodeFlagStrings: array[TNodeFlag] of string = (
+ 'nfDefect', 'nfReadOnly', 'nfChecked',
+ 'nfCopy', 'nfCut', 'nfPaste');
+
+ HostTypeStrings: array[TUniHostType] of string = ('uhNone',
+ 'uhReg', 'uhIni', 'uhRegFile',
+ 'uhUserShortcut', 'uhStandardShortcut', 'uhSystemShortcut');
+
+type
+ TNodeInfo = packed class
+ public
+ HostType: TUniHostType;
+ Flags: TNodeFlags;
+ constructor Create(HostType: TUniHostType = uhNone; Flags: TNodeFlags = []);
+
+ procedure IncludeFlag(Flag: TNodeFlag);
+ procedure ExcludeFlag(Flag: TNodeFlag);
+
+ function IsHost: Boolean;
+ function IsShortcut: Boolean;
+
+ function ReadOnly: Boolean;
+ function Checked: Boolean;
+ function Defect: Boolean;
+ end;
+
+function NodeInfo(Node: TTreeNode): TNodeInfo;
+procedure ReportStatus(const s: string);
+
+const
+ PlatformStrings: array[0..2] of string =
+ ('VER_PLATFORM_WIN32s', 'VER_PLATFORM_WIN32_WINDOWS', 'VER_PLATFORM_WIN32_NT');
+
+var
+ PlutoDir: string = '';
+
+implementation
+
+uses SysUtils;
+
+function NodeInfo(Node: TTreeNode): TNodeInfo;
+begin
+ if not Assigned(Node) then begin
+ Result := nil;
+ Exit end;
+
+ if not Assigned(Node.Data) then
+ Node.Data := TNodeInfo.Create;
+ Result := TNodeInfo(Node.Data);
+end;
+
+{ TNodeInfo }
+
+constructor TNodeInfo.Create(HostType: TUniHostType; Flags: TNodeFlags);
+begin
+ inherited Create;
+ Self.HostType := HostType;
+ Self.Flags := Flags;
+end;
+
+function TNodeInfo.Checked: Boolean;
+begin
+ Result := nfChecked in Flags;
+end;
+
+function TNodeInfo.ReadOnly: Boolean;
+begin
+ Result := nfReadOnly in Flags;
+end;
+
+function TNodeInfo.Defect: Boolean;
+begin
+ Result := nfDefect in Flags;
+end;
+
+procedure TNodeInfo.IncludeFlag(Flag: TNodeFlag);
+begin
+ Include(Flags, Flag);
+end;
+
+procedure TNodeInfo.ExcludeFlag(Flag: TNodeFlag);
+begin
+ Exclude(Flags, Flag);
+end;
+
+function TNodeInfo.IsHost: Boolean;
+begin
+ Result := HostType <> uhNone;
+end;
+
+function TNodeInfo.IsShortcut: Boolean;
+begin
+ Result := HostType in uhShortcuts;
+end;
+
+function GetPlutoDir: string;
+begin
+ Result := LWPSlash(GetParam('-imports=', MyDir));
+ if not DirectoryExists(Result) then begin
+ ReportStatus('PlutoDir "' + Result + '" not found -> setting to default (MyDir).');
+ Result := MyDir;
+ end;
+ ReportStatus('PlutoDir=' + Result);
+end;
+
+var
+ ReportSL: TStringList;
+ ReportFileName: string;
+
+procedure ReportStatus(const s: string);
+begin
+ ReportSL.Add(s);
+ try
+ ReportSL.SaveToFile(ReportFileName);
+ except end;
+end;
+
+initialization
+ ReportFileName := MyDir + 'loadreport.txt';
+ ReportSL := TStringList.Create;
+ PlutoDir := GetPlutoDir;
+
+end.
+//winampviscolor <viscolor.txt>:
+unit plutomain;
+{$DEFINE UNIKEY}
+{$DEFINE CYCFS}
+
+{===============================================================================
+
+ cYcnus.Pluto 1.57 Beta 14
+ by Murphy
+
+ ©2000-2003 by cYcnus
+ visit www.cYcnus.de
+
+ murphy@cYcnus.de (Kornelius Kalnbach)
+
+ this programm is published under the terms of the GPL
+
+===============================================================================}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ StdCtrls, ImgList, ComCtrls, ExtCtrls, Menus, Clipbrd, IniFiles,
+ ShellAPI, Grids,
+ //Components
+ NewPanels,
+ //Units
+ YTools, YTypes, UniKey, XReg,
+ //Pluto
+ Plutoconst,
+ SpyTH, SisyphusTH;
+
+const
+ NoPreBlinkHint = #1;
+
+type
+ TMainWin = class(TForm)
+ StatusBar: TStatusBar;
+ StatusBarPU: TPopupMenu;
+ CopyPath: TMenuItem;
+ InsertPath: TMenuItem;
+ ShowRealPathMI: TMenuItem;
+ PathP: TPanel;
+ N1: TMenuItem;
+ MainMenu1: TMainMenu;
+ Desktop1: TMenuItem;
+ Pluto1: TMenuItem;
+ RegEdit1: TMenuItem;
+ Free1: TMenuItem;
+ BigVal1: TMenuItem;
+ Hilfe1: TMenuItem;
+ History1: TMenuItem;
+ SplashScreen1: TMenuItem;
+ wwwcYcnusde1: TMenuItem;
+ Credits1: TMenuItem;
+ Optionen1: TMenuItem;
+ PrefMI: TMenuItem;
+ EditBoolStrMI: TMenuItem;
+ N4: TMenuItem;
+ ImageList1: TImageList;
+ Plutoini1: TMenuItem;
+ About1: TMenuItem;
+ kornycYcnusde1: TMenuItem;
+ ools1: TMenuItem;
+ NotePad1: TMenuItem;
+ RegEdit2: TMenuItem;
+ SysEdit1: TMenuItem;
+ WordPad1: TMenuItem;
+ N3: TMenuItem;
+ N5: TMenuItem;
+ Suchen1: TMenuItem;
+ Find1: TMenuItem;
+ File1: TMenuItem;
+ ExitPluto1: TMenuItem;
+ OpenProgramFolder1: TMenuItem;
+ N6: TMenuItem;
+ OpenWinDir1: TMenuItem;
+ HintBlinkT: TTimer;
+ FindCLSID1: TMenuItem;
+ Clipboard1: TMenuItem;
+ GotoCLSID1: TMenuItem;
+ CommandLineParameters1: TMenuItem;
+ plutocYcnusde1: TMenuItem;
+ N7: TMenuItem;
+ heinzcYcnusde1: TMenuItem;
+ kornycYcnusde2: TMenuItem;
+ N8: TMenuItem;
+ ExternalHexEditMI: TMenuItem;
+ Cleanup1: TMenuItem;
+ DeleteTempFolder1: TMenuItem;
+ Debug1: TMenuItem;
+ CurrentDir1: TMenuItem;
+ RepairPluto155bBug1: TMenuItem;
+ BackupRegistryscanreg1: TMenuItem;
+ Username1: TMenuItem;
+ SupportMI: TMenuItem;
+ MurphyMI: TMenuItem;
+ ToDoMI: TMenuItem;
+ Beta1: TMenuItem;
+ UniKeycYcnusde1: TMenuItem;
+ YToolscYcnusde1: TMenuItem;
+ YPanelscYcnusde1: TMenuItem;
+ Usedenginescomponents1: TMenuItem;
+ PrefToolscYcnusde1: TMenuItem;
+ BugReportsRequests1: TMenuItem;
+ murphycYcnusde1: TMenuItem;
+ Credits2: TMenuItem;
+ News1: TMenuItem;
+ cYcnus1: TMenuItem;
+ Contact1: TMenuItem;
+ N2: TMenuItem;
+ IjustwantCONTACT1: TMenuItem;
+ N9: TMenuItem;
+ AnotherPluto1: TMenuItem;
+ UniKeyDemoMI: TMenuItem;
+ Path1: TMenuItem;
+ RegisterPlugIns1: TMenuItem;
+ UniPluginOD: TOpenDialog;
+ SwapLM_CUB: TButton;
+ PathE: TEdit;
+ ShowLoadreport1: TMenuItem;
+ KillPluto1: TMenuItem;
+ ShowPlatform1: TMenuItem;
+ MSConfig1: TMenuItem;
+ TimetoRelaxMI: TMenuItem;
+ N10: TMenuItem;
+
+ procedure FormCreate(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure InsertPathClick(Sender: TObject);
+
+ procedure StatusBarResize(Sender: TObject);
+ procedure StatusBarDblClick(Sender: TObject);
+ procedure StatusBarUpdate;
+ procedure CopyPathClick(Sender: TObject);
+
+ procedure SetStatus;
+ procedure GotoKey(Key: string);
+ procedure FindCLSID;
+ procedure GotoCLSID;
+ procedure UserGotoKey;
+ procedure ShowRealPathMIClick(Sender: TObject);
+ procedure PathEKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure PathEChange(Sender: TObject);
+ procedure PathEExit(Sender: TObject);
+
+ procedure AppActivate(Sender: TObject);
+ procedure PathEKeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure ActivateIt(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure FormDeactivate(Sender: TObject);
+ procedure Pluto1Click(Sender: TObject);
+ procedure RegEdit1Click(Sender: TObject);
+ procedure Free1Click(Sender: TObject);
+ procedure BigVal1Click(Sender: TObject);
+ procedure SplashScreen1Click(Sender: TObject);
+ procedure HistoryClick(Sender: TObject);
+ procedure Credits1Click(Sender: TObject);
+
+ function Greeting(Name: string = NoPreBlinkHint): string;
+ procedure PrefMIClick(Sender: TObject);
+ procedure EditBoolStrMIClick(Sender: TObject);
+ procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+ procedure SisyTerminate(Sender: TObject);
+ procedure OnSisyChange(Sender: TSisyThread; Change: TSisyChange);
+ procedure OnSisyValuePlus(Sender: TSisyThread; Change: TSisyChange);
+ procedure OnSisyValueMinus(Sender: TSisyThread; Change: TSisyChange);
+ procedure OnSisyContextChange(Sender: TSisyThread; Change: TSisyChange);
+
+ procedure Plutoini1Click(Sender: TObject);
+ procedure RegEdit2Click(Sender: TObject);
+ procedure SysEdit1Click(Sender: TObject);
+ procedure NotePad1Click(Sender: TObject);
+ procedure WordPad1Click(Sender: TObject);
+ procedure OpenWinDir1Click(Sender: TObject);
+ procedure OpenProgramFolder1Click(Sender: TObject);
+ procedure ExitPluto1Click(Sender: TObject);
+ procedure Find1Click(Sender: TObject);
+ procedure FormPaint(Sender: TObject);
+
+ procedure Load;
+ procedure StatusBarDrawPanel(StatusBar: TStatusBar;
+ Panel: TStatusPanel; const Rect: TRect);
+ procedure PathEKeyPress(Sender: TObject; var Key: Char);
+ procedure HintBlinkTTimer(Sender: TObject);
+ procedure FindCLSID1Click(Sender: TObject);
+ procedure GotoCLSID1Click(Sender: TObject);
+ procedure CommandLineParameters1Click(Sender: TObject);
+ procedure WebLinkMIClick(Sender: TObject);
+ procedure DeleteTempFolder1Click(Sender: TObject);
+ procedure CurrentDir1Click(Sender: TObject);
+ procedure RepairPluto155bBug1Click(Sender: TObject);
+ procedure BackupRegistryscanreg1Click(Sender: TObject);
+ procedure SisyStarted(Sender: TObject);
+ procedure StopHintBlinking;
+ procedure Username1Click(Sender: TObject);
+ procedure SupportMIClick(Sender: TObject);
+ procedure ToDoMIClick(Sender: TObject);
+ procedure MailLinkMIClick(Sender: TObject);
+ procedure IjustwantCONTACT1Click(Sender: TObject);
+ procedure ExternalHexEditMIClick(Sender: TObject);
+ procedure AnotherPluto1Click(Sender: TObject);
+ procedure Path1Click(Sender: TObject);
+ procedure RegisterPlugIns1Click(Sender: TObject);
+ procedure FormResize(Sender: TObject);
+ procedure SwapLM_CUBClick(Sender: TObject);
+ procedure ShowLoadreport1Click(Sender: TObject);
+ procedure KillPluto1Click(Sender: TObject);
+ procedure ShowPlatform1Click(Sender: TObject);
+ procedure MSConfig1Click(Sender: TObject);
+ procedure TimetoRelaxMIClick(Sender: TObject);
+ private
+ DoAutoComplete: Boolean;
+ MainWinLoaded: Boolean;
+ DontSavePrefs: Boolean;
+ PreBlinkHint: string;
+ end;
+
+var
+ MainWin: TMainWin;
+
+ StatusBar: TStatusBar;
+ MainReg: TXRegistry;
+
+ SpyThread: TRegSpyThread;
+ Sisys: TList;
+
+function TempDir: string;
+function PlutoUniPath: string;
+function PlutoIniFileName: string;
+
+function PathOfNode(Node: TTreeNode): string;
+function CurKey(AllowedShortcutTypes: TUniHostTypes = []): TRegPath;
+
+procedure ArrangePlutoStyle;
+procedure ArrangeRegEdStyle;
+procedure ArrangeFreeStyle;
+procedure ArrangeBigValStyle;
+
+procedure ActivateThis(Sender: TObject);
+procedure DeActivateThis(Sender: TObject);
+
+procedure SwapFonts(Sender: TWinControl);
+
+procedure AddHint(const Hint: string; Blinking: Boolean = False);
+procedure AddToLastHint(Appendix: string);
+procedure ChangeLastHint(NewHint: string);
+
+implementation
+
+uses
+ //Forms
+ FindWinU, valuesU, TreeU, WorkU, splash, PrefU,
+ //Units
+ Clock, Start, keybrd, CompEx, Colors, FindAllThread,
+ PrefTools;
+
+{$R *.DFM}
+
+var
+ SavedPlutoIniFileName: string = '';
+
+procedure AddHint(const Hint: string; Blinking: Boolean = False);
+begin
+ if Assigned(WorkWin) then
+ WorkWin.AddAHint(Hint);
+
+ with MainWin do begin
+ StopHintBlinking;
+
+ if Blinking then begin
+ HintBlinkT.Enabled := True;
+ if PreBlinkHint = NoPreBlinkHint then
+ PreBlinkHint := StatusBar.Panels[0].Text;
+ StatusBar.Panels[0].Text := WorkWin.LastHint;
+ end;
+ end;
+end;
+
+procedure AddToLastHint(Appendix: string);
+begin
+ with WorkWin.HintLB.Items do begin
+ if Count = 0 then
+ Exit;
+
+ Strings[Count-1] := Strings[Count-1] + Appendix;
+ end;
+ Application.ProcessMessages;
+// Sleep(1000);
+end;
+
+procedure ChangeLastHint(NewHint: string);
+begin
+ with WorkWin.HintLB.Items do begin
+ if Count = 0 then
+ Exit;
+
+ Strings[Count-1] := NewHint;
+ end;
+ Application.ProcessMessages;
+// Sleep(1000);
+end;
+
+function CurKey(AllowedShortcutTypes: TUniHostTypes = []): TRegPath;
+var
+ s: string;
+ Item: TListItem;
+begin
+ if Assigned(RegTV.Selected) then begin
+ s := PathOfNode(RegTV.Selected);
+ if AllowedShortcutTypes <> [] then
+ s := TraceKey(s, AllowedShortcutTypes);
+ Result.Root := ExRegRoot(s);
+ Result.Key := ExRegKey(s);
+
+ Item := ValueList.ItemFocused;
+ if Assigned(Item) then
+ Result.Value := RealValueName(Item);
+ Result.ValueSet := Assigned(Item);
+ end;
+end;
+
+function PathOfNode(Node: TTreeNode): string;
+begin
+ Result := '';
+
+ if not Assigned(Node) then
+ Exit;
+
+ if Assigned(Node.Parent) then
+ Result := LWPSlash(PathOfNode(Node.Parent)) + Node.Text
+ else
+ Result := Node.Text;
+end;
+
+procedure TMainWin.AppActivate(Sender: TObject);
+var
+ ActForm: TCustomForm;
+
+ procedure TryShow(Win: TCustomForm);
+ begin
+ if Assigned(Win) and Win.Visible then
+ Win.Show;
+ end;
+
+begin
+ ActForm := Screen.ActiveCustomForm; //LastActiveForm;
+ TryShow(ValuesWin);
+ TryShow(WorkWin);
+ TryShow(TreeWin);
+ TryShow(FindWin);
+ TryShow(SplashWin);
+ TryShow(MainWin);
+ TryShow(ActForm);
+end;
+
+procedure TMainWin.FormCreate(Sender: TObject);
+
+ procedure InitHKEYString(var H: THKEYString; const Long, Short: string;
+ Handle: Integer = 0; IsDefault: Boolean = False);
+ begin
+ H.Long := Long;
+ H.Short := Short;
+ H.Handle := Handle;
+ H.IsDefault := IsDefault;
+ end;
+
+begin
+{$IFDEF UNIKEY}
+{$IFDEF CYCFS}
+ RegisterUniClass('Y:\programme\unikey\cyc_fs.uni');
+{$ENDIF}
+{$ENDIF}
+
+ Application.OnActivate := AppActivate;
+ PlutoMain.StatusBar := StatusBar;
+
+ //Creating
+ MainReg := TXRegistry.Create;
+
+ //Initialize
+ Caption := 'cYcnus.Pluto ' + Version;
+ PreBlinkHint := NoPreBlinkHint;
+
+ SetLength(HKEYStrings, Length(HKEYStrings) + 2);
+ InitHKEYString(HKEYStrings[LastDefaultHKEYString + 1],
+ 'HKEY_WindowsMachine', 'HKWM');
+
+ InitHKEYString(HKEYStrings[LastDefaultHKEYString + 2],
+ 'HKEY_WindowsUser', 'HKWU');
+
+ Application.HintHidePause := -1; //that's approximately 136 years :D
+
+ StatusBar.Panels[0].Width := Screen.Width div 6;
+
+ MurphyMI.Visible := MurphyMode;
+
+{$IFDEF UNIKEY}
+ UniPluginOD.InitialDir := MyDir;
+{$ELSE}
+ UniKeyDemoMI.Visible := False;
+{$ENDIF}
+end;
+
+procedure TMainWin.GotoKey(Key: string);
+var
+ Full: TregPath;
+ Node: TTreeNode;
+ keySA: TStrA;
+ i: integer;
+
+ function NodeOfRoot(Root: string): TTreeNode;
+ var
+ i: Integer;
+ begin
+ Result := nil;
+ Root := LongHKEY(Root);
+
+ for i := 0 to RootNodes.Count-1 do
+ if SameText(TTreeNode(RootNodes[i]).Text, Root) then begin
+ Result := TTreeNode(RootNodes[i]);
+ Break; end;
+
+ for i := 0 to High(Shortcuts) do
+ if SameText(Shortcuts[i].Alias, Full.Root) then begin
+ Result := Shortcuts[i].Node;
+ Break; end;
+ end;
+
+begin
+ keySA := nil;
+
+ //Get FullPath of the Key
+ Key := TrimLeft(Key);
+ if TextAtPos(Key, 1, 'Reg:') then
+ Key := TrimLeft(FromChar(Key, ':'));
+ Key := UnQuote(Key);
+
+ Full := RegPathOfStr(Key);
+ if Trim(Full.Root) = '' then begin
+ AddHint('Empty Path.', True);
+ Exit; end;
+
+ //Get Root Node
+ Node := NodeOfRoot(Full.Root);
+ if not Assigned(Node) then begin
+ if not PathE.Focused then
+ AddHint('Key not found:' + EOL + Key);
+ Exit; end;
+
+ //Create an array of all SubKeys
+ keySA := Split(Full.Key, '\');
+
+ //Avoid SmartExpand
+ TreeWin.DoSmartExpand := False; begin
+
+ //Open all SubKeys
+ for i := 0 to High(keySA) do begin
+ //Open the Node if neccessary
+ if not Node.Expanded then begin
+ if not Node.Selected then
+ RegTV.Selected := Node;
+ CheckNode(Node, False);
+ //TreeWin.RegTVChange(Self, Node);
+ Node.Expand(False);
+ end;
+
+ //Get Node of the SubKey
+ Node := FindNodeText(Node, keySA[i]);
+ if not Assigned(Node) then begin
+ if not PathE.Focused then
+ AddHint('Goto Key not found: ' + KeySA[i], True);
+ Exit;
+ end;
+ end;
+
+ end; TreeWin.DoSmartExpand := True;
+
+ if Node <> RegTV.Selected then begin
+ RegTV.Selected := Node;
+ TreeWin.RegTVChange(Self, Node);
+ end;
+
+ Application.ProcessMessages;
+
+ if Full.ValueSet then
+ ValuesWin.FocusItem(Full.Value, not (Active and PathE.Focused))
+ else begin
+ if not (Active and PathE.Focused) then //if not user is currently editing the path
+ TreeWin.FocusControl(RegTV);
+
+ if LastChar(Full.Key) = '\' then
+ Node.Expand(False);
+ end;
+end;
+
+procedure SwapFonts(Sender: TWinControl);
+
+ function OtherFont(N: TFontName): TFontName;
+ begin
+ Result := 'Courier New';
+ if N = Result then
+ Result := 'Arial';
+ end;
+
+begin
+ TEdit(Sender).Font.Name := OtherFont(TTreeView(Sender).Font.Name);
+end;
+
+procedure ActivateThis(Sender: TObject);
+begin
+ if not Assigned(Sender) then
+ Exit;
+
+ with TEdit(Sender) do begin
+ if Tag <> EditControlFlag then
+ Exit;
+ Color := RealColor(clVeryBrightBlue);
+ Font.Color := clBlack;
+ end;
+end;
+
+procedure DeActivateThis(Sender: TObject);
+begin
+ if not Assigned(Sender) then
+ Exit;
+
+ with TEdit(Sender) do begin
+ if Tag <> EditControlFlag then
+ Exit;
+ Color := RealColor(clDarkGray);
+ Font.Color := clWhite;
+ end;
+end;
+
+procedure CreateSisyThreads;
+var
+ i: Integer;
+
+ procedure CreateSisyThread(const Name: string; const KeyName: string;
+ Key: HKEY; StatusLabel: TLabel);
+ var
+ Sisy: TSisyThread;
+ begin
+ ChangeLastHint('Creating ' + Name + '...');
+ Sisy := TSisyThread.CreateIt(Name, KeyName, Key, StatusLabel, PlutoKey);
+ Sisy.OnChange := MainWin.OnSisyChange;
+// Sisy.OnSpecialChange[cValuePlus] := MainWin.OnSisyValuePlus;
+// Sisy.OnSpecialChange[cValueMinus] := MainWin.OnSisyValueMinus;
+// Sisy.OnSpecialChange[cContextChange] := MainWin.OnSisyContextChange;
+ Sisys.Add(Sisy);
+ AddToLastHint('OK');
+ end;
+
+begin
+ AddHint('Starting Sisyphus ' + SisyVersion + '...');
+
+ Sisys := TSisyList.Create;
+ WorkWin.LoadSisyFilter;
+
+ CreateSisyThread('Sisy HKU', 'HKU', HKU, WorkWin.SisyHKUL);
+ CreateSisyThread('Sisy HKLM', 'HKLM', HKLM, WorkWin.SisyHKLML);
+
+ ChangeLastHint('Initializing Sisyphus...');
+ for i := 0 to Sisys.Count-1 do
+ with TSisyThread(Sisys[i]) do begin
+ if Name = 'Sisy HKU' then
+ with WorkWin.SisyHKUCB do begin
+ Settings.KeyName := StrOfUni(Uni.Path);
+ Settings.Load;
+ Settings.AutoSave := True;
+ if Checked then
+ Resume;
+ end
+ else if Name = 'Sisy HKLM' then
+ with WorkWin.SisyHKLMCB do begin
+ Settings.KeyName := StrOfUni(Uni.Path);
+ Settings.Load;
+ Settings.AutoSave := True;
+ if Checked then
+ Resume;
+ end;
+ OnStarted := MainWin.SisyStarted;
+ end;
+end;
+
+procedure CreateSpyThread;
+begin
+ AddHint('Creating SpyThread...');
+ SpyThread := TRegSpyThread.CreateIt(tpLowest);
+ WorkWin.SpyDelayIEChange(MainWin);
+ WorkWin.SpyTestLClick(MainWin);
+ AddToLastHint('OK');
+end;
+
+procedure ShowParams;
+var
+ SL: TStringList;
+begin
+ if Switch('params?') then begin
+ SL := TStringList.Create;
+ GetParams(SL);
+ ShowMessage(SL.Text);
+ SL.Free;
+ end;
+end;
+
+procedure GotoParamKey;
+var
+ s: string;
+begin
+ s := ParamStr(1);
+ if (s <> '')
+ and (s[1] <> '-') then begin //Params have '-' as prefix
+ AddHint('Goto Key ' + Quote(s) + '...');
+ MainWin.GotoKey(s);
+ end else begin
+ RegTV.Selected := RegTV.TopItem;
+ end;
+end;
+
+procedure TMainWin.Load;
+begin
+ TreeWin.Load;
+ WorkWin.LoadBoolStr;
+
+ CreateSpyThread;
+ CreateSisyThreads;
+
+ AddHint(Greeting, True);
+
+ ShowParams;
+ GotoParamKey;
+
+ if Assigned(SplashWin) and SplashWin.Visible then
+ SplashWin.SetFocus;
+end;
+
+procedure TMainWin.CopyPathClick(Sender: TObject);
+begin
+ Clipboard.AsText := StatusBar.Panels[1].Text;
+end;
+
+procedure TMainWin.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if (ssAlt in shift) and (Key = VK_F4) then begin
+ Key := 0;
+ Close;
+ Exit; end;
+
+ if ssCtrl in Shift then
+ case Key of
+ Byte('W'): begin
+ MainPC.ActivePage := WorkWin.WorkPage;
+ if Assigned(MainPC.ActivePage) then
+ WorkWin.FocusControl(TWinControl(ShowPC.ActivePage.Tag))
+ end;
+
+ Byte('H'): MainPC.ActivePage := WorkWin.HintPage;
+
+ Byte('L'): MainWin.FindCLSID;
+ end;
+
+ if Shift = [] then
+ case Key of
+ VK_F6: TreeWin.FocusControl(RegTV);
+
+ VK_F7: with ValueList do begin
+ ValuesWin.FocusControl(ValueList);
+ if (Selected = nil) and (Items.Count > 0) then begin
+ Selected := Items[0];
+ ItemFocused := Selected;
+ end;
+ end;
+
+ VK_F8: WorkWin.FocusControl(MainPC);
+ end;
+
+ if Key = VK_SCROLL then begin
+ TreeWin.CheckRegTVHotTrack;
+ ValuesWin.CheckValueListHotTrack;
+ end;
+end;
+
+procedure TMainWin.StatusBarResize(Sender: TObject);
+begin
+ with StatusBar do
+ Panels[1].Width :=
+ Width - (Panels[0].Width + Panels[2].Width + Panels[3].Width);
+end;
+
+procedure TMainWin.StatusBarDblClick(Sender: TObject);
+begin
+ ShowRealPathMIClick(Sender);
+end;
+
+procedure TMainWin.InsertPathClick(Sender: TObject);
+begin
+ GotoKey(Clipboard.AsText);
+end;
+
+procedure TMainWin.SetStatus;
+begin
+ StatusBarUpdate;
+end;
+
+procedure TMainWin.StatusBarUpdate;
+var
+ Inf: TRegKeyInfo;
+begin
+ OpenCurKey;
+ MainReg.GetKeyInfo(Inf);
+ MainReg.CloseKey;
+
+ StatusBar.Panels[2].Text := StrNumerus(Inf.NumSubKeys, 'key', 'keys', 'no');
+ StatusBar.Panels[3].Text := StrNumerus(Inf.NumValues, 'value', 'values', 'no');
+
+ if ShowRealPathMI.Checked then
+ StatusBar.Panels[1].Text := StrOfRegPath(CurKey(uhShortcuts))
+ else
+ StatusBar.Panels[1].Text := StrOfRegPath(CurKey(uhNonSystemShortcuts));
+
+ if not PathE.Focused then
+ PathE.Text := StrOfRegPath(CurKey);
+end;
+
+procedure TMainWin.ShowRealPathMIClick(Sender: TObject);
+begin
+ ShowRealPathMI.Checked := not ShowRealPathMI.Checked;
+ StatusBarUpdate;
+end;
+
+procedure TMainWin.PathEKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+var
+ Pos: Integer;
+ s: string;
+begin
+ DoAutoComplete := not (Key in [VK_DELETE, VK_BACK, VK_ESCAPE]);
+
+ case Key of
+ VK_BACK:
+ begin
+ s := PathE.Text;
+ Pos := PathE.SelStart;
+
+ if ssCtrl in Shift then
+ repeat
+ Dec(Pos);
+ until (Pos < 1) or (s[Pos] = '\')
+ else if PathE.SelLength = 0 then
+ Exit;
+
+ PathE.Text := Copy(s, 1, Pos);
+ PathE.SelStart := Length(s);
+ Key := 0;
+ UserGotoKey;
+ end;
+
+ VK_ESCAPE:
+ with PathE do begin
+ if SelLength = 0 then
+ Exit;
+ Text := StrOfRegPath(CurKey);
+ SelStart := Length(Text);
+ end;
+
+ VK_RETURN: begin
+ if CurKey.ValueSet then
+ ValuesWin.ValueListDblClick(Self);
+ Key := 0;
+ end;
+
+ VK_RIGHT: begin
+ if not (ssCtrl in Shift) then
+ Exit;
+
+ Key := 0;
+
+ s := PathE.Text;
+ Pos := PathE.SelStart + 1;
+ repeat
+ Inc(Pos);
+ until (Pos > Length(s)) or (s[Pos] = '\');
+
+ PathE.SelStart := Pos - 1;
+ end;
+
+ VK_LEFT: begin
+ if not (ssCtrl in Shift) then
+ Exit;
+
+ with PathE do begin
+ Key := 0;
+
+ s := Text;
+ Pos := SelStart;
+ repeat
+ Dec(Pos);
+ until (Pos < 1) or (s[Pos] = '\');
+
+ if Pos < 1 then
+ Pos := 1;
+
+ SelStart := Pos - 1;
+ end;
+ end;
+ end;
+end;
+
+procedure TMainWin.UserGotoKey;
+begin
+ GotoKey(PathE.Text);
+end;
+
+procedure TMainWin.PathEChange(Sender: TObject);
+var
+ Prefix, Suffix, Key, Path, Root: string;
+ i, p, Len: Integer;
+ SL: TStringList;
+ CompleteKind: (ckRoots, ckKeys, ckValues);
+
+ procedure GetRootNames(Strings: TStrings);
+ var
+ Node: TTreeNode;
+ begin
+ SL.Clear;
+ Node := RegTV.Items.GetFirstNode;
+ while Assigned(Node) do begin
+ SL.Add(Node.Text);
+ Node := Node.GetNextSibling;
+ end;
+ end;
+
+begin
+ if not DoAutoComplete then
+ Exit;
+
+ Key := PathE.Text;
+ Root := TraceKey(ExRegRoot(Key));
+
+ if not CharIn(Key, '\') then
+ CompleteKind := ckRoots
+ else if ExRegValueSet(Key) then
+ CompleteKind := ckValues
+ else
+ CompleteKind := ckKeys;
+
+ case CompleteKind of
+ ckRoots: begin
+ Prefix := '';
+ Suffix := Key;
+ end;
+
+ ckKeys: begin
+ Path := ExRegFullKey(Key);
+ Prefix := UntilLastChar(Path, '\');
+ Suffix := FromLastChar(Path, '\');
+ end;
+
+ ckValues: begin
+ p := Pos('\\', Key);
+ Prefix := Copy(Key, 1, p - 1);
+ Suffix := Copy(Key, p + 2, Length(Key) - p - 1);
+ end;
+
+ else
+ end;
+
+ SL := TStringList.Create;
+
+ if CompleteKind in [ckKeys, ckValues] then
+ with MainReg do begin
+ RootKey := HKEYOfStr(ExRegRoot(Root));
+ OpenKey(ExRegKey(Root));
+ OpenKey(ExRegKey(Prefix));
+
+ if CompleteKind = ckValues then begin
+ if not HasValues then
+ Exit;
+ GetValueNames(SL);
+ end else if CompleteKind = ckKeys then begin
+ if not HasSubKeys then
+ Exit;
+ GetKeyNames(SL);
+ end;
+
+ CloseKey;
+ end
+ else begin
+ GetRootNames(SL);
+ end;
+
+ if Suffix = '' then begin
+ if (SL.Count > 0) and not StrIn(SL, '') then
+ Suffix := SL[0];
+ end else begin
+ for i := 0 to SL.Count-1 do
+ if TextAtBegin(SL[i], Suffix) then begin
+ Suffix := SL[i];
+ Break; end;
+ end;
+
+ Len := Length(PathE.Text);
+
+ if CompleteKind = ckValues then
+ Prefix := Prefix + '\\'
+ else if CompleteKind = ckKeys then
+ Prefix := Prefix + '\';
+
+ with PathE do begin
+ DoAutoComplete := False; //Avoid Recursion
+ Text := Prefix + Suffix;
+ DoAutoComplete := True;
+
+ SelStart := Len;
+ SelLength := Length(Text) - Len;
+ end;
+
+ SL.Free;
+end;
+
+procedure TMainWin.PathEExit(Sender: TObject);
+begin
+ DeActivateThis(PathE);
+ DoAutoComplete := False;
+end;
+
+procedure ArrangePlutoStyle;
+begin
+ with ValuesWin do begin
+ Height := MainWin.ClientHeight div 3;
+ Top := MainWin.ClientHeight - Height - 43;
+ Left := 0;
+ Width := MainWin.ClientWidth - 4;
+ //Align := alBottom;
+ end;
+
+ with WorkWin do begin
+ Top := 0;
+ Width := Max(MainWin.ClientWidth div 3, WorkWin.Constraints.MinWidth);
+ Left := ValuesWin.Width - Width;
+ Height := MainWin.ClientHeight - 43 - ValuesWin.Height;
+ //Align := alRight;
+ end;
+
+ with TreeWin do begin
+ Top := 0;
+ Height := WorkWin.Height;
+ Left := 0;
+ Width := ValuesWin.Width - WorkWin.Width;
+ end;
+
+ {TreeWin.Align := alNone;
+ WorkWin.Align := alNone;
+ ValuesWin.Align := alNone;}
+end;
+
+procedure ArrangeFreeStyle;
+const
+ Space = 10;
+begin
+ with ValuesWin do begin
+ Height := Screen.Height div 3;
+ Align := alBottom;
+ end;
+
+ with WorkWin do begin
+ Width := Max(Screen.WorkAreaWidth div 3, Constraints.MinWidth + 2 * Space);
+ Align := alRight;
+ end;
+
+ with TreeWin do begin
+ Align := alClient;
+ end;
+
+ TreeWin.Align := alNone;
+ WorkWin.Align := alNone;
+ ValuesWin.Align := alNone;
+
+ with ValuesWin do begin
+ Height := Height - 2 * Space;
+ Width := Width - 2 * Space;
+ Top := Top + Space;
+ Left := Left + Space;
+ end;
+
+ with TreeWin do begin
+ Height := Height - 1 * Space;
+ Width := Width - 1 * Space;
+ Top := Top + Space;
+ Left := Left + Space;
+ end;
+
+ with WorkWin do begin
+ Height := Height - 1 * Space;
+ Width := Width - 2 * Space;
+ Top := Top + Space;
+ Left := Left + Space;
+ end;
+end;
+
+procedure ArrangeBigValStyle;
+var
+ MinHeight: Integer;
+begin
+ MinHeight := WorkWin.Constraints.MinHeight +
+ MainWin.Constraints.MinHeight;
+
+ with ValuesWin do begin
+ Height := Screen.WorkAreaHeight - Max(Screen.Height div 3, MinHeight);
+ Align := alBottom;
+ end;
+
+ with WorkWin do begin
+ Width := Screen.WorkAreaWidth div 3;
+ Align := alRight;
+ end;
+
+ with TreeWin do begin
+ Align := alClient;
+ end;
+
+ TreeWin.Align := alNone;
+ WorkWin.Align := alNone;
+ ValuesWin.Align := alNone;
+end;
+
+procedure ArrangeRegEdStyle;
+begin
+ with TreeWin do begin
+ Width := Screen.WorkAreaWidth div 4;
+ Align := alLeft;
+ end;
+
+ with ValuesWin do begin
+ Align := alClient;
+ Align := alNone;
+ Height := Height - WorkWin.Constraints.MinHeight;
+ end;
+
+ with WorkWin do begin
+ Top := ValuesWin.Top + ValuesWin.Height;
+ Left := ValuesWin.Left;
+ Height := Constraints.MinHeight;
+ Width := ValuesWin.Width;
+ end;
+
+ TreeWin.Align := alNone;
+end;
+
+procedure TMainWin.PathEKeyUp(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if not (Key in [VK_DELETE, VK_BACK, VK_ESCAPE]) then
+ UserGotoKey;
+end;
+
+procedure TMainWin.ActivateIt(Sender: TObject);
+begin
+ ActivateThis(Sender);
+end;
+
+procedure TMainWin.FormActivate(Sender: TObject);
+begin
+ if Assigned(ActiveControl) and (ActiveControl.Tag = EditControlFlag) then
+ ActivateThis(ActiveControl);
+end;
+
+procedure TMainWin.FormDeactivate(Sender: TObject);
+begin
+ if Assigned(ActiveControl) and (ActiveControl.Tag = EditControlFlag) then
+ DeActivateThis(ActiveControl);
+end;
+
+procedure TMainWin.Pluto1Click(Sender: TObject);
+begin
+ ArrangePlutoStyle;
+end;
+
+procedure TMainWin.RegEdit1Click(Sender: TObject);
+begin
+ ArrangeRegEdStyle;
+end;
+
+procedure TMainWin.Free1Click(Sender: TObject);
+begin
+ ArrangeFreeStyle;
+end;
+
+procedure TMainWin.BigVal1Click(Sender: TObject);
+begin
+ ArrangeBigValStyle;
+end;
+
+procedure TMainWin.SplashScreen1Click(Sender: TObject);
+begin
+ SplashWin.Show;
+end;
+
+procedure TMainWin.HistoryClick(Sender: TObject);
+begin
+ NotePad(PlutoDir + 'version.txt');
+end;
+
+procedure TMainWin.WebLinkMIClick(Sender: TObject);
+begin
+ Browse('http://' + TMenuItem(Sender).Caption);
+end;
+
+procedure TMainWin.SupportMIClick(Sender: TObject);
+begin
+ Browse('http://cYcnus.de/php/phpbb/viewforum.php?f=1');
+end;
+
+procedure TMainWin.Credits1Click(Sender: TObject);
+var
+ FileName: string;
+begin
+ FileName := PlutoDir + 'credits deluxe.htm';
+ if FileExists(FileName) then
+ ExecFile(FileName)
+ else begin
+ FileName := PlutoDir + 'credits.htm';
+ if FileExists(FileName) then
+ ExecFile(FileName);
+ end;
+end;
+
+function GetCLSIDFromClipboard: string;
+var
+ CLSID: string;
+begin
+ CLSID := BetweenChars(Clipboard.AsText, '{', '}', True);
+ if CLSID = '' then begin
+ Result := Clipboard.AsText;
+ InputQuery('No CLSID in Clipboard.',
+ 'Use following format:' + EOL +
+ '{00000000-0000-0000-0000-000000000000}', Result);
+ Exit; end else
+ Result := CLSID;
+end;
+
+procedure TMainWin.FindCLSID;
+var
+ CLSID, Desc: string;
+begin
+ CLSID := GetCLSIDFromClipboard;
+ Desc := RegNameOfCLSID(CLSID);
+ if Desc <> '' then
+ InputQuery('Your CLSID is...', CLSID, Desc)
+ else
+ ShowMessage('CLSID not found: ' + CLSID + '.');
+end;
+
+procedure TMainWin.GotoCLSID;
+var
+ CLSID, Desc: string;
+begin
+ CLSID := GetCLSIDFromClipboard;
+ Desc := RegNameOfCLSID(CLSID);
+ if Desc <> '' then begin
+ GotoKey('HKCR\CLSID\' + CLSID);
+ TreeWin.FocusControl(RegTV);
+ end else
+ ShowMessage('CLSID not found: ' + CLSID + '.');
+end;
+
+function TMainWin.Greeting(Name: string = NoPreBlinkHint): string;
+const
+ Alias: array[0..4] of string =
+ ('Licenser', 'Murphy', 'Sleeper', 'Leon', 'Great Admin');
+ RealNames: array[0..4] of string =
+ ('Heinz', 'Korny', 'Sven', 'Simon', 'Korny ;-)');
+var
+ i: Integer;
+ s: string;
+begin
+ if Name = NoPreBlinkHint then
+ Name := PrefWin.UserNameE.Text;
+
+ if Trim(Name) = '' then
+ s := 'No name?'
+ else if SameText(Trim(Name), 'Pluto-User') then
+ s := 'Hi!'
+ else
+ for i := 0 to 4 do
+ if SameText(Name, Alias[i]) then begin
+ s := 'Hi ' + RealNames[i] + '! This is a cYcnus.EasterEgg';
+ Break; end
+ else if Length(Name) > 20 then
+ s := 'Hi ' + Name +
+ '. What a name.'
+ else
+ s := 'Hi ' + Name + '!';
+
+ Result := s;
+end;
+
+procedure TMainWin.PrefMIClick(Sender: TObject);
+begin
+ PrefWin.Show;
+end;
+
+function TempDir: string;
+begin
+ Result := PlutoDir + 'temp\';
+ if not (DirectoryExists(Result) or CreateDir(Result)) then
+ Result := PlutoDir;
+end;
+
+function PlutoIniFileName: string;
+
+ function Default: string;
+ begin
+ Result := MyDir + 'pluto.ini';
+ end;
+
+begin
+ Result := SavedPlutoIniFileName;
+ if Result <> '' then
+ Exit;
+
+// Result := Params.ReadString('ini', '');
+
+ if IsValidFileName(Result) then
+ Result := PlutoDir + Result
+ else
+ Result := Default;
+
+ SavedPlutoIniFileName := Result; //Faster in future calls
+end;
+
+function PlutoUniPath: string;
+begin
+ //Result := 'Reg: HKCU\Software\Pluto\';
+ Result := 'Ini <' + PlutoIniFileName + '>:';
+end;
+
+procedure TMainWin.EditBoolStrMIClick(Sender: TObject);
+begin
+ NotePad(PlutoDir + BoolStrFileName);
+ ShowMessage('Click OK when you finished editing.' + EOL +
+ '(Pluto will reload the Boolean Strings.)');
+ WorkWin.LoadBoolStr;
+end;
+
+procedure TMainWin.SisyStarted(Sender: TObject);
+{var
+ NextSisyIndex: Integer;
+ NextSisy: TSisyThread; }
+begin
+ {NextSisy := nil;
+
+ with TSisyThread(Sender) do begin
+ //AddHint(Format('%s started after %0.1f seconds', [Name, SecsPerRound]), True);
+
+ with Sisys do begin
+ NextSisyIndex := IndexOf(Sender) + 1;
+ if NextSisyIndex < Count then
+ NextSisy := Items[NextSisyIndex];
+ end;
+
+ if Assigned(NextSisy) then
+ with NextSisy do
+ if not Started and Suspended then
+ Resume;
+ end; }
+end;
+
+procedure TMainWin.SisyTerminate(Sender: TObject);
+begin
+ if Assigned(Sisys) then
+ Sisys.Delete(Sisys.IndexOf(Sender));
+ AddHint('Sisyphus ' + Quote(TSisyThread(Sender).Name) + ' destroyed.');
+end;
+
+procedure TMainWin.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
+var
+ i: Integer;
+
+ procedure TerminateThread(Thread: TThread; Name: string);
+ const
+ ThreadTimeOut = 3000;
+ begin
+ if Assigned(Thread) then
+ with Thread do begin
+ Priority := tpNormal;
+ Terminate;
+ while Suspended do Resume; // ensure running
+ if 0 <> WaitForSingleObject(Handle, ThreadTimeOut) then begin
+ ShowMessage('Timeout: Killing Thread: ' + Name + EOL +
+ 'This is a critical error and may cause memory leaks and crashes.' + EOL +
+ 'We recommend to reboot your system before you continue.');
+ Windows.TerminateThread(Handle, 0);
+ end else
+ Thread.Free;
+ end;
+ end;
+
+begin
+ CanClose := False;
+
+ try
+ AddHint('Stopping SisyphusThreads...');
+ if Assigned(Sisys) then
+ for i := 0 to Sisys.Count-1 do
+ TSisyThread(Sisys[i]).Suspend;
+ AddToLastHint('OK');
+
+ AddHint('Wait for SpyThread...');
+ TerminateThread(SpyThread, 'SpyThread');
+ AddToLastHint('OK');
+
+ AddHint('Wait for SisyphusThreads...');
+ if Assigned(Sisys) then
+ for i := 0 to Sisys.Count-1 do begin
+ ChangeLastHint('Wait for SisyphusThreads...' + TSisyThread(Sisys[i]).Name);
+ TerminateThread(TSisyThread(Sisys[i]), TSisyThread(Sisys[i]).Name);
+ end;
+ ChangeLastHint('Wait for SisyphusThreads...OK');
+ except
+ with WorkWin.HintLB.Items do
+ ShowMessage('Error while trying to terminate threads.' + EOL +
+ 'Last Message:' + EOL +
+ Strings[Count - 1]);
+ CanClose := True;
+ end;
+
+ AddHint('Terminating successfull.');
+ CanClose := True;
+end;
+
+procedure TMainWin.FormClose(Sender: TObject; var Action: TCloseAction);
+
+ procedure TryClose(Win: TCustomForm);
+ begin
+ if Assigned(Win) and Win.Visible then
+ Win.Close;
+ end;
+
+begin
+ MainReg.Free;
+
+ Action := caFree;
+
+ if DontSavePrefs then
+ Exit;
+
+ AddHint('Saving settings...');
+
+ try
+ TryClose(WorkWin);
+ TryClose(ValuesWin);
+ TryClose(TreeWin);
+ TryClose(FindWin);
+ TryClose(SplashWin);
+ TryClose(PrefWin);
+ except
+ DontSavePrefs := True; //try again without pref saving
+ end;
+
+ with PlutoKey.GetKey('Window') do
+ try
+ WriteBool('Maximized', WindowState = wsMaximized);
+ if WindowState = wsNormal then begin
+ WriteInteger('Left', Left);
+ WriteInteger('Top', Top);
+ WriteInteger('Width', Width);
+ WriteInteger('Height', Height);
+ end;
+ finally
+ Free;
+ end;
+end;
+
+procedure TMainWin.Plutoini1Click(Sender: TObject);
+begin
+ NotePad(PlutoIniFileName);
+ ShowMessage('Click OK when you finished editing.' + EOL +
+ '(Pluto will reload ' + PlutoIniFileName + ')');
+ PrefWin.PrefHost.Load;
+end;
+
+procedure TMainWin.RegEdit2Click(Sender: TObject);
+begin
+ RegEdit;
+end;
+
+procedure TMainWin.SysEdit1Click(Sender: TObject);
+begin
+ SysEdit;
+end;
+
+procedure TMainWin.NotePad1Click(Sender: TObject);
+begin
+ NotePad;
+end;
+
+procedure TMainWin.WordPad1Click(Sender: TObject);
+begin
+ WordPad;
+end;
+
+procedure TMainWin.OpenWinDir1Click(Sender: TObject);
+begin
+ ExploreFolder(WinDir);
+end;
+
+procedure TMainWin.OpenProgramFolder1Click(Sender: TObject);
+begin
+ ExploreFolder(MyDir);
+end;
+
+procedure TMainWin.ExitPluto1Click(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TMainWin.Find1Click(Sender: TObject);
+begin
+ FindWin.SfRootKeyRB.Checked := True;
+ FindWin.Show;
+end;
+
+procedure TMainWin.FormPaint(Sender: TObject);
+begin
+ if Started and not MainWinLoaded then begin
+ MainWinLoaded := True;
+ Load;
+ end;
+end;
+
+procedure TMainWin.StatusBarDrawPanel(StatusBar: TStatusBar;
+ Panel: TStatusPanel; const Rect: TRect);
+begin
+ with StatusBar.Canvas do begin
+ Brush.Color := clBlack;
+ FillRect(Rect);
+ with Font do begin
+ Name := 'MS Sans Serif';
+ Style := [];
+ case Panel.Index of
+ 0: if HintBlinkT.Enabled then
+ Color := clBrightRed
+ else
+ Color := clBrightSilver;
+ 1: Color := clWhite;
+ 2: Color := clCyan;
+ 3: Color := clBrightPurple;
+ end;
+ end;
+
+ if Panel.Alignment = taRightJustify then
+ TextOut(Rect.Right - TextWidth(Panel.Text), Rect.Top, Panel.Text)
+ else
+ TextOut(Rect.Left, Rect.Top, Panel.Text);
+ end;
+end;
+
+procedure TMainWin.PathEKeyPress(Sender: TObject; var Key: Char);
+begin
+ if Key = #127 then //Silly key management
+ Key := #0;
+end;
+
+procedure TMainWin.HintBlinkTTimer(Sender: TObject);
+begin
+ StatusBar.Panels[0].Text := 'Ready';
+ StopHintBlinking;
+end;
+
+procedure TMainWin.StopHintBlinking;
+begin
+ HintBlinkT.Enabled := False;
+ PreBlinkHint := NoPreBlinkHint;
+end;
+
+procedure TMainWin.FindCLSID1Click(Sender: TObject);
+begin
+ FindCLSID;
+end;
+
+procedure TMainWin.GotoCLSID1Click(Sender: TObject);
+begin
+ GotoCLSID;
+end;
+
+procedure TMainWin.CommandLineParameters1Click(Sender: TObject);
+begin
+ NotePad(PlutoDir + 'Params.txt');
+end;
+
+procedure TMainWin.DeleteTempFolder1Click(Sender: TObject);
+begin
+ if mrYes = MessageDlg('Deleting ' + Quote(TempDir + '*.*' + EOL, '"') +
+ 'Are you sure?', mtConfirmation, [mbYes, mbCancel], 0) then
+ DeleteFiles(TempDir + '*.*', False);
+end;
+
+procedure TMainWin.CurrentDir1Click(Sender: TObject);
+begin
+ ShowMessage('MyDir: ' + MyDir + EOL +
+ 'PlutoDir: ' + PlutoDir + EOL +
+ 'CurrentDir: ' + GetCurrentDir + EOL +
+ 'Params: ' + EOL +
+ GetParams(EOL));
+end;
+
+procedure TMainWin.RepairPluto155bBug1Click(Sender: TObject);
+var
+ Msg: string;
+ Reg: TXRegistry;
+begin
+ Reg := TXRegistry.Create;
+
+ try
+ Reg.RootKey := HKCU;
+ Reg.OpenKey('Software');
+ Msg := '';
+ if Reg.KeyExists('Sisyphus') then
+ Msg := Msg + 'HKCU\Software\Sisyphus' + EOL;
+ if Reg.KeyExists('Main') then
+ Msg := Msg + 'HKCU\Software\Main' + EOL;
+ if Reg.KeyExists('Spy') then
+ Msg := Msg + 'HKCU\Software\Spy' + EOL;
+ if Reg.KeyExists('View') then
+ Msg := Msg + 'HKCU\Software\View' + EOL;
+ if Msg = '' then begin
+ ShowMessage('No bug detected :-)');
+ end else begin
+ Msg :=
+ 'Hi folks!' + EOL +
+ 'We are very sorry: A bug in Pluto made some components in the Edit' + EOL +
+ 'window save their values to the regsitry instead of the ini file.' + EOL +
+ 'If you want to repair that, you have to delete the following keys:' + EOL +
+ EOL +
+ Msg +
+ EOL +
+ 'This is not dangerous at all, but if you are interested in having' + EOL +
+ 'a clean registry, you should delete this useless keys.' + EOL +
+ EOL +
+ 'You surely noticed that this key names are rubish because they are' + EOL +
+ 'in the level that is normally used by programs.' + EOL +
+ 'If you have programs installed that use this keys for their' + EOL +
+ 'preferences, you may get problems when deleting the keys!' + EOL +
+ EOL +
+ 'So, now you have to decide what to do:' + EOL +
+ EOL +
+ 'Yes: Delete the keys. You have to confirm the deleting of each key.' + EOL +
+ 'No: Jump to the Software key and delete manually.' + EOL +
+ 'Cancel: Do nothing.' + EOL +
+ 'Yes to All: Delete all keys.';
+
+ case MessageDlg(Msg, mtWarning, [mbYes, mbNo, mbYesToAll, mbCancel], 0) of
+ mrYes: begin
+ if Reg.KeyExists('Main')
+ and (mrYes=MessageDlg('Delete HKU\Software\Main ?',
+ mtWarning, [mbYes, mbNo], 0)) then
+ Reg.DeleteKey('Main');
+
+ if Reg.KeyExists('Sisyphus')
+ and (mrYes=MessageDlg('Delete HKU\Software\Sisyphus ?',
+ mtWarning, [mbYes, mbNo], 0)) then
+ Reg.DeleteKey('Sisyphus');
+
+ if Reg.KeyExists('Spy')
+ and (mrYes=MessageDlg('Delete HKU\Software\Spy ?',
+ mtWarning, [mbYes, mbNo], 0)) then
+ Reg.DeleteKey('Spy');
+
+ if Reg.KeyExists('View')
+ and (mrYes=MessageDlg('Delete HKU\Software\View ?',
+ mtWarning, [mbYes, mbNo], 0)) then
+ Reg.DeleteKey('View');
+ end;
+
+ mrYesToAll: begin
+ Reg.DeleteKey('Main');
+ Reg.DeleteKey('Sisyphus');
+ Reg.DeleteKey('Spy');
+ Reg.DeleteKey('View');
+ end;
+
+ mrNo: begin
+ TreeWin.SetFocus;
+ GotoKey('HKCU\Software\');
+ end;
+ end;
+ end;
+
+ finally
+ Reg.Free;
+ end;
+end;
+
+procedure TMainWin.BackupRegistryscanreg1Click(Sender: TObject);
+begin
+ ExecFile('scanreg');
+end;
+
+procedure TMainWin.Username1Click(Sender: TObject);
+begin
+ ShowMessage(UserName);
+end;
+
+procedure TMainWin.ToDoMIClick(Sender: TObject);
+begin
+ NotePad(PlutoDir + 'ToDo.txt');
+end;
+
+procedure TMainWin.MailLinkMIClick(Sender: TObject);
+begin
+ MailTo(TMenuItem(Sender).Caption);
+end;
+
+procedure TMainWin.IjustwantCONTACT1Click(Sender: TObject);
+begin
+ MailTo('pluto@cYcnus.de');
+end;
+
+procedure TMainWin.ExternalHexEditMIClick(Sender: TObject);
+begin
+ ExecFile(PrefWin.ExternalHexEditE.Text);
+end;
+
+procedure TMainWin.AnotherPluto1Click(Sender: TObject);
+begin
+ ExecFile(Application.ExeName);
+end;
+
+procedure TMainWin.Path1Click(Sender: TObject);
+begin
+{$IFDEF UNIKEY}
+ UserUniPath := InputBox('UniKey', 'Input an UniPath.' + EOL +
+ EOL +
+ 'No idea? Try one of these: ' + EOL +
+ 'WinAmpVisColor <viscolor.txt>:' + EOL +
+ 'Params:' + EOL +
+ 'Reg: HKCU' + EOL +
+ 'Ini <' + MyDir + 'pluto.ini>:' + EOL +
+ 'Ini <' + MyDir + 'pluto.ini>:[View]' + EOL,
+ UserUniPath);
+{$ENDIF}
+end;
+
+procedure TMainWin.RegisterPlugIns1Click(Sender: TObject);
+begin
+{$IFDEF UNIKEY}
+ if UniPluginOD.Execute then
+ RegisterUniClass(UniPluginOD.FileName);
+{$ENDIF}
+end;
+
+procedure TMainWin.FormResize(Sender: TObject);
+begin
+ ArrangeIcons;
+ ArrangePlutoStyle;
+ WorkWin.WindowState := wsNormal;
+ ValuesWin.WindowState := wsNormal;
+ TreeWin.WindowState := wsNormal;
+end;
+
+procedure TMainWin.SwapLM_CUBClick(Sender: TObject);
+var
+ Path: string;
+begin
+ Path := TraceKey(PathE.Text, uhShortcuts);
+ if SwapHKU_HKLM(Path) then begin
+ PathE.Text := Path;
+ UserGotoKey;
+ end;
+end;
+
+procedure TMainWin.ShowLoadreport1Click(Sender: TObject);
+begin
+ NotePad(MyDir + 'loadreport.txt');
+end;
+
+procedure TMainWin.KillPluto1Click(Sender: TObject);
+begin
+ Application.Terminate;
+end;
+
+procedure TMainWin.ShowPlatform1Click(Sender: TObject);
+begin
+ ShowMessage(Format('Platform: %s' + EOL +
+ 'Versin: %d.%d Build %d',
+ [PlatformStrings[Win32Platform],
+ Win32MajorVersion, Win32MinorVersion, Win32BuildNumber]));
+end;
+
+procedure TMainWin.MSConfig1Click(Sender: TObject);
+begin
+ ExecFile('msconfig');
+end;
+
+procedure TMainWin.TimetoRelaxMIClick(Sender: TObject);
+var
+ RelaxFile: string;
+begin
+ with PlutoKey.GetKey('Main') do
+ try
+ RelaxFile := ReadString('Relax');
+ finally
+ Free;
+ end;
+
+ if RelaxFile = '' then
+ ShowMessage('This menu item can be used for something that lets you relax,' + EOL +
+ 'for example Diablo2, you favorite song or the latest news about the' + EOL +
+ 'decreasing AOL member numbers.' + EOL +
+ EOL +
+ 'Feel free to use everything you want.' + EOL +
+ 'Open the pluto.ini (CTRL+I) and add a new value "Relax" in the "Main"' + EOL +
+ 'section.' + EOL +
+ EOL +
+ 'And don''t forget:' + EOL +
+ 'R E L A X ! ! !')
+ else
+ ExecFile(RelaxFile);
+end;
+
+procedure TMainWin.OnSisyChange(Sender: TSisyThread; Change: TSisyChange);
+
+ procedure UpdateValue;
+ var
+ Reg: TXRegistry;
+ Index: Integer;
+ begin
+ if not SameRegPath(ExRegFullKey(Change.Path), PathOfNode(RegTV.Selected)) then
+ Exit;
+
+ Reg := TXRegistry.Create;
+ try
+ Reg.RootKey := HKEYOfStr(ExRegRoot(Change.Path));
+ if Reg.OpenKey(ExRegKey(Change.Path)) then
+ with ValuesWin do begin
+ Index := FindItemByRealName(ExRegValue(Change.Path));
+ if Index > -1 then begin
+ if Change.Typ = cValueMinus then
+ ValueList.Items.Delete(Index)
+ else if Change.Typ = cContextChange then
+ UpdateValue(Reg, ValueList.Items[Index]);
+ end else if Change.Typ = cValuePlus then
+ AddValue(Reg, ExRegValue(Change.Path));
+ end;
+ finally
+ Reg.Free;
+ end;
+ end;
+
+begin
+ AddHint(Sender.Name + ' notified ' + Change.Path);
+ if Change.Typ in [cValueMinus, cValuePlus, cContextChange] then
+ UpdateValue;
+end;
+
+procedure TMainWin.OnSisyValuePlus(Sender: TSisyThread; Change: TSisyChange);
+var
+ Reg: TXRegistry;
+begin
+ if not SameRegPath(ExRegFullKey(Change.Path), PathOfNode(RegTV.Selected)) then
+ Exit;
+
+ Reg := TXRegistry.Create;
+ try
+ Reg.RootKey := HKEYOfStr(ExRegRoot(Change.Path));
+ if Reg.OpenKey(ExRegKey(Change.Path)) then
+ ValuesWin.AddValue(Reg, ExRegValue(Change.Path));
+ finally
+ Reg.Free;
+ end;
+end;
+
+procedure TMainWin.OnSisyValueMinus(Sender: TSisyThread; Change: TSisyChange);
+var
+ Reg: TXRegistry;
+ Index: Integer;
+begin
+ if not SameRegPath(ExRegFullKey(Change.Path), PathOfNode(RegTV.Selected)) then
+ Exit;
+
+ Reg := TXRegistry.Create;
+ try
+ Reg.RootKey := HKEYOfStr(ExRegRoot(Change.Path));
+ if Reg.OpenKey(ExRegKey(Change.Path)) then
+ with ValuesWin do begin
+ Index := FindItemByRealName(ExRegValue(Change.Path));
+ if Index > -1 then
+ ValueList.Items.Delete(Index);
+ end;
+ finally
+ Reg.Free;
+ end;
+end;
+
+procedure TMainWin.OnSisyContextChange(Sender: TSisyThread; Change: TSisyChange);
+var
+ Reg: TXRegistry;
+ Index: Integer;
+begin
+ if not SameRegPath(ExRegFullKey(Change.Path), PathOfNode(RegTV.Selected)) then
+ Exit;
+
+ Reg := TXRegistry.Create;
+ try
+ Reg.RootKey := HKEYOfStr(ExRegRoot(Change.Path));
+ if Reg.OpenKey(ExRegKey(Change.Path)) then
+ with ValuesWin do begin
+ Index := FindItemByRealName(ExRegValue(Change.Path));
+ if Index > -1 then
+ UpdateValue(Reg, ValueList.Items[Index]);
+ end;
+ finally
+ Reg.Free;
+ end;
+end;
+
+end.
+unit PrefU;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, ComCtrls, ExtCtrls, StdCtrls, PlutoConst, NewPanels, PrefTools,
+ YTools, YTypes, start, XReg, LinkLabel;
+
+type
+ TPrefWin = class(TForm)
+ PrefPC: TPageControl;
+ CommonPage: TTabSheet;
+ KeyPage: TTabSheet;
+ DataPage: TTabSheet;
+ KeysBP: TBorderPanel;
+ GroupBox3: TGroupBox;
+ MainPrevBP: TBorderPanel;
+ GroupBox4: TGroupBox;
+ BorderPanel6: TBorderPanel;
+ GroupBox6: TGroupBox;
+ SortKeysCB: TPrefCheckBox;
+ PrefHost: TPrefHost;
+ MainPreviewCB: TPrefCheckBox;
+ SplashScreenCB: TPrefCheckBox;
+ PrefValuesPC: TPageControl;
+ StringPage: TTabSheet;
+ MultiStringPage: TTabSheet;
+ IntPage: TTabSheet;
+ BinaryPage: TTabSheet;
+ BorderPanel8: TBorderPanel;
+ GroupBox8: TGroupBox;
+ ShowDwordAsHex: TPrefCheckBox;
+ BorderPanel7: TBorderPanel;
+ GroupBox7: TGroupBox;
+ CountZeroByteCB: TPrefCheckBox;
+ BorderPanel1: TBorderPanel;
+ GroupBox2: TGroupBox;
+ UseExtendedModelCB: TPrefCheckBox;
+ BorderPanel2: TBorderPanel;
+ GroupBox1: TGroupBox;
+ ShowAsBinaryCB: TPrefCheckBox;
+ ShowBinaryAsRG: TPrefRadioGroup;
+ Smart4BBCB: TPrefCheckBox;
+ DWordPreviewL: TLabel;
+ Label4: TLabel;
+ Label5: TLabel;
+ Label6: TLabel;
+ Label7: TLabel;
+ UserNameE: TPrefEdit;
+ Label8: TLabel;
+ MainPreviewE: TPrefEdit;
+ Label12: TLabel;
+ DefaultIconPreviewCB: TPrefCheckBox;
+ KeyInfoPreviewCB: TPrefCheckBox;
+ SelectExternalHexEditOD: TOpenDialog;
+ BorderPanel3: TBorderPanel;
+ GroupBox9: TGroupBox;
+ IntegrationPage: TTabSheet;
+ BorderPanel4: TBorderPanel;
+ GroupBox5: TGroupBox;
+ Label11: TLabel;
+ SelectExternalHexEditB: TButton;
+ RunExternalHexEditB: TButton;
+ ExternalHexEditE: TPrefEdit;
+ Label13: TLabel;
+ BorderPanel5: TBorderPanel;
+ GroupBox10: TGroupBox;
+ Label15: TLabel;
+ RegisterAppCB: TCheckBox;
+ Label3: TLabel;
+ Memo1: TMemo;
+ ExpandStringsRG: TPrefRadioGroup;
+ QuotersE: TPrefEdit;
+ Label1: TLabel;
+ StringPreviewL: TLabel;
+ ShowLineCountCB: TPrefCheckBox;
+ ShowTreeViewLinesCB: TPrefCheckBox;
+ ValuePage: TTabSheet;
+ BorderPanel10: TBorderPanel;
+ GroupBox12: TGroupBox;
+ ShowListViewGridCB: TPrefCheckBox;
+ Label9: TLabel;
+ DefaultValueNameE: TPrefEdit;
+ Label10: TLabel;
+ GotoPlutoKeyB: TButton;
+ ColorPanel2: TColorPanel;
+ LinkLabel1: TLinkLabel;
+ SmartExpandCB: TPrefCheckBox;
+ KeysSingleClickCB: TPrefCheckBox;
+ ValuesSingleClickCB: TPrefCheckBox;
+ ShowProgressCB: TPrefCheckBox;
+ ColorPanel1: TColorPanel;
+ Label2: TLabel;
+ ReloadB: TButton;
+ DefaultB: TButton;
+ SaveB: TButton;
+ procedure PrefPCDrawTab(Control: TCustomTabControl;
+ TabIndex: Integer; const Rect: TRect; Active: Boolean);
+ procedure PrefHostLoaded(Sender: TObject);
+ procedure StandardPreviewChange(Sender: TObject);
+ procedure DataPreviewChange(Sender: TObject);
+ procedure UserNameEChange(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ procedure FormDeactivate(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure PrefValuesPCDrawTab(Control: TCustomTabControl;
+ TabIndex: Integer; const Rect: TRect; Active: Boolean);
+ procedure ShowDwordAsHexClick(Sender: TObject);
+ procedure MainPreviewEChange(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure ActivateIt(Sender: TObject);
+ procedure DeActivateIt(Sender: TObject);
+ procedure ReloadBClick(Sender: TObject);
+ procedure RunExternalHexEditBClick(Sender: TObject);
+ procedure SelectExternalHexEditBClick(Sender: TObject);
+ procedure ExternalHexEditEChange(Sender: TObject);
+ procedure DefaultBClick(Sender: TObject);
+ procedure RegisterAppCBClick(Sender: TObject);
+ procedure SaveBClick(Sender: TObject);
+ procedure StringPreviewChange(Sender: TObject);
+ procedure ShowTreeViewLinesCBClick(Sender: TObject);
+ procedure ShowListViewGridCBClick(Sender: TObject);
+ procedure DefaultValueNameEChange(Sender: TObject);
+ procedure LoadPrefs;
+ procedure UseExtendedModelCBClick(Sender: TObject);
+ procedure IntegrationPageShow(Sender: TObject);
+ procedure GotoPlutoKeyBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure KeysSingleClickCBClick(Sender: TObject);
+ procedure ValuesSingleClickCBClick(Sender: TObject);
+ procedure QuotersEChange(Sender: TObject);
+ procedure SplashScreenCBClick(Sender: TObject);
+ procedure SaveBMouseMove(Sender: TObject; Shift: TShiftState; X,
+ Y: Integer);
+ public
+ StringQuoterBegin, StringQuoterEnd: string;
+ end;
+
+var
+ PrefWin: TPrefWin;
+
+implementation
+
+uses
+ TreeU, ValuesU, Splash, plutomain, WorkU;
+
+{$R *.dfm}
+
+procedure TPrefWin.PrefPCDrawTab(Control: TCustomTabControl;
+ TabIndex: Integer; const Rect: TRect; Active: Boolean);
+var
+ PC: TPageControl;
+ Page: TTabSheet;
+begin
+ PC := TPageControl(Control);
+ Page := PC.Pages[TabIndex];
+ with PC.Canvas.Font do begin
+ if Page.Caption = 'Common' then
+ Color := clWhite
+ else if Page.Caption = 'Keys' then
+ Color := clBrightCyan
+ else if Page.Caption = 'Values' then
+ Color := clBrightPurple
+ else if Page.Caption = 'Data' then
+ Color := clBrightBlue
+ else if Page.Caption = 'System' then
+ Color := clBrightYellow
+ else
+ Color := clWhite;
+ end;
+
+ with PC.Canvas do
+ if Active then begin
+ Font.Style := [fsBold];
+ Brush.Color := clDarkGray;
+ FillRect(Rect);
+ TextOut(Rect.Left + 5, Rect.Top + 3, Page.Caption);
+ end else begin
+ Font.Style := [];
+ Brush.Color := clDarkGray;
+ FillRect(Rect);
+ TextOut(Rect.Left + 3, Rect.Top + 2, Page.Caption);
+ end;
+end;
+
+procedure TPrefWin.PrefHostLoaded(Sender: TObject);
+begin
+ PrefHost.KeyName := PlutoUniPath;
+end;
+
+procedure TPrefWin.StandardPreviewChange(Sender: TObject);
+begin
+ if Started then
+ RegTV.Repaint;
+end;
+
+procedure TPrefWin.DataPreviewChange(Sender: TObject);
+begin
+ if not Started then
+ Exit;
+
+ ValuesWin.UpdateValues;
+ RegTV.Repaint;
+end;
+
+procedure TPrefWin.UserNameEChange(Sender: TObject);
+begin
+ StatusBar.Panels[0].Text := MainWin.Greeting;
+end;
+
+procedure TPrefWin.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_ESCAPE then
+ Close;
+
+ if Key = VK_SCROLL then
+ MainWin.FormKeyDown(Sender, Key, Shift);
+end;
+
+procedure TPrefWin.FormDeactivate(Sender: TObject);
+begin
+ if ActiveControl.Tag = EditControlFlag then
+ DeActivateThis(ActiveControl);
+
+ AlphaBlendValue := 127;
+end;
+
+procedure TPrefWin.FormActivate(Sender: TObject);
+begin
+ if Started and (ActiveControl.Tag = EditControlFlag) then
+ ActivateThis(ActiveControl);
+
+ AlphaBlendValue := 255;
+end;
+
+procedure TPrefWin.PrefValuesPCDrawTab(Control: TCustomTabControl;
+ TabIndex: Integer; const Rect: TRect; Active: Boolean);
+var
+ PC: TPageControl;
+ Page: TTabSheet;
+begin
+ PC := TPageControl(Control);
+ Page := PC.Pages[TabIndex];
+ with PC.Canvas.Font do begin
+ if Page = StringPage then
+ Color := clBrightRed
+ else if Page = MultiStringPage then
+ Color := clBrightPurple
+ else if Page = IntPage then
+ Color := clBrightBlue
+ else if Page = BinaryPage then
+ Color := clBrightGreen;
+ end;
+
+ with PC.Canvas do
+ if Active then begin
+ Font.Style := [fsBold];
+ Brush.Color := clDarkGray;
+ FillRect(Rect);
+ TextOut(Rect.Left + 18 + 5, Rect.Top + 3, Page.Caption);
+ PC.Images.Draw(PC.Canvas, Rect.Left + 4, Rect.Top + 2, Page.ImageIndex);
+ end else begin
+ Font.Style := [];
+ Brush.Color := clDarkGray;
+ FillRect(Rect);
+ TextOut(Rect.Left + 18 + 3, Rect.Top + 2, Page.Caption);
+ PC.Images.Draw(PC.Canvas, Rect.Left + 1, Rect.Top + 1, Page.ImageIndex);
+ end;
+end;
+
+procedure TPrefWin.ShowDwordAsHexClick(Sender: TObject);
+begin
+ DWordPreviewL.Caption := 'Preview: ' + ValuesU.DataPreviewOfContext(
+ RegContext(rdCardinal, Reverse(ByteAOfHex(HexOfCard(1234567890, 8)))));
+ DataPreviewChange(Self);
+end;
+
+procedure TPrefWin.MainPreviewEChange(Sender: TObject);
+begin
+ if MainPreviewE.Text = '' then
+ MainPreviewCB.Caption := '&Show Preview for Default Value'
+ else
+ MainPreviewCB.Caption := '&Show Preview for ' +
+ Quote(MainPreviewE.Text);
+
+ StandardPreviewChange(Self);
+end;
+
+procedure TPrefWin.FormCreate(Sender: TObject);
+begin
+ UserNameE.DefaultValue := UserName;
+ MainPreviewEChange(Self);
+ PrefPC.ActivePageIndex := 0;
+ PrefValuesPC.ActivePageIndex := 0;
+end;
+
+procedure TPrefWin.ActivateIt(Sender: TObject);
+begin
+ ActivateThis(Sender);
+end;
+
+procedure TPrefWin.DeActivateIt(Sender: TObject);
+begin
+ DeActivateThis(Sender);
+end;
+
+procedure TPrefWin.ReloadBClick(Sender: TObject);
+begin
+ LoadPrefs;
+end;
+
+procedure TPrefWin.RunExternalHexEditBClick(Sender: TObject);
+var
+ FileName, TestValue: string;
+begin
+ FileName := TempDir + '~test.bin';
+ TestValue := 'This is only a test.' + EOL +
+ 'Everything seems to be OK.';
+ if SaveByteA(ByteAOfStr(TestValue), FileName) then
+ ExecFileWith(ExternalHexEditE.Text, FileName)
+ else
+ ShowMessage('Could not write into file:' + EOL +
+ FileName);
+end;
+
+procedure TPrefWin.SelectExternalHexEditBClick(Sender: TObject);
+begin
+ with SelectExternalHexEditOD do begin
+ InitialDir := ExtractPath(ExternalHexEditE.Text);
+ FileName := ExtractFileName(ExternalHexEditE.Text);
+ if Execute and FileExists(FileName) then
+ ExternalHexEditE.Text := FileName;
+ end;
+end;
+
+procedure TPrefWin.ExternalHexEditEChange(Sender: TObject);
+begin
+ RunExternalHexEditB.Enabled := FileExists(ExternalHexEditE.Text);
+ if Assigned(WorkWin) then
+ WorkWin.ExternalEditB.Enabled := RunExternalHexEditB.Enabled;
+ if Assigned(MainWin) then
+ MainWin.ExternalHexEditMI.Enabled := RunExternalHexEditB.Enabled;
+end;
+
+procedure TPrefWin.DefaultBClick(Sender: TObject);
+begin
+ if mrYes=MessageDlg('Do you really want to reset the preferences' + EOL +
+ 'to their defaults?' + EOL +
+ '(This can not be undone.)', mtWarning, [mbYes, mbCancel], 0) then begin
+ CopyFile(PChar(PlutoIniFileName), PChar(PlutoIniFileName + '.backup'), False);
+ //PrefHost.KeyName := 'Ini <' + PlutoIniFileName + '.backup>:';
+ //PrefHost.Save;
+ //PrefHost.KeyName := PlutoUniPath;
+ PrefHost.BackUp;
+ end;
+end;
+
+procedure TPrefWin.RegisterAppCBClick(Sender: TObject);
+begin
+ with TXRegistry.Create do
+ try
+ RootKey := HKLM;
+ OpenKey('Software\Microsoft\Windows\CurrentVersion\App Paths');
+ if RegisterAppCB.Checked then begin
+ OpenKey('pluto.exe', True);
+ WriteString('', GetFileNew(Application.ExeName));
+ end else
+ DeleteKey('pluto.exe');
+ finally
+ Free;
+ end;
+end;
+
+procedure TPrefWin.SaveBClick(Sender: TObject);
+begin
+ PrefHost.Save;
+end;
+
+procedure TPrefWin.StringPreviewChange(Sender: TObject);
+begin
+ StringPreviewL.Caption := 'Preview: ' + ValuesU.DataPreviewOfContext(
+ RegContext(rdString, ByteAOfStr('%windir%')));
+ DataPreviewChange(Self);
+end;
+
+procedure TPrefWin.ShowTreeViewLinesCBClick(Sender: TObject);
+begin
+ with RegTV do begin
+ ShowLines := ShowTreeViewLinesCB.Checked;
+ ShowButtons := ShowLines;
+ end;
+ StandardPreviewChange(Sender);
+end;
+
+procedure TPrefWin.ShowListViewGridCBClick(Sender: TObject);
+begin
+ ValueList.GridLines := ShowListViewGridCB.Checked;
+end;
+
+procedure TPrefWin.DefaultValueNameEChange(Sender: TObject);
+begin
+ DefaultValueCaption := DefaultValueNameE.Text;
+ if Started then
+ TreeWin.RegTVChange(Self, RegTV.Selected);
+end;
+
+procedure TPrefWin.LoadPrefs;
+begin
+ PrefHost.Load;
+end;
+
+procedure TPrefWin.UseExtendedModelCBClick(Sender: TObject);
+begin
+ WorkWin.MultiStringTypeRG.ItemIndex := Integer(UseExtendedModelCB.Checked);
+ DataPreviewChange(Sender);
+end;
+
+procedure TPrefWin.IntegrationPageShow(Sender: TObject);
+begin
+ with TXRegistry.Create do
+ try
+ RootKey := HKLM;
+ OpenKey('Software\Microsoft\Windows\CurrentVersion\App Paths\pluto.exe');
+ RegisterAppCB.Checked := SameFileName(GetFileNew(ReadString('')),
+ GetFileNew(Application.ExeName));
+ finally
+ Free;
+ end;
+end;
+
+procedure TPrefWin.GotoPlutoKeyBClick(Sender: TObject);
+begin
+ MainWin.GotoKey('HKLM\Software\Microsoft\Windows\CurrentVersion\App Paths\pluto.exe');
+end;
+
+procedure TPrefWin.FormShow(Sender: TObject);
+begin
+ PrefHost.Load;
+end;
+
+procedure TPrefWin.KeysSingleClickCBClick(Sender: TObject);
+begin
+ TreeWin.CheckRegTVHotTrack;
+end;
+
+procedure TPrefWin.ValuesSingleClickCBClick(Sender: TObject);
+begin
+ ValuesWin.CheckValueListHotTrack;
+end;
+
+procedure TPrefWin.QuotersEChange(Sender: TObject);
+var
+ QBegin, QEnd: string;
+begin
+ with QuotersE do begin
+ if Text = '' then
+ QBegin := ''
+ else
+ QBegin := Text[1];
+ if Length(Text) < 2 then
+ QEnd := QBegin
+ else
+ QEnd := Text[2];
+ end;
+
+ if (QBegin <> StringQuoterBegin) or (QEnd <> StringQuoterEnd) then begin
+ StringQuoterBegin := QBegin;
+ StringQuoterEnd := QEnd;
+ StringPreviewChange(Self);
+ end;
+end;
+
+procedure TPrefWin.SplashScreenCBClick(Sender: TObject);
+begin
+ if Started and Assigned(SplashWin) then
+ SplashWin.SplashScreenCB.Checked := SplashScreenCB.Checked;
+end;
+
+procedure TPrefWin.SaveBMouseMove(Sender: TObject; Shift: TShiftState; X,
+ Y: Integer);
+begin
+ Label2.Font.Color := clBrightRed;
+ Application.ProcessMessages;
+ Sleep(200);
+ Label2.Font.Color := clWhite;
+end;
+
+end.
+unit RegScanner;
+
+interface
+
+uses
+ Windows, SysUtils, Dialogs, Classes,
+ YTools, YTypes, XReg, Clock;
+
+type
+ TRegScanThread = class;
+
+ TRegScanKeyEvent = procedure (Sender: TRegScanThread; const KeyName: string; Key: HKEY; Info: TRegKeyInfo) of object;
+ TRegScanValueEvent = procedure (Sender: TRegScanThread; const ValueName: string; Context: TRegContext) of object;
+
+ TRegScanTask = record
+ Root: string;
+ Key: HKEY;
+ end;
+ TRegScanTasks = array of TRegScanTask;
+
+ TRegScanThread = class(TThread)
+ private
+ Keys, KeysOK, Values, ValuesOK: Integer;
+ DoScanValues: Boolean;
+ FOnKey: TRegScanKeyEvent;
+ FOnValue: TRegScanValueEvent;
+ FOnFaileKey: TRegScanKeyEvent;
+ protected
+ procedure ScanKey(Key: HKEY; const KeyName: string = ''); virtual;
+ procedure ScanValues(Key: HKEY; Info: TRegKeyInfo); virtual;
+
+ public
+ Path: string;
+ CurrentTask: TRegScanTask;
+ Tasks: TRegScanTasks;
+ destructor Destroy; override;
+ procedure Execute; override;
+ procedure ScanAll;
+ function CurrentPath: string;
+ published
+ constructor CreateIt(PriorityLevel: TThreadPriority;
+ DoScanValues: Boolean = True; Tasks: TRegScanTasks = nil);
+
+ property OnKey: TRegScanKeyEvent read FOnKey write FOnKey;
+ property OnValue: TRegScanValueEvent read FOnValue write FOnValue;
+ property OnFaileKey: TRegScanKeyEvent read FOnFaileKey write FOnFaileKey;
+ end;
+
+implementation
+
+{ TRegScanThread }
+
+constructor TRegScanThread.CreateIt(PriorityLevel: TThreadPriority;
+ DoScanValues: Boolean = True; Tasks: TRegScanTasks = nil);
+begin
+ inherited Create(True);
+ Priority := PriorityLevel;
+ FreeOnTerminate := False;
+ Self.DoScanValues := DoScanValues;
+ Self.Tasks := Tasks;
+end;
+
+destructor TRegScanThread.Destroy;
+begin
+ inherited;
+end;
+
+procedure TRegScanThread.ScanAll;
+var
+ i: Integer;
+begin
+ Keys := 0;
+ KeysOK := 0;
+ Values := 0;
+ ValuesOK := 0;
+
+ for i := 0 to High(Tasks) do begin
+ CurrentTask := Tasks[i];
+ with CurrentTask do begin
+ Inc(Keys);
+ ScanKey(Key);
+ end;
+
+ if Terminated then Break;
+ end;
+end;
+
+procedure TRegScanThread.ScanValues(Key: HKEY; Info: TRegKeyInfo);
+var
+ i: Integer;
+ MaxLen, NameLen, Len, Typ: Cardinal;
+ p: PChar;
+ Buffer: TByteA;
+
+ procedure ScanValue(ValueName: string; Typ: TRegDataType; Data: TByteA);
+ begin
+ if Assigned(OnValue) then
+ OnValue(Self, ValueName, RegContext(Typ, Data));
+ Inc(ValuesOK);
+ end;
+
+begin
+ MaxLen := Info.MaxValueLen + 1; //Include Nullbyte
+ SetLength(Buffer, Info.MaxDataLen);
+ GetMem(p, MaxLen);
+
+ Inc(Values, Info.NumValues);
+ for i := 0 to Info.NumValues-1 do begin
+ NameLen := MaxLen;
+ Len := Info.MaxDataLen;
+ if Success(RegEnumValue(Key, i, p, NameLen, nil, @Typ, Pointer(Buffer),
+ @Len)) then
+ ScanValue(Copy(p, 0, NameLen), Typ, Copy(Buffer, 0, Len))
+ else
+ Yield;
+ end;
+ FreeMem(p, MaxLen);
+end;
+
+procedure TRegScanThread.ScanKey(Key: HKEY; const KeyName: string = '');
+var
+ i: Integer;
+ NewHKEY: HKEY;
+ Info: TRegKeyInfo;
+ l, Len: DWORD;
+ p: PChar;
+ z: Integer;
+begin
+ if Terminated then Exit;
+
+ with Info do begin
+ if not Success(RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys,
+ @MaxSubKeyLen, nil, @NumValues, @MaxValueLen, @MaxDataLen,
+ nil, nil)) then
+ Exit;
+
+ if Assigned(OnKey) then
+ OnKey(Self, KeyName, Key, Info);
+ if DoScanValues and (NumValues > 0) then
+ ScanValues(Key, Info);
+
+ if Info.NumSubKeys > 0 then begin
+ Inc(Keys, NumSubKeys);
+
+ Len := MaxSubKeyLen + 1;
+ GetMem(p, Len);
+
+ for i := 0 to NumSubKeys-1 do begin
+ l := Len;
+ RegEnumKeyEx(Key, i, p, l, nil, nil, nil, nil);
+ if Success(RegOpenKey(Key, p, NewHKEY)) then begin
+ z := Length(Path);
+ Path := Path + '\' + p;
+ ScanKey(NewHKEY, p);
+ RegCloseKey(NewHKEY);
+ SetLength(Path, z);
+ end else
+ if Assigned(OnFaileKey) then
+ OnFaileKey(Self, p, Key, Info);
+
+ if Terminated then
+ Break;
+ end;
+ FreeMem(p, Len);
+ end;
+ end;
+
+ Inc(KeysOK);
+end;
+
+procedure TRegScanThread.Execute;
+var
+ Secs: Double;
+begin
+ with TClock.Create do begin
+ ScanAll;
+ Secs := SecondsPassed;
+ Free;
+ end;
+
+ WriteLn('finished.');
+ WriteLn( Format('Keys: %6d counted (%3d failed)', [Keys, Keys - KeysOK]));
+ if DoScanValues then
+ WriteLn(Format('Values: %6d counted (%3d failed)', [Values, Values - ValuesOK]));
+ WriteLn('t ' + Format('%.2f', [Secs]) + ' seconds');
+ if Secs > 0 then
+ WriteLn('r ' + Format('%.0f', [Keys / Secs]) + ' k/s');
+end;
+
+function TRegScanThread.CurrentPath: string;
+begin
+ Result := CurrentTask.Root + Path;
+end;
+
+end.
+unit RegTV;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ ComCtrls;
+
+type
+ TRegTV = class(TTreeView)
+ private
+ { Private-Deklarationen }
+ protected
+ { Protected-Deklarationen }
+ public
+ { Public-Deklarationen }
+ published
+ { Published-Deklarationen }
+ end;
+
+procedure Register;
+
+implementation
+
+procedure Register;
+begin
+ RegisterComponents('pluto', [TRegTV]);
+end;
+
+end.
+unit Sisyphus;
+
+interface
+
+uses
+ Windows, Classes, SysUtils, XReg, YTools, YTypes, Clock;
+
+type
+ TSpyValue = class
+ Name: string;
+ Next: TSpyValue;
+ //DIC: TByteA;
+ Typ: TXRegDataType;
+ Data: TByteA;
+ constructor Create(AName: string);
+ end;
+
+ TSpyKey = class
+ public
+ Parent: TSpyKey;
+ Name: string;
+ Next: TSpyKey;
+ Keys: TSpyKey;
+ Values: TSpyValue;
+ procedure Spy(AHKEY: HKEY);
+ function Path: string;
+ constructor Create(AParent: TSpyKey; AName: string);
+ destructor Destroy; override;
+ end;
+
+var
+ Reg: TXRegistry;
+ HKLMSpyKey, HKUSpyKey: TSpyKey;
+ Started: Boolean = False;
+
+implementation
+
+uses
+ Plutomain;
+
+procedure AddChange(M: string);
+begin
+ Yield;
+ //AddHint(M);
+end;
+
+{ TSpyValue }
+
+constructor TSpyValue.Create(AName: string);
+begin
+ Name := AName;
+ Next := nil;
+end;
+
+{ TSpyKey }
+
+constructor TSpyKey.Create(AParent: TSpyKey; AName: string);
+begin
+ Name := AName;
+ Parent := AParent;
+
+ Next := nil;
+ Keys := nil;
+ Values := nil;
+end;
+
+destructor TSpyKey.Destroy;
+var
+ Value, NextValue: TSpyValue;
+ Key, NextKey: TSpyKey;
+begin
+ Value := Values;
+ while Value <> nil do begin
+ NextValue := Value.Next;
+ Value.Free;
+ Value := NextValue;
+ end;
+
+ Key := Keys;
+ while Key <> nil do begin
+ NextKey := Key.Next;
+ Key.Free;
+ Key := NextKey;
+ end;
+
+ inherited;
+end;
+
+function TSpyKey.Path: string;
+begin
+ if Assigned(Parent) then
+ Result := Parent.Path + '\'
+ else
+ Result := 'Reg: ';
+
+ Result := Result + Name;
+end;
+
+procedure TSpyKey.Spy(AHKEY: HKEY);
+var
+ SL: TStringList;
+
+ procedure CompareValues;
+ var
+ i: Integer;
+ Value, LastValue, NewValue, SearchValue: TSpyValue;
+ begin
+ //OK, this part is a little bit complicate. So I will comment very much.
+ //First, two terms are important:
+ //<REAL> means the list of values that will be read from the registry now:
+ Reg.GetValueNames(SL);
+ //So <REAL> is TStringList.
+
+ //<CURRENT> means the image that was saved before.
+ //Here, it is a linear list of TSpyValue objects. That means that you can
+ //only get X.Next and not X.Prev! However, I use "X.Prev" to simplify
+ //some comments.
+
+ //!!! Comparing means: Make <CURRENT> fit <REAL> !!!
+
+ //If <CURRENT> wasn't saved before, it is just empty.
+
+ //!!! There is no difference in comparing and saving in this method !!!
+
+ //Building means: Comparing with an empty image.
+
+ //We go through <REAL> and make <CURRENT> fit it
+
+ //The following rules are important:
+ //Value = "The currently interesting value.
+ //LastValue = "The value with X.Next = Value" = "Value.Pref"
+
+ LastValue := nil; // := "Values.Prev"
+ Value := Values; // := "LastValue.Next"
+
+ //Now compare step by step
+ for i := 0 to SL.Count-1 do begin
+ if Assigned(Value) and (SL[i] = Value.Name) then begin
+ //cV= Normally (0.9999) everything's the same
+ LastValue := Value;
+ Value := Value.Next;
+ end else begin //Something's different? Yes, the IMPORTANT rest (0.0001))
+ //Because the list finally must exactly fit SL, the "SL[i] value" hast
+ //to be inserted right here. But first let's look...
+
+ //Maybe it was just moved? So search for it...
+ NewValue := nil;
+ if Assigned(Value) then begin
+ SearchValue := Value;
+ while Assigned(SearchValue.Next) do
+ if (SearchValue.Next.Name = SL[i]) then begin
+ //cV\
+ NewValue := SearchValue.Next;
+ AddChange('cV\ ' + Path);
+ SearchValue.Next := SearchValue.Next.Next;
+ Break; end;
+ end;
+
+ if not Assigned(NewValue) then begin
+ //cV+ No, not found! So it is new...
+ NewValue := TSpyValue.Create(SL[i]);
+ AddChange('cV+ ' + Path + '\\' + NewValue.Name);
+ with NewValue do begin
+ Typ := Reg.GetDataType(SL[i]);
+ Data := Reg.ReadBin(SL[i]);
+ end;
+ end;
+
+ //The new object now must be placed after the last value
+ if Assigned(LastValue) then begin
+ LastValue.Next := NewValue;
+ end else begin
+ //If it's the first value, we don't have LastValue defined
+ //So we have to set the "Root" to it
+ Values := NewValue;
+ end;
+ //Now the rest of <CURRENT> has to be placed after the new value
+ NewValue.Next := Value;
+ //And LastValue also has to refreshed: It is "Value.Pref" = NewValue!
+ LastValue := NewValue;
+ end;
+ end;
+
+ //Because the whole <CURRENT> before Value is exactly <REAL>, the rest
+ //(if there is one) must have been deleted!
+
+ //So first let's ensure that <CURRENT> ends here:
+ if Assigned(LastValue) then begin
+ LastValue.Next := nil;
+ end else begin
+ //Another time: <CURRENT> is empty now, so set Values instead
+ Values := nil;
+ end;
+
+ //Now, the first value that maybe was "cut" off is Value:
+ while Assigned(Value) do begin
+ //cV- So, here really something HAS been deleted
+ LastValue := Value;
+ Value := Value.Next;
+ AddChange('cV- ' + Path + '\\' + LastValue.Name);
+ LastValue.Free;
+ end;
+ end;
+
+ procedure CompareData;
+ var
+ Value: TSpyValue;
+ Typ: TXRegDataType;
+ Data: TByteA;
+ begin
+ //So, finally <CURRENT> = <REAL>. That means we now can compare the data:
+ Value := Values;
+ while Assigned(Value) do begin
+ Typ := Reg.GetDataType(Value.Name);
+ Data := Reg.ReadBin(Value.Name);
+ if Typ <> Value.Typ then begin
+ //cT#
+ AddChange('cT# ' + Path + '\\' + Value.Name);
+ Value.Typ := Typ;
+ end;
+ if not SameByteA(Data, Value.Data) then begin
+ //cD#
+ AddChange('cD# ' + Path + '\\' + Value.Name);
+ Value.Data := Data;
+ end;
+
+ Value := Value.Next;
+ end;
+ end;
+
+ procedure CompareKeys;
+ var
+ i: Integer;
+ Key, LastKey, NewKey, SearchKey: TSpyKey;
+ NewHKEY: HKEY;
+ begin
+ //OK, this part is a little bit complicate. So I will comment very much.
+ //First, two terms are important:
+ //<REAL> means the list of keys that will be read from the registry now:
+ Reg.GetKeyNames(SL);
+ //So <REAL> is TStringList.
+
+ //<CURRENT> means the image that was saved before.
+ //Here, it is a linear list of TSpyKey objects. That means that you can
+ //only get X.Next and not X.Prev! However, I use "X.Prev" to simplify
+ //some comments.
+
+ //!!! Comparing means: Make <CURRENT> fit <REAL> !!!
+
+ //If <CURRENT> wasn't saved before, it is just empty.
+
+ //!!! There is no difference in comparing and saving in this method !!!
+
+ //Building means: Comparing with an empty image.
+
+ //We go through <REAL> and make <CURRENT> fit it
+
+ //The following rules are important:
+ //Key = "The currently interesting key.
+ //LastKey = "The key with X.Next = Key" = "Key.Pref"
+
+ LastKey := nil; // := "Keys.Prev"
+ Key := Keys; // := "LastKey.Next"
+
+ //Now compare step by step
+ for i := 0 to SL.Count-1 do begin
+ if Assigned(Key) and (SL[i] = Key.Name) then begin
+ //cK= Normally (0.9999) everything's the same
+ RegOpenKey(AHKEY, PChar(SL[i]), NewHKEY);
+ Key.Spy(NewHKEY);
+ LastKey := Key;
+ Key := Key.Next;
+ end else begin //Something's different? Yes, the IMPORTANT rest (0.0001))
+ //Because the list finally must exactly fit SL, the "SL[i] key" hast
+ //to be inserted right here. But first let's look...
+
+ //Maybe it was just moved? So search for it...
+ NewKey := nil;
+ if Assigned(Key) then begin
+ SearchKey := Key;
+ while Assigned(SearchKey.Next) do
+ if (SearchKey.Next.Name = SL[i]) then begin
+ //cK\
+ NewKey := SearchKey.Next;
+ AddChange('cK\ ' + Path);
+ SearchKey.Next := SearchKey.Next.Next;
+ Break; end;
+ end;
+
+ if not Assigned(NewKey) then begin
+ //cK+ No, not found! So it is new...
+ NewKey := TSpyKey.Create(Self, SL[i]);
+ AddChange('cK+ ' + Path + '\' + NewKey.Name);
+
+ RegOpenKey(AHKEY, PChar(SL[i]), NewHKEY);
+ NewKey.Spy(NewHKEY);
+ end;
+
+ //The new object now must be placed after the last key
+ if Assigned(LastKey) then begin
+ LastKey.Next := NewKey;
+ end else begin
+ //If it's the first key, we don't have LastKey defined
+ //So we have to set the "Root" to it
+ Keys := NewKey;
+ end;
+ //Now the rest of <CURRENT> has to be placed after the new key
+ NewKey.Next := Key;
+ //And LastKey also has to refreshed: It is "Key.Pref" = NewKey!
+ LastKey := NewKey;
+ end;
+ end;
+
+ //Because the whole <CURRENT> before Key is exactly <REAL>, the rest
+ //(if there is one) must have been deleted!
+
+ //So first let's ensure that <CURRENT> ends here:
+ if Assigned(LastKey) then begin
+ LastKey.Next := nil;
+ end else begin
+ //Another time: <CURRENT> is empty now, so set Keys instead
+ Keys := nil;
+ end;
+
+ //Now, the first key that maybe was "cut" off is Key:
+ while Assigned(Key) do begin
+ //cV- So, here really something HAS been deleted
+ LastKey := Key;
+ Key := Key.Next;
+ AddChange('cK- ' + Path + '\' + LastKey.Name);
+ LastKey.Free;
+ end;
+ end;
+
+
+begin
+ SL := TStringList.Create;
+
+ try
+ Reg.CurrentKey := AHKEY;
+
+ CompareValues;
+
+ CompareData;
+
+ CompareKeys;
+
+ finally
+ RegCloseKey(AHKEY);
+ end;
+
+ SL.Free;
+end;
+
+initialization
+ Reg := TXRegistry.Create;
+ HKLMSpyKey := TSpyKey.Create(nil, 'HKEY_LOCAL_MACHINE');
+ HKUSpyKey := TSpyKey.Create(nil, 'HKEY_USERS');
+
+finalization
+ Reg.Free;
+ HKLMSpyKey.Free;
+ HKUSpyKey.Free;
+
+end.
+unit SisyphusTH;
+
+interface
+
+uses
+ Windows, Classes, StdCtrls, Dialogs, SysUtils, XReg, YTools, YTypes, Clock,
+ ComCtrls, PlutoConst, UniKey, CompEx;
+
+const
+ SisyVersion = '1.2 b3';
+ StatusPoints = 25;
+
+type
+ TSisyChangeType = (cNone, cError,
+ cKeyPlus, cKeyMinus,
+ cValuePlus, cValueMinus,
+ cContextChange);
+
+const
+ SisyChangeStrings: array[TSisyChangeType] of string =
+ ('?', 'Error',
+ 'cK+', 'cK-',
+ 'cV+', 'cV-',
+ 'cC');
+
+type
+ TSpyValue = class
+ Name: string;
+ Next: TSpyValue;
+ Context: TRegContext;
+ constructor Create(const Name: string; Context: TRegContext);
+ end;
+
+ TSisyThread = class;
+
+ TSpyKey = class
+ public
+ Parent: TSpyKey;
+ Name: string;
+ Next: TSpyKey;
+ Keys: TSpyKey;
+ Values: TSpyValue;
+ procedure Spy(AHKEY: HKEY; Sisy: TSisyThread);
+ function Path: string;
+ constructor Create(AParent: TSpyKey; AName: string);
+ destructor Destroy; override;
+ end;
+
+ TSisyChange = class
+ public
+ Typ: TSisyChangeType;
+ Path: string;
+ Old, New: TRegContext;
+ constructor Create(ATyp: TSisyChangeType; const APath: string;
+ AOldContext: TRegContext; ANewContext: TRegContext);
+ procedure ReportToPluto;
+ end;
+
+ TSisyChangeEvent = procedure (Sender: TSisyThread; Change: TSisyChange) of object;
+ TSisyThread = class(TThread)
+ private
+ Reg: TXRegistry;
+ Key: TSpyKey;
+ KeyHKEY: HKEY;
+ CurrentChange: TSisyChange;
+ FOnChange: TSisyChangeEvent;
+ FOnSpecialChanges: array[TSisyChangeType] of TSisyChangeEvent;
+ procedure FreeKey;
+ procedure IncKeyCount;
+ procedure IncKeyIndex;
+ function GetSpecialChange(ChangeType: TSisyChangeType): TSisyChangeEvent;
+ procedure SetSpecialChange(ChangeType: TSisyChangeType;
+ const Value: TSisyChangeEvent);
+ protected
+ procedure AddValueChange(Typ: TSisyChangeType; const Path: string;
+ Old, New: TRegContext);
+ procedure AddKeyChange(Typ: TSisyChangeType; const Path: string);
+ procedure Execute; override;
+ procedure ShowInfo;
+ procedure NotifyChange;
+ procedure ReportCurrentChange;
+ public
+ CurrentSpyKey: TSpyKey;
+ StatusLabel: TLabel;
+ Name: string;
+ Started: Boolean;
+ DoReport: Boolean;
+ SecsPerRound: Double;
+ InfoForShow: string;
+ OnStarted: TNotifyEvent;
+ KeyCount: Integer;
+ PrevKeyCount: Integer;
+ KeyIndex: Integer;
+ TheClock: TClock;
+ Uni: TUniKey;
+ MaxValueCountToScan, MaxKeyCountToScan, MaxDataLenToScan: Cardinal;
+ constructor CreateIt(const AName, AKeyName: string; AHKEY: HKEY;
+ ALabel: TLabel; AUniKey: TUniKey);
+ destructor Destroy; override;
+
+ property OnChange: TSisyChangeEvent read FOnChange write FOnChange;
+ property OnSpecialChange[ChangeType: TSisyChangeType]: TSisyChangeEvent
+ read GetSpecialChange write SetSpecialChange;
+ end;
+
+ TSisyList = class(TList)
+ protected
+ function GetSisy(Index: Integer): TSisyThread;
+ procedure PutSisy(Index: Integer; Sisy: TSisyThread);
+ public
+ procedure Suspend;
+ procedure Resume;
+ property Items[Index: Integer]: TSisyThread read GetSisy write PutSisy; default;
+ end;
+
+procedure SetSisyChangeState(Node: TTreeNode; Active: Boolean);
+function SisyChangeActivated(Node: TTreeNode): Boolean;
+
+var
+ SisyFilter: TStringList;
+
+implementation
+
+uses plutomain, workU, ValuesU;
+
+procedure SetSisyChangeState(Node: TTreeNode; Active: Boolean);
+begin
+ Node.Data := Pointer(not Active);
+end;
+
+function SisyChangeActivated(Node: TTreeNode): Boolean;
+begin
+ Result := Node.Data = Pointer(False);
+end;
+
+{ TSisyThread }
+
+constructor TSisyThread.CreateIt(const AName, AKeyName: string;
+ AHKEY: HKEY; ALabel: TLabel; AUniKey: TUniKey);
+begin
+ inherited Create(True); // Create thread suspended
+
+ Started := False;
+ DoReport := True;
+ KeyCount := 0;
+ FreeOnTerminate := False; // Thread frees itself not when terminated
+
+ KeyHKEY := AHKEY;
+ Name := AName;
+ StatusLabel := ALabel;
+ StatusLabel.Caption := 'Zzzzzzz...';
+
+ Reg := TXRegistry.Create;
+ TheClock := TClock.Create;
+
+ Uni := AUniKey.GetKey(Name);
+ Priority := TThreadPriority(Uni.ReadInteger('Priority', Integer(tpLowest)));
+ PrevKeyCount := Uni.ReadInteger('KeyCount', 0);
+
+ MaxKeyCountToScan := Cardinal(Uni.ReadInteger('ScanTuner: MaxKeys', -1));
+ MaxValueCountToScan := Cardinal(Uni.ReadInteger('ScanTuner: MaxValues', -1));
+ MaxDataLenToScan := Cardinal(Uni.ReadInteger('ScanTuner: MaxDataLen', -1));
+
+ Key := TSpyKey.Create(nil, AKeyName);
+end;
+
+procedure TSisyThread.FreeKey;
+begin
+ Reg.Free;
+ TheClock.Free;
+ Key.Free;
+end;
+
+destructor TSisyThread.Destroy;
+begin
+ Synchronize(FreeKey);
+ inherited;
+end;
+
+procedure TSisyThread.Execute;
+begin
+ InfoForShow := Name + ' initializing...';
+ Synchronize(ShowInfo);
+
+ TheClock.Restart;
+ Started := False;
+ while not Terminated do
+ try
+ KeyIndex := 0;
+
+ { ===================== }
+ Key.Spy(KeyHKEY, Self);
+ { ===================== }
+
+ if Terminated then
+ Continue; //= Exit
+
+ SecsPerRound := TheClock.SecondsPassed;
+ TheClock.Restart;
+ if not Started then begin
+ Started := True;
+ Uni.WriteInteger('KeyCount', KeyCount);
+ if Assigned(OnStarted) then
+ OnStarted(Self);
+ end;
+ except
+ ShowMessage('Error in Sisyphus');
+ end;
+end;
+
+procedure TSisyThread.AddValueChange(Typ: TSisyChangeType; const Path: string;
+ Old, New: TRegContext);
+
+ procedure TryNotify(Event: TSisyCHangeEvent);
+ begin
+
+ end;
+
+begin
+ if not (Started and DoReport) then
+ Exit;
+
+ CurrentChange := TSisyChange.Create(Typ, Path, Old, New);
+ Synchronize(ReportCurrentChange);
+ Synchronize(NotifyChange);
+
+// CurrentChange.Free; //this makes Pluto itself
+end;
+
+procedure TSisyThread.AddKeyChange(Typ: TSisyChangeType; const Path: string);
+begin
+ AddValueChange(Typ, Path, ZeroRegContext, ZeroRegContext);
+end;
+
+procedure TSisyThread.ShowInfo;
+begin
+ if Assigned(StatusLabel) then
+ StatusLabel.Caption := InfoForShow;
+end;
+
+procedure TSisyThread.ReportCurrentChange;
+begin
+ if Assigned(CurrentChange) then
+ CurrentChange.ReportToPluto;
+end;
+
+procedure TSisyThread.IncKeyCount;
+var
+ c: Integer;
+begin
+ if Started then
+ Exit;
+
+ Inc(KeyCount);
+
+ if (KeyCount and $1FF) = 0 then begin
+ if KeyCount > PrevKeyCount then
+ PrevKeyCount := KeyCount;
+
+ c := 0;
+ if PrevkeyCount > 0 then
+ c := Round((KeyCount * StatusPoints) / PrevKeyCount);
+ InfoForShow := '|' + MulStr('.', c) + MulStr(' ', StatusPoints - c) + '|' +
+ Format(' (%0.1f s) %d/%d k ',
+ [TheClock.SecondsPassed, KeyCount, PrevKeyCount]);
+
+ Synchronize(ShowInfo);
+ end;
+end;
+
+procedure TSisyThread.IncKeyIndex;
+var
+ c: Integer;
+begin
+ if not Started then
+ Exit;
+
+ Inc(KeyIndex);
+
+ if ((KeyIndex and $1FF) = 0) and (KeyCount > 0) then begin
+ if KeyIndex > KeyCount then
+ KeyCount := KeyIndex;
+
+ c := 0;
+ if KeyCount > 0 then
+ c := Round((KeyIndex * StatusPoints) / KeyCount);
+
+ InfoForShow := '|' + MulStr(':', c) + MulStr('.', StatusPoints - c) + '|' +
+ Format(' (%0.1f s) %d/%d k ', [SecsPerRound, KeyIndex, KeyCount]);
+
+ Synchronize(ShowInfo);
+ end;
+end;
+
+function TSisyThread.GetSpecialChange(ChangeType: TSisyChangeType):
+ TSisyChangeEvent;
+begin
+ Result := FOnSpecialChanges[ChangeType];
+end;
+
+procedure TSisyThread.SetSpecialChange(ChangeType: TSisyChangeType;
+ const Value: TSisyChangeEvent);
+begin
+ FOnSpecialChanges[ChangeType] := Value;
+end;
+
+procedure TSisyThread.NotifyChange;
+var
+ Event: TSisyChangeEvent;
+begin
+ Event := FOnSpecialChanges[CurrentChange.Typ];
+ if Assigned(Event) then
+ Event(Self, CurrentChange);
+
+ if Assigned(FOnChange) then
+ FOnChange(Self, CurrentChange);
+end;
+
+{ TSpyValue }
+
+constructor TSpyValue.Create(const Name: string; Context: TRegContext);
+begin
+ Self.Name := Name;
+ Next := nil;
+ Self.Context := Context;
+end;
+
+{ TSpyKey }
+
+constructor TSpyKey.Create(AParent: TSpyKey; AName: string);
+begin
+ Name := AName;
+ Parent := AParent;
+
+ Next := nil;
+ Keys := nil;
+ Values := nil;
+end;
+
+destructor TSpyKey.Destroy;
+var
+ Value, NextValue: TSpyValue;
+ Key, NextKey: TSpyKey;
+begin
+ Value := Values;
+ while Assigned(Value) do begin
+ NextValue := Value.Next;
+ Value.Free;
+ Value := NextValue;
+ end;
+
+ Key := Keys;
+ while Assigned(Key) do begin
+ NextKey := Key.Next;
+ Key.Free;
+ Key := NextKey;
+ end;
+
+ inherited;
+end;
+
+function TSpyKey.Path: string;
+begin
+ if Assigned(Parent) then
+ Result := Parent.Path + '\'
+ else
+ Result := '';
+
+ Result := Result + Name;
+end;
+
+procedure TSpyKey.Spy(AHKEY: HKEY; Sisy: TSisyThread);
+var
+ SL: TStringList;
+ LastKey: TSpyKey;
+
+ procedure CompareValues;
+ var
+ i: Integer;
+ Value, LastValue, NewValue, SearchValue, SearchValue_Prev: TSpyValue;
+ begin
+ //OK, this part is a little bit complicate. So I will comment very much.
+ //First, two terms are important:
+ //<REAL> means the list of values that will be read from the registry now:
+ Sisy.Reg.GetValueNames(SL);
+ if Cardinal(SL.Count) > Sisy.MaxValueCountToScan then
+ Exit;
+ //So <REAL> is TStringList.
+
+ //<CURRENT> means the image that was saved before.
+ //Here, it is a linear list of TSpyValue objects. That means that you can
+ //only get X.Next and not X.Prev! However, I use "X.Prev" to simplify
+ //some comments.
+
+ //!!! Comparing means: Make <CURRENT> fit <REAL> !!!
+
+ //If <CURRENT> wasn't saved before, it is just empty.
+
+ //!!! There is no difference in comparing and saving in this method !!!
+
+ //Building means: Comparing with an empty image.
+
+ //We go through <REAL> and make <CURRENT> fit it
+
+ //The following rules are important:
+ //Value = "The currently interesting value.
+ //LastValue = "The value with X.Next = Value" = "Value.Pref"
+
+ LastValue := nil; // := "Values.Prev"
+ Value := Values; // := "LastValue.Next"
+
+ //Now compare step by step
+ for i := 0 to SL.Count-1 do begin
+ if Assigned(Value) and (SL[i] = Value.Name) then begin
+ //cV= Normally (0.9999) everything's the same
+ LastValue := Value;
+ Value := Value.Next;
+ end else begin //Something's different? Yes, the IMPORTANT rest (0.0001))
+ //Because the list finally must exactly fit SL, the "SL[i] value" hast
+ //to be inserted right here. But first let's look...
+
+ //Maybe it was just moved? So search for it...
+ NewValue := nil;
+ if Assigned(Value) then begin
+ SearchValue_Prev := Value;
+ SearchValue := Value.Next;
+ while Assigned(SearchValue) do begin
+ if SearchValue.Name = SL[i] then begin //we found our moved value
+ SearchValue_Prev.Next := SearchValue.Next; //delete it from <CURRENT>
+ NewValue := SearchValue; //save that we found it
+ Break end;
+ SearchValue_Prev := SearchValue;
+ SearchValue := SearchValue.Next;
+ end;
+ end;
+
+ if not Assigned(NewValue) then begin
+ //cV+ No, not found! So it is new...
+ NewValue := TSpyValue.Create(SL[i], Sisy.Reg.ReadContext(SL[i]));
+ { ================ cV+ ================ }
+ if Sisy.Started and Sisy.Reg.ValueReallyExists(SL[i]) then
+ Sisy.AddValueChange(cValuePlus, Path + '\\' + NewValue.Name,
+ ZeroRegContext, NewValue.Context);
+ end;
+
+ //The new object now must be placed after the last value
+ if Assigned(LastValue) then
+ LastValue.Next := NewValue
+ else
+ //If it's the first value, we don't have LastValue defined
+ //So we have to set the "Root" to it
+ Values := NewValue;
+
+ //Now the rest of <CURRENT> has to be placed after the new value
+ NewValue.Next := Value;
+ //And LastValue also has to refreshed: It is "Value.Pref" = NewValue!
+ LastValue := NewValue;
+ end;
+ end;
+
+ //Because the whole <CURRENT> before Value is exactly <REAL>, the rest
+ //(if there is one) must have been deleted!
+
+ //So first let's ensure that <CURRENT> ends here:
+ if Assigned(LastValue) then
+ LastValue.Next := nil
+ else
+ //Another time: <CURRENT> is empty now, so set Values instead
+ Values := nil;
+
+ //Now, the first value that maybe was "cut" off is Value:
+ while Assigned(Value) do begin
+ //cV- So, here really something HAS been deleted
+ LastValue := Value;
+ Value := Value.Next;
+ { ================ cV- ================ }
+ if Sisy.Started and not Sisy.Reg.ValueReallyExists(LastValue.Name) then
+ Sisy.AddValueChange(cValueMinus, Path + '\\' + LastValue.Name,
+ LastValue.Context, ZeroRegContext);
+ LastValue.Free;
+ end;
+ end;
+
+ procedure CompareData;
+ var
+ Value: TSpyValue;
+ Context: TRegContext;
+ Size: Cardinal;
+ begin
+ Context := ZeroRegContext; //Initialize
+ //So, finally <CURRENT> = <REAL>. That means we now can compare the data:
+ Value := Values;
+ while Assigned(Value) and not Sisy.Terminated do begin
+ Size := Sisy.Reg.GetDataSize(Value.Name);
+ if (Size = Cardinal(-1)) or
+ (Size <= Sisy.MaxDataLenToScan) then begin
+ Context := Sisy.Reg.ReadContext(Value.Name);
+ if not SameContext(Context, Value.Context) then begin
+ { ================ cC ================ }
+ Sisy.AddValueChange(cContextChange, Path + '\\' + Value.Name,
+ Value.Context, Context);
+ Value.Context := Context;
+ end;
+ end;
+
+ Value := Value.Next;
+ end;
+ end;
+
+ procedure CompareKeys;
+ var
+ i: Integer;
+ Key, LastKey, NewKey, SearchKey, SearchKey_Prev: TSpyKey;
+ SavedDoReport: Boolean;
+ NewHKEY: HKEY;
+ begin
+ //OK, this part is a little bit complicate. So I will comment very much.
+ //First, two terms are important:
+ //<REAL> means the list of keys that will be read from the registry now:
+
+ Sisy.Reg.GetKeyNames(SL);
+ if Cardinal(SL.Count) > Sisy.MaxKeyCountToScan then
+ Exit;
+ //So <REAL> is TStringList.
+
+ //<CURRENT> means the image that was saved before.
+ //Here, it is a linear list of TSpyKey objects. That means that you can
+ //only get X.Next and not X.Prev! However, I use "X.Prev" to simplify
+ //some comments.
+
+ //!!! Comparing means: Make <CURRENT> fit <REAL> !!!
+
+ //If <CURRENT> wasn't saved before, it is just empty.
+
+ //!!! There is no difference in comparing and saving in this method !!!
+
+ //Building means: Comparing with an empty image.
+
+ //We go through <REAL> and make <CURRENT> fit it
+
+ //The following rules are important:
+ //Key = "The currently interesting key.
+ //LastKey = "The key with X.Next = Key" = "Key.Pref"
+
+ LastKey := nil; // := "Keys.Prev"
+ Key := Keys; // := "LastKey.Next"
+
+ //Now compare step by step
+ for i := 0 to SL.Count-1 do begin
+ if Assigned(Key) and (SL[i] = Key.Name) then begin
+ //cK= Normally (0.9999) everything's the same
+ if Success(RegOpenKey(AHKEY, PChar(SL[i]), NewHKEY)) then
+ try
+ Key.Spy(NewHKEY, Sisy);
+ finally
+ RegCloseKey(NewHKEY);
+ end;
+ if Sisy.Terminated then
+ Exit;
+
+ LastKey := Key;
+ Key := Key.Next;
+ end else begin //Something's different? Yes, the IMPORTANT rest (0.0001))
+ //Because the list finally must exactly fit SL, the "SL[i] key" has
+ //to be inserted right here. But first let's look...
+
+ //Maybe it was just moved? So search for it...
+ NewKey := nil;
+ if Assigned(Key) then begin
+ SearchKey_Prev := Key;
+ SearchKey := Key.Next;
+ while Assigned(SearchKey) do begin
+ if SearchKey.Name = SL[i] then begin //we found our moved key
+ SearchKey_Prev.Next := SearchKey.Next; //delete it from <CURRENT>
+ NewKey := SearchKey; //save that we found it
+ Break end;
+ SearchKey_Prev := SearchKey;
+ SearchKey := SearchKey.Next;
+ end;
+ end;
+
+ if not Assigned(NewKey) then begin //if we didn't find it
+ //cK+ No, not found! So it is new...
+ NewKey := TSpyKey.Create(Self, SL[i]);
+ Sisy.IncKeyCount;
+ Sisy.Reg.CurrentKey := AHKEY;
+ { ================ cK+ ================ }
+ if Sisy.Started and Sisy.Reg.KeyExists(SL[i]) then
+ Sisy.AddKeyChange(cKeyPlus, Path + '\' + NewKey.Name);
+
+ SavedDoReport := Sisy.DoReport;
+ if Success(RegOpenKey(AHKEY, PChar(SL[i]), NewHKEY)) then
+ try
+ Sisy.DoReport := False;
+ NewKey.Spy(NewHKEY, Sisy); //<-- recursion itself
+ finally
+ RegCloseKey(NewHKEY);
+ Sisy.DoReport := SavedDoReport;
+ end;
+
+ if Sisy.Terminated then
+ Exit;
+ end;
+
+ //The new key now must be placed after the last key
+ if Assigned(LastKey) then
+ LastKey.Next := NewKey
+ else
+ //If it's the first key, we don't have LastKey defined
+ //So we have to set the "Root" to it
+ Keys := NewKey;
+
+ //Now the rest of <CURRENT> has to be placed after the new key
+ NewKey.Next := Key;
+ //And LastKey also has to refreshed: It is "Key.Pref" = NewKey!
+ LastKey := NewKey;
+ end;
+ end;
+
+ //Because the whole <CURRENT> before Key is exactly <REAL>, the rest
+ //(if there is one) must have been deleted!
+
+ //So first let's ensure that <CURRENT> ends here:
+ if Assigned(LastKey) then
+ LastKey.Next := nil
+ else
+ //Another time: <CURRENT> is empty now, so set Keys instead
+ Keys := nil;
+
+ //Now, the first key that maybe was "cut" off is Key:
+ while Assigned(Key) do begin
+ //cV- So, here really something HAS been deleted
+ LastKey := Key;
+ Key := Key.Next;
+ Sisy.Reg.CurrentKey := AHKEY;
+ { ================ cK- ================ }
+ if Sisy.Started and not Sisy.Reg.KeyExists(LastKey.Name) then
+ Sisy.AddKeyChange(cKeyMinus, Path + '\' + LastKey.Name);
+ LastKey.Free;
+ end;
+ end;
+
+
+begin
+ if Sisy.Terminated or (AHKEY = 0) then
+ Exit;
+ LastKey := Sisy.CurrentSpyKey;
+ Sisy.CurrentSpyKey := Self;
+
+ Sisy.IncKeyIndex;
+
+ SL := TStringList.Create;
+ try
+ Sisy.Reg.CurrentKey := AHKEY;
+ CompareValues;
+ if Sisy.Started then CompareData;
+ CompareKeys;
+ finally
+ Sisy.Reg.CurrentKey := 0;
+ SL.Free;
+ Sisy.CurrentSpyKey := LastKey;
+ end;
+end;
+
+{ TSisyChange }
+
+constructor TSisyChange.Create(ATyp: TSisyChangeType; const APath: string;
+ AOldContext: TRegContext; ANewContext: TRegContext);
+begin
+ inherited Create;
+ Typ := ATyp;
+ Path := APath;
+ Old := AOldContext;
+ New := ANewContext;
+end;
+
+procedure TSisyChange.ReportToPluto;
+var
+ Node, RootNode: TTreeNode;
+ Root, SubPath: string;
+ NewNode: Boolean;
+ i: Integer;
+
+ function IconOfSisyChangeType(Typ: TSisyChangeType): Integer;
+ begin
+ Result := -1;
+ case Typ of
+ //cNone, cError: Result := -1;
+ cKeyPlus..cContextChange: Result := Integer(Typ) - 2;
+ end;
+ end;
+
+ function FindNode(Text: string): TTreeNode;
+ begin
+ Result := WorkWin.SisyTV.Items.GetFirstNode;
+ while Assigned(Result) do begin
+ if SameText(Result.Text, Text) then
+ Exit;
+ Result := Result.GetNextSibling;
+ end;
+ end;
+
+begin
+ if not WorkWin.SisyListCB.Checked then
+ Exit;
+
+ if Typ in [cContextChange, cValueMinus, cValuePlus] then begin
+ Root := ExRegFullKey(Path);
+ SubPath := ExRegValue(Path);
+ end else begin
+ Root := UntilLastChar(ExRegFullKey(Path), '\');
+ SubPath := FromLastChar(ExRegFullKey(Path), '\');
+ end;
+
+ with WorkWin do
+ for i := 0 to SisyFilter.Count-1 do begin
+ if TextAtPos(Root, 1, SisyFilter[i]) then begin
+ //show that it's working
+ with FilterChangesB do begin
+ Caption := 'Filter..!';
+ Repaint;
+ Caption := 'Filter...';
+ Repaint;
+ end;
+ Exit; end;
+ end;
+
+ with WorkWin.SisyTV.Items do begin
+ BeginUpdate;
+ try
+ RootNode := FindNode(Root);
+ NewNode := not Assigned(RootNode);
+ if NewNode then begin
+ RootNode := AddChild(nil, Root);
+ RootNode.ImageIndex := iconGroup;
+ end else if not SisyChangeActivated(RootNode) then begin
+ EndUpdate;
+ Exit end;
+
+ Node := AddChildObject(RootNode, SubPath, Self);
+ Node.ImageIndex := IconOfSisyChangeType(Typ);
+ if Typ = cContextChange then begin
+ AddChild(Node, DataPreviewOfContext(Old)).ImageIndex := iconOldContext;
+ AddChild(Node, DataPreviewOfContext(New)).ImageIndex := iconNewContext;
+ end;
+ finally
+ EndUpdate;
+ end;
+ end;
+
+ if NewNode and WorkWin.SisyExpandGroupsCB.Checked then
+ RootNode.Expand(False);
+
+ if not RootNode.Expanded then
+ RootNode.ImageIndex := iconGroupBlinking;
+end;
+
+{ TSisyList }
+
+function TSisyList.GetSisy(Index: Integer): TSisyThread;
+begin
+ Result := Get(Index);
+end;
+
+procedure TSisyList.PutSisy(Index: Integer; Sisy: TSisyThread);
+begin
+ Put(Index, Sisy);
+end;
+
+procedure TSisyList.Resume;
+var
+ i: Integer;
+begin
+ for i := 0 to Count-1 do
+ Items[i].Resume;
+end;
+
+procedure TSisyList.Suspend;
+var
+ i: Integer;
+begin
+ for i := 0 to Count-1 do
+ Items[i].Resume;
+end;
+
+initialization
+ SisyFilter := TStringList.Create;
+ SisyFilter.Sorted := True;
+ SisyFilter.Duplicates := dupIgnore;
+
+finalization
+ SisyFilter.Free;
+
+end.
+unit splash;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
+ ExtCtrls, StdCtrls, ImgList, YTools, IniFiles, LinkLabel, PrefTools,
+ PlutoConst;
+
+type
+ TSplashWin = class(TForm)
+ Image1: TImage;
+ StartB: TButton;
+ SplashScreenCB: TPrefCheckBox;
+ LinkLabel1: TLinkLabel;
+ LinkLabel2: TLinkLabel;
+ LogoL: TLabel;
+ procedure StartBClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormCreate(Sender: TObject);
+ procedure FormHide(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ procedure SplashScreenCBClick(Sender: TObject);
+ end;
+
+var
+ SplashWin: TSplashWin;
+
+implementation
+
+uses plutomain, TreeU, WorkU, PrefU;
+
+{$R *.DFM}
+
+procedure TSplashWin.StartBClick(Sender: TObject);
+begin
+ Close;
+end;
+
+procedure TSplashWin.FormShow(Sender: TObject);
+const
+ Messages: array[0..12] of string = ('Let''s see...',
+ 'Ready',
+ 'Hello World!',
+ 'Start',
+ 'OK',
+ 'Pluto!',
+ 'Go Go Go',
+ 'Everything''s OK',
+ 'Yes!',
+ 'God save the Queen',
+ 'Oh yeah',
+ 'Yabadabadoo!',
+ 'Don''t worry, be happy!'
+ );
+var
+ ImageFile: string;
+begin
+ Left := (Screen.Width - Width) div 2;
+ Top := (Screen.Height - Height) div 2;
+
+ StartB.Caption := Messages[Random(Length(Messages))];
+ SplashWin.SplashScreenCB.Load;
+
+ Caption := 'cYcnus.Pluto ' + Version + ' says ' + MainWin.Greeting;
+
+ try
+ ImageFile := PlutoDir + 'logo deluxe.bmp';
+ if FileEx(ImageFile) then begin
+ with Image1.Picture do
+ if Graphic = nil then
+ LoadFromFile(ImageFile);
+ if not Switch('MurphyMode') then
+ LogoL.Visible := False;
+ Exit;
+ end;
+
+ ImageFile := PlutoDir + 'logo.bmp';
+ if FileEx(ImageFile) then begin
+ with Image1.Picture do
+ if Graphic = nil then
+ LoadFromFile(ImageFile);
+ end;
+ except
+ ShowMessage('Could not load Splash Screen image!');
+ end;
+end;
+
+procedure TSplashWin.FormCreate(Sender: TObject);
+begin
+ Hide;
+ Randomize;
+end;
+
+procedure TSplashWin.FormHide(Sender: TObject);
+begin
+ //Image1.Picture.Bitmap.FreeImage;
+end;
+
+procedure TSplashWin.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_ESCAPE then
+ Close;
+end;
+
+procedure TSplashWin.SplashScreenCBClick(Sender: TObject);
+begin
+ if Started then
+ PrefWin.SplashScreenCB.Checked := SplashScreenCB.Checked;
+end;
+
+end.
+unit SpyTH;
+
+interface
+
+uses
+ Classes, Windows, Dialogs, ComCtrls, CompEx, SysUtils, YTools, clock,
+ plutoconst, StdCtrls, forms, XReg, stringcomp;
+
+type
+ TChildren = array of TTreeNode;
+
+ TRegSpyThread = class(TThread)
+ private
+ Reg: TXRegistry;
+ CurNode: TTreeNode;
+ Dead: Boolean;
+ Dif: TSLComp;
+ CurChildren: TChildren;
+ protected
+ procedure Execute; override;
+
+ procedure SaveCheckNode;
+ procedure SaveGetDif;
+ procedure SaveDeleteDead;
+ procedure SaveGetChildren;
+ procedure SaveAddNew;
+ public
+ Restart: Boolean;
+ Mess: string;
+ Delay: Integer;
+ function Alive(Node: TTreeNode): Boolean;
+ procedure Spy;
+ procedure Reload(Node: TTreeNode);
+ procedure ReloadValues;
+ procedure AddTrace(Trace: string);
+ constructor CreateIt(PriorityLevel: TThreadPriority);
+ destructor Destroy; override;
+ end;
+
+implementation
+
+uses plutomain, TreeU, WorkU, ValuesU;
+
+{ TRegSpyThread }
+
+constructor TRegSpyThread.CreateIt(PriorityLevel: TThreadPriority);
+begin
+ inherited Create(True); // Create thread suspended
+ Priority := PriorityLevel; // Set Priority Level
+ FreeOnTerminate := False; // Thread frees itself when terminated
+ Reg := TXRegistry.Create;
+ Delay := 100;
+end;
+
+procedure TRegSpyThread.Execute;
+begin
+ while not Terminated do begin
+ Restart := False;
+ try
+ if not Terminated then
+ Sleep(Delay);
+ if not Terminated then
+ Spy;
+ except end;
+ end;
+end;
+
+function TRegSpyThread.Alive(Node: TTreeNode): Boolean;
+begin
+ Result := False;
+
+ if Restart then
+ Exit;
+
+ if Terminated then
+ Exit;
+
+ if Assigned(Node) then
+ try
+ if (Node.Text = '') then
+ Exit;
+
+ if not Assigned(Node) then
+ Exit;
+
+ Result := True;
+ except
+ Exit;
+ end;
+end;
+
+procedure TRegSpyThread.SaveCheckNode;
+begin
+ Dead := not Alive(CurNode);
+ if Dead then
+ Exit;
+
+ CheckNode(CurNode, False);
+end;
+
+procedure TRegSpyThread.SaveGetDif;
+var
+ Real, Cur: TStringList;
+begin
+ Dead := not Alive(CurNode);
+ if Dead then
+ Exit;
+
+ dif := nil;
+
+ if not CurNode.Expanded then begin
+ Dead := True;
+ Exit; end;
+
+ if not OpenNodeOK(Reg, CurNode) then
+ Exit;
+
+ Real := TStringList.Create;
+
+ Reg.GetKeyNames(Real);
+ Reg.CloseKey;
+
+ Cur := GetChildNames(CurNode);
+
+ if (Cur.Count = 0) and (Real.Count = 0) then
+ Dead := True;
+
+ dif := TSLComp.Create(Cur, Real, False);
+
+ Cur.Free;
+ Real.Free;
+end;
+
+procedure TRegSpyThread.SaveDeleteDead;
+var
+ TN: TTreeNode;
+ i: Integer;
+begin
+ Dead := not Alive(CurNode);
+ if Dead then
+ Exit;
+
+ if not Assigned(dif) or not Assigned(dif.OnlyA) then
+ Exit;
+
+ if CurNode.Expanded then
+ for i := 0 to dif.OnlyA.Count-1 do begin
+ TN := FindNode(CurNode, dif.OnlyA[i]);
+ if Assigned(TN) then begin
+ RegTV.Selected := GetNextBest(TN);
+ TN.Delete;
+ AddTrace('Key deleted: ' + dif.OnlyA[i]);
+ end;
+ end
+ else
+ Exit;
+end;
+
+procedure TRegSpyThread.SaveGetChildren;
+var
+ i: Integer;
+ TN: TTreeNode;
+begin
+ Dead := not Alive(CurNode);
+ if Dead then
+ Exit;
+
+ CurChildren := nil;
+ SetLength(CurChildren, CurNode.Count);
+
+ i := 0;
+ TN := CurNode.GetFirstChild;
+ while Assigned(TN) do begin
+ if i <= High(CurChildren) then
+ CurChildren[i] := TN
+ else
+ ShowMessage('Error: Too much children');
+ Inc(i);
+ TN := CurNode.GetNextChild(TN)
+ end;
+end;
+
+procedure TRegSpyThread.SaveAddNew;
+var
+ i: Integer;
+begin
+ Dead := not Alive(CurNode);
+ if Dead then
+ Exit;
+
+ if not Assigned(Dif) or not Assigned(Dif.OnlyB) or (Dif.OnlyB.Count = 0) then
+ Exit;
+
+ for i := 0 to Dif.OnlyB.Count-1 do begin //Erstellt/hinbenannt
+ RegTV.Items.AddChild(CurNode, Dif.OnlyB[i]);
+ AddTrace('New Key: ' + dif.OnlyB[i]);
+ MainWin.StatusBarUpdate;
+ //AddHint('Neuer Schlüssel: ' + CurNode.Text + '\' + Dif.OnlyB[i]);
+ end;
+end;
+
+procedure TRegSpyThread.Reload(Node: TTreeNode);
+var
+ i: Integer;
+ TN: TTreeNode;
+ zCurNode: TTreeNode;
+ MyChildren: TChildren;
+begin
+ if Terminated or Restart then
+ Exit;
+
+ CurNode := Node;
+
+ zCurNode := CurNode;
+ try
+ //Mess := 'SaveCheckNode';
+ Synchronize(SaveCheckNode);
+ if Dead or Terminated then
+ Exit;
+
+ //Mess := 'SaveGetDif';
+ Synchronize(SaveGetDif);
+ if Dead or Terminated then
+ Exit;
+
+ //Mess := 'SaveDeleteDead';
+ Synchronize(SaveDeleteDead);
+ if Dead or Terminated then
+ Exit;
+
+ //Mess := 'SaveGetChildren';
+ Synchronize(SaveGetChildren);
+ if Dead or Terminated then
+ Exit;
+
+ //Mess := 'SaveGetChildren';
+ Synchronize(SaveAddNew);
+ if Dead or Terminated then
+ Exit;
+
+ Dif.Free;
+
+ //Mess := 'MyChildren';
+ SetLength(MyChildren, Length(CurChildren));
+ for i := 0 to High(MyChildren) do
+ MyChildren[i] := CurChildren[i];
+
+ for i := 0 to High(MyChildren) do begin
+ TN := MyChildren[i];
+ if Alive(TN) then
+ //if TN.Expanded then
+ //if NodeVisible(TN) then
+ Reload(TN);
+ //else
+ //Break;
+ if Restart or Terminated then
+ Break;
+ end;
+ MyChildren := nil;
+
+ except
+ if Terminated then
+ Exit;
+ AddHint('Error in Spy: ' + Mess);
+ WorkWin.Label7.Caption := 'ERROR';
+ end;
+ CurNode := zCurNode;
+end;
+
+function FindItemByRealName(LV: TListView; Text: string): TListItem;
+var
+ i: Integer;
+begin
+ Result := nil;
+ for i := 0 to LV.Items.Count-1 do
+ if LV.Items[i].Caption = Text then begin
+ Result := LV.Items[i];
+ Exit; end;
+ for i := 0 to LV.Items.Count-1 do
+ if SameText(RealValueName(LV.Items[i]), Text) then begin
+ Result := LV.Items[i];
+ Break; end;
+end;
+
+procedure TRegSpyThread.ReloadValues;
+var
+ Item: TListItem;
+ Real, Cur: TStringList;
+ Dif: TSLComp;
+ i: integer;
+begin
+ if Terminated or Restart then
+ Exit;
+
+ if not OpenNodeOK(Reg, RegTV.Selected) then
+ Exit;
+
+ Real := TStringList.Create;
+ Reg.GetValueNames(Real);
+
+ Cur := TStringList.Create;
+ with ValueList.Items do
+ for i := 0 to Count-1 do
+ Cur.Add(RealValueName(Item[i]));
+
+ Dif := TSLComp.Create(Cur, Real, False);
+ Real.Free;
+ Cur.Free;
+
+ for i := 0 to Dif.OnlyA.Count-1 do begin //Gelöscht/wegbenannt
+ Item := FindItemByRealName(ValueList, Dif.OnlyA[i]);
+ if Assigned(Item) then begin
+ Item.Delete;
+ AddTrace('Value deleted: ' + Dif.OnlyA[i]);
+ end;
+ end;
+
+ for i := 0 to ValueList.Items.Count-1 do begin //Daten
+ Item := ValueList.Items[i];
+ {if Item.SubItems.Count < 2 then begin
+ ShowMessage('Fehler in Sync.');
+ Exit end; }
+ if ValuesWin.UpdateValue(Reg, Item) then
+ AddTrace('Value Changed: ' + Item.Caption + ' = ' +
+ ValueDataPreview(Reg.ReadContext(RealValueName(Item))));
+ end;
+
+ for i := 0 to dif.OnlyB.Count-1 do begin //Erstellt/hinbenannt
+ ValuesWin.AddValue(Reg, dif.OnlyB[i]);
+ AddTrace('New Value: ' + Dif.OnlyB[i]);
+ end;
+
+ Reg.CloseKey;
+ Dif.Free;
+end;
+
+procedure TRegSpyThread.Spy;
+var
+ i: Integer;
+ a: Real;
+begin
+ with TClock.Create do begin
+ for i := 0 to RootNodes.Count-1 do
+ Reload(TTreeNode(RootNodes[i]));
+ for i := 0 to High(Shortcuts) do
+ Reload(Shortcuts[i].Node);
+ Synchronize(ReloadValues);
+ a := SecondsPassed * 1000;
+ Free; end;
+
+ if a > 0 then
+ WorkWin.Label7.Caption := 'Spy: ' + Format('%0.2f', [a]) + ' s';
+end;
+
+procedure TRegSpyThread.AddTrace(Trace: string);
+begin
+ with WorkWin do
+ if ListTracesCB.Checked then
+ SpyLB.Items.Add(Trace);
+end;
+
+destructor TRegSpyThread.Destroy;
+begin
+ Dif.Free;
+ Reg.Free;
+ inherited;
+end;
+
+end.
+unit TreeU;
+{$DEFINE UNIKEY}
+{$DEFINE CYCFS}
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ ComCtrls, Menus, Clipbrd, keybrd, Dialogs, YTools, PlutoConst, CompEx,
+ IniFiles, XReg, Colors, Clock,
+ ToolWin, RegFiles {$IFDEF UNIKEY}, UniKey, ImgList {$ENDIF};
+
+type
+ TTreeWin = class(TForm)
+ RegTVPU: TPopupMenu;
+ NewSubKeyMI: TMenuItem;
+ NewKeyMI: TMenuItem;
+ CreateShortcutMI: TMenuItem;
+ TraceMI: TMenuItem;
+ N3: TMenuItem;
+ DeleteMI: TMenuItem;
+ DublicateMI: TMenuItem;
+ N4: TMenuItem;
+ FindMI: TMenuItem;
+ RegTV: TTreeView;
+ PastePathMI: TMenuItem;
+ N1: TMenuItem;
+ InsertPathMI: TMenuItem;
+ RenameMI: TMenuItem;
+ CopyPathMI: TMenuItem;
+ CutPathMI: TMenuItem;
+ EditShortcutMI: TMenuItem;
+ N2: TMenuItem;
+ Export1: TMenuItem;
+ SubKeylist1: TMenuItem;
+ ValueNameslist1: TMenuItem;
+ KeyInfosMI: TMenuItem;
+ N5: TMenuItem;
+ ExportAsReg: TMenuItem;
+ ExportD: TSaveDialog;
+ procedure FormCreate(Sender: TObject);
+ procedure RegTVClick(Sender: TObject);
+ procedure RegTVChange(Sender: TObject; Node: TTreeNode);
+ procedure RegTVChanging(Sender: TObject; Node: TTreeNode; var AllowChange: Boolean);
+ procedure RegTVCollapsing(Sender: TObject; Node: TTreeNode; var AllowCollapse: Boolean);
+ procedure RegTVCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure RegTVDblClick(Sender: TObject);
+ procedure RegTVDeletion(Sender: TObject; Node: TTreeNode);
+ procedure RegTVDragDrop(Sender, Source: TObject; X, Y: Integer);
+ procedure RegTVDragOver(Sender, Source: TObject; X, Y: Integer; State: TDragState; var Accept: Boolean);
+ procedure RegTVEdited(Sender: TObject; Node: TTreeNode; var S: String);
+ procedure RegTVEditing(Sender: TObject; Node: TTreeNode; var AllowEdit: Boolean);
+ procedure RegTVEndDrag(Sender, Target: TObject; X, Y: Integer);
+ procedure RegTVEnter(Sender: TObject);
+ procedure RegTVExpanded(Sender: TObject; Node: TTreeNode);
+ procedure RegTVExpanding(Sender: TObject; Node: TTreeNode; var AllowExpansion: Boolean);
+ procedure RegTVGetSelectedIndex(Sender: TObject; Node: TTreeNode);
+ procedure RegTVKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure RegTVMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ procedure RegTVStartDrag(Sender: TObject; var DragObject: TDragObject);
+
+ function CreateKey(Subkey: Boolean): Boolean;
+ procedure CloneKey;
+ procedure DeleteKey;
+ procedure NewShortcut;
+ procedure MoveKey(const Src, Trg: TRegPath; CopyWanted: Boolean);
+ procedure MoveValues(SrcNode, TrgNode: TTreeNode; CopyWanted: Boolean);
+
+ procedure NewSubKeyMIClick(Sender: TObject);
+ procedure NewKeyMIClick(Sender: TObject);
+ procedure CreateShortcutMIClick(Sender: TObject);
+ procedure TraceMIClick(Sender: TObject);
+ procedure DeleteMIClick(Sender: TObject);
+ procedure DublicateMIClick(Sender: TObject);
+ procedure FindMIClick(Sender: TObject);
+ procedure RegTVPUPopup(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure RegTVKeyPress(Sender: TObject; var Key: Char);
+ procedure RegTVAdvancedCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
+ var PaintImages, DefaultDraw: Boolean);
+ procedure RenameMIClick(Sender: TObject);
+ procedure CopyPathMIClick(Sender: TObject);
+ procedure InsertPathMIClick(Sender: TObject);
+ procedure RegTVGetImageIndex(Sender: TObject; Node: TTreeNode);
+ procedure CheckRegTVHotTrack;
+ procedure PasteKeyMIClick(Sender: TObject);
+ procedure CutPathMIClick(Sender: TObject);
+
+ procedure OpenNextLevel(Node: TTreeNode);
+ procedure EditShortcutMIClick(Sender: TObject);
+ procedure SubKeylist1Click(Sender: TObject);
+ procedure ValueNameslist1Click(Sender: TObject);
+ procedure KeyInfosMIClick(Sender: TObject);
+ function GetKeyInfos: string;
+ procedure ExportAsRegClick(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+
+ procedure Load;
+ procedure Reg4WriterTerminate(Sender: TObject);
+ private
+ DragNode: TTreeNode;
+ NoAsterisk: Boolean; //To prevent NumPadMULTIPLY and asterisk errors
+ UserCopyKeyFlag: Boolean;
+ SpaceCount: Integer; //EasterEgg
+ public
+ CantWrite: Boolean;
+ DoSmartExpand: Boolean;
+ end;
+
+procedure CheckNode(Node: TTreeNode; OnlyOnce: Boolean = True;
+ TakeNodeSelected: Boolean = False);
+
+function AddShortcut(Alias, RealPath: string; Icon: Integer;
+ AHostType: TUniHostType = uhUserShortcut; WriteIni: Boolean = False): TTreeNode;
+function ShortcutIndex(Node: TTreeNode): Integer;
+
+function TraceKey(const Path: string; AllowedShortcutTypes: TUniHostTypes =
+ uhNonSystemShortcuts): string;
+
+type
+ TOpenNodeMode = (onNodeNil, onError, onReadOnly, onFull);
+
+const
+ onOK = [onFull, onReadOnly];
+
+function OpenNode(Reg: TXRegistry; Node: TTreeNode): TOpenNodeMode;
+function OpenNodeOK(Reg: TXRegistry; Node: TTreeNode): Boolean;
+function OpenCurKey: Boolean;
+function OpenCurParent: Boolean;
+
+var
+ TreeWin: TTreeWin;
+
+ RegTV: TTreeView; //Shortcut for other units, equals TreeWin.RegTV
+
+{$IFDEF UNIKEY}
+ UserUniPath: string {$IFDEF CYCFS} = 'cYcFS <y:\programme\cYcFS\test>'{$ENDIF};
+{$ENDIF}
+ Shortcuts: TShortcutA;
+ RootNodes: TList; //list of TTreeNode;
+
+implementation
+
+uses
+ PlutoMain, ValuesU, FindWinU, WorkU, PrefU, ShellEx, Types;
+
+{$R *.dfm}
+
+{$IFDEF UNIKEY}
+function UniOfNode(Node: TTreeNode): TUniKey;
+var
+ UniPath: TUniPath;
+begin
+ UniPath := UniOfStr(UserUniPath);
+ UniPath.Path := Join(Copy(NodePath(Node), 1, MaxInt), '/');
+ Result := TUniKey.CreateU(UniPath, reTryToSolve);
+end;
+{$ENDIF}
+
+procedure TTreeWin.FormCreate(Sender: TObject);
+begin
+ TreeU.RegTV := RegTV;
+
+ DragNode := nil;
+ NoAsterisk := False;
+ DoSmartExpand := True;
+ UserCopyKeyFlag := True;
+ SpaceCount := 0; //EasterEgg
+
+ RegTV.Items.Clear;
+ CheckRegTVHotTrack;
+
+ KeyInfosMI.ImageIndex := iconKeyInfos;
+
+ NewSubKeyMI.ImageIndex := iconSubKey;
+ NewKeyMI.ImageIndex := iconKey;
+ CreateShortcutMI.ImageIndex := iconShortcut;
+
+ RenameMI.ImageIndex := iconRename;
+ DeleteMI.ImageIndex := iconDelete;
+ DublicateMI.ImageIndex := iconKeyDublicate;
+
+ FindMI.ImageIndex := iconKeyFind;
+ TraceMI.ImageIndex := iconKeyTrace;
+end;
+
+procedure TTreeWin.RegTVClick(Sender: TObject);
+begin
+ if KeyIsDown(VK_CONTROL) then begin
+ TraceMIClick(Sender);
+ Exit; end;
+end;
+
+procedure TTreeWin.RegTVChange(Sender: TObject; Node: TTreeNode);
+var
+ Reg: TXRegistry;
+ OpenRe: TOpenNodeMode;
+
+{$IFDEF UNIKEY}
+ Uni: TUniKey;
+ ValueNames: TStringList;
+ Item: TListItem;
+ i: Integer;
+
+ procedure AppendSubItemData(SubItems: TStrings; Uni: TUniKey;
+ const ValueName: string);
+ var
+ SL: TStringList;
+
+ procedure Add(const s: string);
+ begin
+ SubItems.Append(s);
+ end;
+
+ begin
+ SL := nil;
+ try
+ Add('beta');
+
+ case Uni.GetDataType(ValueName) of
+
+ udString, udExpandString: begin
+ Add('String');
+ Add(Uni.ReadString(ValueName));
+ end;
+
+ udCardinal, udCardBigEndian, udInteger: begin
+ Add('Numeric');
+ Add(IntToStr(Uni.ReadInteger(ValueName)));
+ end;
+
+ udBinary, udNone: begin
+ Add('Binary');
+ Add(FriendlyStr(Uni.ReadBinary(ValueName)));
+ end;
+
+ udBoolean: begin
+ Add('Boolean');
+ Add(StrOfBool(Uni.ReadBool(ValueName)));
+ end;
+
+ udStringList: begin
+ Add('List');
+ if not Assigned(SL) then
+ SL := TStringList.Create
+ else
+ SL.Clear;
+ Uni.ReadStringList(ValueName, SL);
+ Add(Join(SL, MultiStringSeparator));
+ end;
+
+ udColor: begin
+ Add('Color');
+ Add(ColorToString(Uni.ReadColor(ValueName)));
+ end;
+
+ else
+ Add('Unsupported Data Type: ' +
+ IntToStr(Cardinal(Uni.GetDataType(ValueName))));
+ end; //case
+
+ finally
+ SL.Free;
+ end;
+ end;
+
+
+{$ENDIF}
+
+begin
+ SpaceCount := 0; //Easteregg
+
+ CheckNode(Node, False);
+ CantWrite := False;
+
+ try
+ SpyThread.Suspend;
+ Reg := TXRegistry.Create;
+ try
+
+{$IFDEF UNIKEY}
+ if RootOfNode(Node).ImageIndex = iconHostUni then begin
+ ValueNames := TStringList.Create;
+ ValueList.Clear;
+
+ Uni := UniOfNode(Node);
+ {Uni := CreateUniSubKey(UserUniPath, Copy(NodePath(Node), 1, MaxInt),
+ reFaile); }
+ if Assigned(Uni) then
+ try
+ Uni.GetValueNames(ValueNames);
+
+ for i := 0 to ValueNames.Count-1 do begin
+ Item := ValuesWin.AddValue(Reg, ValueNames[i], False);
+ Item.ImageIndex := iconHostUni2;
+ AppendSubItemData(Item.SubItems, Uni, ValueNames[i]);
+ end;
+
+ finally
+ Uni.Free;
+ ValueNames.Free;
+ end;
+
+ end else begin
+{$ENDIF}
+
+ OpenRe := OpenNode(Reg, Node);
+ if OpenRe in onOK then begin
+ ValuesWin.LoadValues(Reg);
+ if OpenRe = onReadOnly then begin
+ AddHint('Read only', True);
+ CantWrite := True;
+ end;
+ end else if OpenRe = onError then begin
+ ValueList.Clear;
+ CantWrite := True;
+ if Node.Level = 0 then begin
+ AddHint('Shortcut target not found', True);
+ end else
+ AddHint('Key not found: ' + Node.Text, True);
+ end;
+
+{$IFDEF UNIKEY}
+ end;
+{$ENDIF}
+
+ finally
+ Reg.Free;
+ end;
+
+ CantWrite := CantWrite or not Assigned(Node)
+ or NodeInfo( Node ).ReadOnly //Node itself
+ or NodeInfo(RootOfNode(Node)).ReadOnly //or host
+ or (SameText(CurKey(uhNonSystemShortcuts).Root, 'HKEY_DYN_DATA'));
+
+ MainWin.SetStatus;
+ WorkWin.InfoMemo.Text := GetKeyInfos;
+ finally
+ SpyThread.Restart := True;
+ SpyThread.Resume;
+ end;
+end;
+
+procedure TTreeWin.RegTVChanging(Sender: TObject; Node: TTreeNode;
+ var AllowChange: Boolean);
+begin
+ CantWrite := False;
+ AllowChange := Assigned(Node);
+ // CheckNode(Node, True);
+end;
+
+procedure TTreeWin.RegTVCollapsing(Sender: TObject; Node: TTreeNode;
+ var AllowCollapse: Boolean);
+begin
+ SpyThread.Restart := True;
+ Node.DeleteChildren;
+ RegTVChange(Sender, Node);
+end;
+
+procedure TTreeWin.RegTVCustomDrawItem(Sender: TCustomTreeView; Node: TTreeNode;
+ State: TCustomDrawState; var DefaultDraw: Boolean);
+var
+ Info: TNodeInfo;
+begin
+ {if Node.Text = '' then begin
+ ShowMessage('Error: Key has empty name.');
+ Node.Delete;
+ Exit; end;}
+
+ Info := NodeInfo(Node);
+ with TTreeView(Sender).Canvas.Font do begin
+ if Info.Defect then begin
+ Style := [];
+ Color := $AAAAAA
+ end else begin
+ case Info.HostType of
+
+ uhReg: begin
+ Style := [fsBold];
+ Color := clCyan;
+ end;
+
+ {uhIni: begin
+ Style := [fsBold];
+ Color := clBrightYellow;
+ end;
+
+ uhRegFile: begin
+ Style := [fsBold];
+ Color := clBrightGreen;
+ end; }
+
+ uhSystemShortcut: begin
+ Style := [];
+ Color := clBrightCyan;
+ end;
+
+ uhStandardShortcut: begin
+ Style := [fsBold];
+ Color := $EEEEEE;
+ end;
+
+ uhUserShortcut: begin
+ Style := [];
+ Color := $EEEEEE;
+ end;
+
+ else
+ Style := [];
+ if Info.ReadOnly then
+ Color := clBrightRed
+ else
+ Color := clWhite;
+ end;
+
+ end;
+ end;
+end;
+
+procedure TTreeWin.RegTVDblClick(Sender: TObject);
+var
+ Node: TTreeNode;
+ MouseX: Integer;
+ NodeRect: TRect;
+begin
+ Node := RegTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ MouseX := RegTV.ScreenToClient(Mouse.CursorPos).X;
+ NodeRect := Node.DisplayRect(True);
+ if MouseX > NodeRect.Right then begin
+ with ValuesWin do begin
+ FocusItem(PrefWin.MainPreviewE.Text);
+ ValueListDblClick(Self);
+ end;
+ end;
+end;
+
+procedure TTreeWin.RegTVDeletion(Sender: TObject; Node: TTreeNode);
+begin
+ if Assigned(SpyThread) then
+ SpyThread.Restart := True;
+ if Node.Selected then
+ RegTV.Selected := GetNextBest(Node);
+ NodeInfo(Node).Free;
+end;
+
+procedure TTreeWin.RegTVDragDrop(Sender, Source: TObject; X, Y: Integer);
+
+ procedure DragKey;
+ var
+ Src, Trg: TRegPath;
+ Node: TTreeNode;
+ begin
+ Src := RegPathOfStr(TraceKey(PathOfNode(DragNode)));
+ Trg := RegPathOfStr(TraceKey(PathOfNode(RegTV.DropTarget)));
+ Trg.Key := Trg.Key + '\' + DragNode.Text;
+
+ MoveKey(Src, Trg, KeyIsDown(VK_CONTROL));
+
+ Node := RegTV.DropTarget;
+ if Node.Expanded then
+ Node.Collapse(False);
+ Node.Expanded := False;
+ CheckNode(Node, False, True);
+ Node.Expand(False);
+ end;
+
+ procedure DragValues;
+ begin
+ MoveValues(RegTV.Selected, RegTV.DropTarget, KeyIsDown(VK_CONTROL));
+ end;
+
+begin
+ if Source is TTreeView then
+ DragKey
+ else if Source is TListView then
+ DragValues;
+end;
+
+procedure TTreeWin.RegTVDragOver(Sender, Source: TObject; X, Y: Integer;
+ State: TDragState; var Accept: Boolean);
+begin
+ Accept := False;
+ if not Assigned(RegTV.DropTarget) then
+ Exit;
+
+ if Source is TTreeView then begin
+ if not Assigned(DragNode) then
+ Exit;
+ if not KeyIsDown(VK_CONTROL) then begin
+ if (DragNode = RegTV.DropTarget)
+ or RegTV.DropTarget.HasAsParent(DragNode) then
+ Exit; //avoid recursive moving
+ end;
+ end else if Source is TListView then begin
+ //accept
+ end;
+ Accept := True;
+end;
+
+procedure TTreeWin.RegTVEdited(Sender: TObject; Node: TTreeNode; var S: string);
+var
+ old, tmp: string;
+ i: Integer;
+ Shortcut: PKeyShortcut;
+begin
+ if s = Node.Text then
+ Exit;
+
+ Old := Node.Text;
+
+ if NodeInfo(Node).HostType = uhUserShortcut then begin
+ i := ShortcutIndex(Node);
+ if i = -1 then begin
+ ShowMessage('Shortcut not found!');
+ s := old;
+ Exit; end;
+
+ Shortcut := @Shortcuts[i];
+ Shortcut.Alias := s;
+
+ with TIniFile.Create(PlutoDir + 'Shortcuts.ini') do
+ try
+ DeleteKey('Shortcuts', Old);
+ WriteString('Shortcuts', Shortcut.Alias, Shortcut.RealPath);
+ finally
+ Free;
+ end;
+ Node.Text := s;
+ RegTVChange(Self, Node);
+ Exit; end;
+
+ if s = '' then begin
+ ShowMessage('KeyNames cannot be empty.');
+ s := old;
+ Exit; end;
+
+ SpyThread.Suspend;
+ SpyThread.Restart := True;
+ Node.Text := s;
+
+ if Length(s) > RegMaxKeyLen then begin
+ s := Copy(s, 1, RegMaxKeyLen);
+ if MessageDlg(
+ 'The maximum size of a key name is ' + IntToStr(RegMaxKeyLen) + ' characters.' + EOL +
+ 'Shorten the key name to:' + EOL +
+ Quote(StringWrap(s, 80)),
+ mtConfirmation, [mbOK, mbCancel], 0) <> mrOK then begin
+ s := Old;
+ SpyThread.Resume;
+ Exit;
+ end;
+ end;
+
+ if CharIn(s, [#0..#31, '\']) then begin
+ s := ReplaceChars(s, [#0..#31], '#');
+ s := ReplaceChars(s, '\', '-');
+
+ if MessageDlg('The following characters are not allowed in KeyNames:' + EOL +
+ '- Control chars (0-31)' + EOL +
+ '- ' + Quote('\') + EOL +
+ 'The following name is allowed:' + EOL +
+ s + EOL +
+ 'Use this name instead?',
+ mtConfirmation, [mbYes, mbNo], 0) <> mrYes then begin
+ s := Old;
+ SpyThread.Resume;
+ Exit;
+ end;
+ end;
+
+ try
+ OpenCurParent;
+ if not SameText(s, Old) then begin
+ if not MainReg.KeyExists(s) or
+ (mrIgnore = MessageDlg(
+ 'Key already exists.' + EOL +
+ 'Click Ignore to overwrite the key.',
+ mtConfirmation, [mbCancel, mbIgnore], 0)
+ ) then begin
+ MainReg.DeleteKey(s);
+ MainReg.MoveKey(Old, s, True);
+ Node.Text := Old;
+ end else begin
+ s := Old;
+ end;
+ end else begin //change CharCase
+ tmp := MainReg.GetFreeKeyName;
+ AddHint('Forced change of case using temporary key ' + Quote(tmp));
+ MainReg.MoveKey(Old, tmp, True);
+ MainReg.MoveKey(tmp, s, True);
+ end;
+ finally
+ MainReg.CloseKey;
+ end;
+
+ Node.Text := s;
+ SpyThread.Resume;
+ RegTVChange(Sender, Node);
+end;
+
+procedure TTreeWin.RegTVEditing(Sender: TObject; Node: TTreeNode;
+ var AllowEdit: Boolean);
+begin
+ CheckNode(Node, False);
+ if RegTV.Selected <> Node then
+ Exit;
+ AllowEdit := (NodeInfo(Node).HostType in [uhNone, uhUserShortcut])
+ and (not CantWrite)
+ and OpenCurKey;
+ MainReg.CloseKey;
+end;
+
+procedure TTreeWin.RegTVEndDrag(Sender, Target: TObject; X, Y: Integer);
+begin
+ DragNode := nil;
+end;
+
+procedure TTreeWin.RegTVEnter(Sender: TObject);
+begin
+ if not Started then
+ Exit;
+ ValueList.ItemFocused := nil;
+ MainWin.SetStatus;
+end;
+
+procedure TTreeWin.RegTVExpanded(Sender: TObject; Node: TTreeNode);
+begin
+ if not DoSmartExpand or not PrefWin.SmartExpandCB.Checked then
+ Exit;
+
+ if not Assigned(Node) then
+ Exit;
+
+ RegTVChange(Sender, Node);
+
+ //SmartExpand
+ if (Node.Count > 0) and (ValueList.Items.Count = 0) then begin
+ RegTV.Selected := Node.GetFirstChild;
+ RegTVChange(Sender, RegTV.Selected);
+ end;
+
+ if Node.Count = 1 then
+ Node.GetFirstChild.Expand(False);
+end;
+
+procedure TTreeWin.RegTVExpanding(Sender: TObject; Node: TTreeNode;
+ var AllowExpansion: Boolean);
+var
+ SL: TStringList;
+ Reg: TXRegistry;
+ Clock: TClock;
+{$IFDEF UNIKEY}
+ Uni: TUniKey;
+{$ENDIF}
+
+ procedure AddKeys(TreeView: TTreeView; Node: TTreeNode; SL: TStrings);
+ var
+ i: Integer;
+ begin
+ for i := 0 to SL.Count-1 do
+ TreeView.Items.AddNode(TTreeNode.Create(TreeView.Items), Node, SL[i],
+ nil, naAddChild);
+ end;
+
+ procedure AddKeysProgressive(TreeView: TTreeView; Node: TTreeNode;
+ SL: TStrings);
+ var
+ i, delta: Integer;
+ GaugeRect, FullRect: TRect;
+ GaugeWidth: Integer;
+ begin
+ delta := SL.Count div 100;
+ GaugeWidth := 100;
+ with TreeView.Canvas do begin
+ FullRect := Node.DisplayRect(True);
+ with FullRect do begin
+ Left := Right + 40;
+ Right := Left + GaugeWidth + 2;
+ Inc(Top, 5);
+ Dec(Bottom, 5);
+ end;
+ with Pen do begin
+ Width := 1;
+ Style := psSolid;
+ end;
+ Pen.Color := clBrightBlue;
+ Brush.Style := bsClear;
+ Rectangle(FullRect);
+ Pen.Style := psClear;
+ end;
+
+ GaugeRect := FullRect;
+ with GaugeRect do begin
+ Inc(Left);
+ Inc(Top);
+ Dec(Bottom);
+ end;
+
+ for i := 0 to SL.Count-1 do begin
+ TreeView.Items.AddNode(TTreeNode.Create(TreeView.Items), Node, SL[i],
+ nil, naAddChild);
+
+ if ((i + 1) mod delta) = 0 then begin
+ with TreeView.Canvas do begin
+ GaugeRect.Right := GaugeRect.Left + (GaugeWidth * i) div SL.Count;
+ Brush.Color := GadientAqua(90 + Round(100 * ((i+1) / SL.Count)));
+ FillRect(GaugeRect);
+ end;
+ end;
+ end;
+
+ with TreeView.Canvas do begin
+ Pen.Color := clVeryBrightBlue;
+ Pen.Style := psSolid;
+ Brush.Color := GadientAqua(200);
+ Rectangle(FullRect);
+ Brush.Style := bsClear;
+ end;
+ end;
+
+begin
+ if Node.Expanded then
+ Exit;
+
+ SpyThread.Suspend;
+ SL := TStringList.Create;
+ Clock := TClock.Create;
+
+ try
+
+{$IFDEF UNIKEY}
+ if RootOfNode(Node).ImageIndex = iconHostUni then begin
+ Uni := UniOfNode(Node);
+ if Assigned(Uni) then
+ try
+ Uni.GetKeyNames(SL);
+ finally
+ Uni.Free;
+ end;
+
+ end else begin
+{$ENDIF}
+
+ Reg := TXRegistry.Create;
+ try
+ if OpenNodeOK(Reg, Node) then
+ Reg.GetKeyNames(SL);
+ finally
+ Reg.Free;
+ end;
+
+{$IFDEF UNIKEY}
+ end;
+{$ENDIF}
+
+ Node.DeleteChildren;
+ if PrefWin.ShowProgressCB.Checked and (SL.Count > 100) then
+ AddKeysProgressive(RegTV, Node, SL)
+ else
+ AddKeys(RegTV, Node, SL);
+
+ if PrefWin.SortKeysCB.Checked then
+ Node.AlphaSort;
+
+ if MurphyMode then begin
+ Clock.Stop;
+ AddHint(Format('[MM] Key opened after %0.2f s.', [Clock.SecondsPassed]));
+ end;
+ finally
+ Clock.Free;
+ SL.Free;
+ SpyThread.Resume;
+ end;
+end;
+
+procedure TTreeWin.RegTVGetSelectedIndex(Sender: TObject; Node: TTreeNode);
+begin
+ Node.SelectedIndex := Node.ImageIndex;
+end;
+
+procedure TTreeWin.RegTVKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+var
+ Node: TTreeNode;
+begin
+ if Key = VK_SCROLL then
+ CheckRegTVHotTrack;
+
+ if RegTV.IsEditing then
+ Exit;
+
+ Node := RegTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ if ssShift in Shift then
+ case Key of
+ VK_DOWN: begin
+ Node := Node.GetNextSibling;
+ if Assigned(Node) then
+ RegTV.Selected := Node;
+ Key := 0; end;
+
+ VK_UP: begin
+ Node := Node.GetPrevSibling;
+ if Assigned(Node) then
+ RegTV.Selected := Node;
+ Key := 0; end;
+
+ VK_RIGHT: Key := VK_MULTIPLY;
+ VK_LEFT: Key := VK_DIVIDE;
+ end;
+
+ if Assigned(Node.Parent) then begin
+ case Key of
+ VK_END:
+ begin
+ RegTV.Selected := Node.Parent.GetLastChild;
+ Key := 0; end;
+
+ VK_HOME:
+ begin
+ RegTV.Selected := Node.Parent.GetFirstChild;
+ Key := 0; end;
+ end;
+ end;
+
+ case Key of
+ 0: Exit;
+ VK_RETURN: ValuesWin.FocusControl(ValueList);
+ VK_DELETE: DeleteMIClick(Sender);
+ VK_SPACE: begin
+ JumpToSel(RegTV);
+ Inc(SpaceCount);
+ if SpaceCount > 10 then begin
+ ShowMessage('YES!');
+ SpaceCount := 0;
+ end;
+ end;
+ VK_F9: SwapFonts(RegTV);
+
+ VK_F12:
+ if ssShift in Shift then begin
+ if Assigned(Node.Parent) then Node.Parent.AlphaSort;
+ end else
+ if Node.Expanded then Node.AlphaSort;
+
+ VK_LEFT, VK_SUBTRACT:
+ begin
+ if Node.Expanded then
+ Node.Collapse(False)
+ else if Assigned(Node.Parent) then
+ RegTV.Selected := Node.Parent;
+ Key := 0; end;
+
+ VK_RIGHT, VK_ADD:
+ begin
+ if not Node.HasChildren then
+ TreeWin.RegTV.Items.AddChild(Node, '');
+ if Node.Expanded then
+ RegTV.Selected := Node.GetFirstChild
+ else
+ Node.Expand(False);
+ Key := 0; end;
+
+ VK_MULTIPLY:
+ begin
+ NoAsterisk := True;
+ OpenNextLevel(Node);
+ JumpToSel(RegTV);
+ AddHint('Press the Multiply Key again to open the next level.');
+ Key := 0; end;
+
+ VK_DIVIDE:
+ begin
+ DoSmartExpand := False;
+ Node.Collapse(true);
+ DoSmartExpand := True;
+ Key := 0; end;
+ end;
+
+ if ssctrl in Shift then
+ case Key of
+ Ord('C'): CopyPathMIClick(Sender);
+ Ord('X'): CutPathMIClick(Sender);
+ Ord('V'): PasteKeyMIClick(Sender);
+ end;
+end;
+
+procedure TTreeWin.RegTVMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+var
+ Node: TTreeNode;
+ RelX, RelY: Integer;
+ NodeRect: TRect;
+begin
+ CheckRegTVHotTrack;
+
+ if not Active then
+ Exit;
+
+ RelX := RegTV.ScreenToClient(Mouse.CursorPos).X;
+ RelY := RegTV.ScreenToClient(Mouse.CursorPos).Y;
+ Node := RegTV.GetNodeAt(RelX, RelY);
+ if not Assigned(Node) then
+ Exit;
+
+ if not Node.Selected then
+ Node.Selected := True;
+
+ if Button = mbLeft then begin
+ NodeRect := RegTV.Selected.DisplayRect(True);
+ if RegTV.HotTrack
+ or (RelX < NodeRect.Left) and (RelX > NodeRect.Left - 20) then begin
+ //4px more to the left (friendlier for the user)
+ if not Node.HasChildren then
+ RegTV.Items.AddChild(Node, '');
+ DoSmartExpand := False;
+ with Node do
+ if not Expanded then
+ Expand(False)
+ else
+ Collapse(False);
+ DoSmartExpand := True;
+ end;
+ end;
+end;
+
+procedure TTreeWin.RegTVStartDrag(Sender: TObject; var DragObject: TDragObject);
+begin
+ DragNode := RegTV.Selected;
+ if NodeInfo(DragNode).IsHost then
+ DragNode := nil;
+end;
+
+function OpenNodeError(Reg: TXRegistry; Node: TTreeNode;
+ out Mode: TOpenNodeMode): Integer;
+var
+ Key: string;
+begin
+ Result := ERROR_SUCCESS;
+ Mode := onNodeNil;
+ if not Assigned(Node) then
+ Exit;
+
+ Reg.CloseKey;
+ Key := TraceKey(PathOfNode(Node));
+ Reg.RootKey := HKEYOfStr(ExRegRoot(Key));
+ Result := Reg.OpenKeyError(ExRegKey(Key), False, True);
+ if Success(Result) then
+ if Reg.RootKey = HKDD then
+ Mode := onReadOnly
+ else
+ Mode := onFull
+ else if Reg.OpenKeyReadOnly(ExRegKey(Key)) then
+ Mode := onReadOnly
+ else
+ Mode := onError;
+end;
+
+function OpenNode(Reg: TXRegistry; Node: TTreeNode): TOpenNodeMode;
+begin
+ OpenNodeError(Reg, Node, Result);
+end;
+
+function OpenNodeOK(Reg: TXRegistry; Node: TTreeNode): Boolean;
+begin
+ Result := OpenNode(Reg, Node) in onOK;
+end;
+
+function OpenCurKey: Boolean;
+begin
+ Result := OpenNodeOK(MainReg, RegTV.Selected);
+end;
+
+function OpenCurParent: Boolean;
+begin
+ Result := Assigned(RegTV.Selected)
+ and OpenNodeOK(MainReg, RegTV.Selected.Parent);
+end;
+
+function TTreeWin.CreateKey(Subkey: Boolean): Boolean;
+var
+ Node, NewNode: TTreeNode;
+ KeyName: string;
+ i: integer;
+begin
+ Result := False;
+
+ if CantWrite then
+ Exit;
+
+ Node := RegTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ if not Subkey then begin
+ //key shall be created on same level...
+ if Node.Level = 0 then begin
+ Node := RegTV.Selected;
+ if TraceKey(PathOfNode(Node)) <> PathOfNode(Node) then
+ //check for shortcut: shortcuts are unequal to their trace
+ if mrOK = MessageDlg(
+ 'You are trying to create a Key in the shortcut''s level.' + EOL +
+ 'Pluto needs to jump to the target of the shortcut to do this.',
+ mtConfirmation, [mbOK, mbCancel], 0) then begin
+ MainWin.GotoKey(TraceKey(PathOfNode(Node)));
+ Node := RegTV.Selected.Parent;
+ end else Exit
+ else begin
+ ShowMessage('Key is a HKEY.' + EOL +
+ 'It is not possible to create Keys on HKEY level.');
+ Exit; end;
+ end else
+ Node := Node.Parent; //set reference key to parent
+ end;
+
+ try
+
+ case OpenNode(MainReg, Node) of
+
+ onFull: begin
+ KeyName := 'New'; //find best free name
+ i := 0;
+ while MainReg.KeyExists(KeyName) do begin
+ Inc(i);
+ KeyName := 'New ' + IntToStr(i);
+ end;
+
+ Result := MainReg.CreateKey(KeyName) and MainReg.KeyExists(KeyName);
+ // ^-- CREATE KEY
+
+ if not Result then // <-- FAILED
+ ShowMessage('Could not create key!');
+ end;
+
+ onReadOnly: ShowMessage('Key is read-only.');
+
+ else
+ ShowMessage('Error: Couldn''t open key.');
+
+ end; //case
+
+ finally
+ MainReg.CloseKey;
+ end;
+
+ if not Result then
+ Exit;
+
+ if not Node.Expanded then begin //find the node, if Parent not Expanded
+ CheckNode(Node, False);
+ DoSmartExpand := False;
+ Node.Expand(False);
+ DoSmartExpand := True;
+ NewNode := FindNode(Node, KeyName);
+ end else
+ NewNode := RegTV.Items.AddChild(Node, KeyName); //else create a new node
+
+ Result := Assigned(NewNode);
+ if not Result then
+ ShowMessage('Error: Could not find created key.');
+
+ if Result then begin
+ RegTV.Selected := NewNode;
+ RegTV.Selected.EditText;
+ end;
+end;
+
+procedure TTreeWin.CloneKey;
+var
+ Node: TTreeNode;
+ Full: TRegPath;
+ MainKey, SubKey, NewKey, zKey: string;
+ i: integer;
+begin
+ Node := RegTV.Selected;
+
+ if CantWrite then
+ Exit;
+
+ if NodeInfo(Node).IsHost then
+ Exit;
+
+ Full := CurKey(uhNonSystemShortcuts);
+ MainKey := LWPSolve(Full.Key);
+ SubKey := FromLastChar(MainKey, '\');
+ MainKey := UntilLastChar(MainKey, '\');
+ if SubKey = '' then begin //Directly beyound HKEY
+ SubKey := MainKey;
+ MainKey := '';
+ end;
+
+ try
+ MainReg.RootKey := HKEYOfStr(Full.Root);
+ if not MainReg.OpenKey(MainKey, False) then begin
+ ShowMessage('Error: Couldn''t not open Key: ' + MainKey);
+ Exit end;
+ if Copy(SubKey, 1, 3) <> 'New' then
+ NewKey := 'New ' + SubKey
+ else
+ NewKey := SubKey;
+
+ zKey := Trim(FromLastChar(NewKey, ' '));
+
+ i := StrToIntDef(zKey, 0);
+ if IsValidInteger(zKey) then
+ zKey := Trim(UntilLastChar(NewKey, ' '))
+ else
+ zKey := NewKey;
+
+ while MainReg.KeyExists(NewKey) do begin
+ Inc(i);
+ NewKey := zKey + ' ' + IntToStr(i);
+ end;
+
+ MainReg.MoveKey(SubKey, NewKey, False);
+ finally
+ MainReg.CloseKey;
+ end;
+
+ Node := RegTV.Items.Add(Node, NewKey);
+ RegTV.Selected := Node;
+ Node.EditText;
+end;
+
+procedure TTreeWin.NewShortcut;
+var
+ Node, ShortCutNode: TTreeNode;
+ ScName, ScRealPath: string;
+ i: Integer;
+begin
+ Node := RegTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ if Node.Level = 0 then
+ ScName := 'new ' + Node.Text
+ else
+ ScName := '' + Node.Text;
+
+ ScRealPath := TraceKey(PathOfNode(Node));
+ if not InputQuery('New shortcut to ', ScRealPath, ScName) then
+ Exit;
+
+ for i := 0 to High(ShortCuts) do
+ if SameText(ScName, ShortCuts[i].Alias) then begin
+ ShowMessage('Name already in use.');
+ NewShortcut;
+ Exit; end;
+
+ ShortCutNode := AddShortcut(ScName, ScRealPath, iconShortcut, uhUserShortcut,
+ True);
+ CheckNode(Node, False);
+ RegTV.Selected := ShortCutNode;
+end;
+
+function AddShortcut(Alias, RealPath: string; Icon: Integer;
+ AHostType: TUniHostType = uhUserShortcut;
+ WriteIni: Boolean = False): TTreeNode;
+var
+ Last: Integer;
+begin
+ RealPath := TraceKey(RealPath); //Important: do this BEFORE adding a new,
+ //empty shortcut to ShortCuts
+
+ SetLength(ShortCuts, Length(ShortCuts) + 1);
+ Last := High(Shortcuts);
+ ShortCuts[Last].Alias := Alias;
+ ShortCuts[Last].RealPath := RealPath;
+
+ Result := RegTV.Items.Add(nil, Alias);
+ ShortCuts[Last].Node := Result;
+
+ if Alias = 'HKEY_WindowsMachine' then
+ Icon := iconHKWM
+ else if Alias = 'HKEY_WindowsUser' then
+ Icon := iconHKWU;
+ SetTNImage(Result, Icon);
+
+ NodeInfo(Result).HostType := AHostType;
+
+ if WriteIni then
+ with TIniFile.Create(PlutoDir + 'Shortcuts.ini') do
+ try
+ WriteString('Shortcuts', Alias, RealPath);
+ finally
+ Free;
+ end;
+end;
+
+procedure TTreeWin.DeleteKey;
+var
+ i: Integer;
+ Node, Node2: TTreeNode;
+begin
+ Node := RegTV.Selected;
+
+
+ i := ShortcutIndex(Node);
+ if (i > -1) then begin
+ if (mrYes = MessageDlg('This is a Pluto shortcut to a real key.'#13#10 +
+ 'Do you really want to delete the shortcut?',
+ mtConfirmation, [mbYes, mbCancel], 0)) then begin
+ SpyThread.Suspend;
+ SpyThread.Restart := True;
+ with TIniFile.Create(PlutoDir + 'Shortcuts.ini') do
+ try
+ DeleteKey('Shortcuts', Shortcuts[i].Alias);
+ finally
+ Free;
+ end;
+ Shortcuts[i] := Shortcuts[High(Shortcuts)];
+ SetLength(Shortcuts, Length(Shortcuts)-1);
+ RegTV.Selected := GetNextBest(Node);
+ Node.Delete;
+ RegTVChange(Self, RegTV.Selected);
+ SpyThread.Resume;
+ end;
+ Exit; end;
+
+ if CantWrite then
+ Exit;
+
+ if NodeInfo(Node).IsHost then
+ Exit;
+
+ SpyThread.Suspend;
+ SpyThread.Restart := True;
+
+ Node2 := GetNextBest(Node);
+
+ if MessageDlg('Do you really want to delete this key?', mtConfirmation,
+ [mbYes, mbCancel], 0) = mrYes then
+ try
+ if OpenCurParent then begin
+ if not MainReg.DeleteKey(Node.Text) then //<-- DELETE KEY
+ ShowMessage('Key could not be deleted.')
+ else begin
+ RegTV.Selected := Node2;
+ if Assigned(Node.Parent) and (Node2 = Node.Parent) then
+ Node.Parent.Collapse(False);
+ Node.Delete;
+ end;
+ end;
+ finally
+ MainReg.CloseKey;
+ end;
+
+ RegTVChange(Self, Node2);
+
+ SpyThread.Resume;
+end;
+
+procedure TTreeWin.MoveKey(const Src, Trg: TRegPath; CopyWanted: Boolean);
+var
+ TrgReg: TXRegistry;
+begin
+ with MainReg do begin
+ RootKey := HKEYOfStr(Src.Root);
+ OpenKey('');
+
+ if not KeyExists(Src.Key) then begin
+ ShowMessage('Source not found.');
+ Exit; end;
+ end;
+
+ TrgReg := TXRegistry.Create;
+ with TrgReg do begin
+ RootKey := HKEYOfStr(Trg.Root);
+ OpenKey('');
+ if KeyExists(Trg.Key) then begin
+ ShowMessage('Target already existing.');
+ TrgReg.Free;
+ Exit; end;
+ end;
+
+ if not CopyWanted then
+ if mrYes <> MessageDlg('From source: ' + StrOfRegPath(Src) + EOL +
+ 'To target: ' + StrOfRegPath(Trg) + EOL +
+ 'Do you really want to move this key?',
+ mtConfirmation, [mbYes, mbCancel], 0)
+ then
+ Exit;
+
+ try
+ MainReg.MoveKey(Src.Key, TrgReg, Trg.Key, not CopyWanted); //<-- MOVE KEY
+ except
+ end;
+
+ if not TrgReg.OpenKey(Trg.Key, False) then
+ ShowMessage('Could not move key!')
+ else
+ if not CopyWanted then
+ DragNode.Delete;
+
+
+ TrgReg.Free;
+
+ MainReg.CloseKey;
+end;
+
+procedure TTreeWin.MoveValues(SrcNode, TrgNode: TTreeNode;
+ CopyWanted: Boolean);
+var
+ SrcReg, TrgReg: TXRegistry;
+ i: Integer;
+ ValueName: string;
+ AnswerToAll: Integer;
+
+ function AskForReplacing(const ValueName: string): Integer;
+ begin
+ if AnswerToAll = -1 then begin
+ Result := MessageDlg(
+ 'Value ' + Quote(ValueName) + 'already exists in target key.' + EOL +
+ 'Do you want to replace it?',
+ mtWarning, [mbNo, mbYes, mbNoToAll, mbYesToAll, mbAbort], 0);
+ if Result in [mrNoToAll, mrYesToAll] then begin
+ if Result = mrYesToAll then
+ Result := mrYes
+ else if Result = mrNoToAll then
+ Result := mrNo;
+ AnswerToAll := Result;
+ end;
+ end else Result := AnswerToAll;
+ end;
+
+begin
+ AnswerToAll := -1;
+
+ if not CopyWanted then
+ if mrYes<>MessageDlg(
+ Format(
+ 'Do you really want to move %s' + EOL +
+ 'from: %s' + EOL +
+ 'to: %s',
+ [StrNumerus(ValueList.SelCount, 'value', 'values'),
+ PathOfNode(SrcNode), PathOfNode(TrgNode)]
+ ), mtConfirmation, [mbYes, mbAbort], 0) then
+ Exit;
+
+ SrcReg := TXRegistry.Create;
+ try
+ if not (OpenNode(SrcReg, SrcNode) in onOK) then
+ MessageDlg('Couldn''t open source key: ' + PathOfNode(SrcNode),
+ mtError, [mbOK], 0);
+
+ TrgReg := TXRegistry.Create;
+ try
+ if not (OpenNode(TrgReg, TrgNode) in onOK) then
+ MessageDlg('Couldn''t open target key: ' + PathOfNode(TrgNode),
+ mtError, [mbOK], 0);
+
+ with ValueList.Items do begin
+ for i := 0 to Count-1 do begin
+ if not Item[i].Selected then
+ Continue;
+ ValueName := RealValueName(Item[i]);
+
+ if TrgReg.ValueExists(ValueName) then begin
+ case AskForReplacing(ValueName) of
+ mrYes: ;
+ mrNo: Continue;
+ mrAbort: Break;
+ end;
+ end;
+
+ TrgReg.WriteContext(ValueName, SrcReg.ReadContext(ValueName));
+ if not CopyWanted then
+ SrcReg.DeleteValue(ValueName);
+ end;
+ end;
+
+ finally
+ TrgReg.Free;
+ end;
+
+ finally
+ SrcReg.Free;
+ end;
+
+ if not CopyWanted then
+ ValuesWin.Reload;
+end;
+
+procedure TTreeWin.NewSubKeyMIClick(Sender: TObject);
+begin
+ CreateKey(True);
+end;
+
+procedure TTreeWin.NewKeyMIClick(Sender: TObject);
+begin
+ CreateKey(False);
+end;
+
+procedure TTreeWin.CreateShortcutMIClick(Sender: TObject);
+begin
+ NewShortcut;
+end;
+
+procedure TTreeWin.TraceMIClick(Sender: TObject);
+begin
+ if NodeInfo(RegTV.Selected).IsShortcut then
+ MainWin.GotoKey(TraceKey(PathOfNode(RegTV.Selected)));
+end;
+
+procedure TTreeWin.DeleteMIClick(Sender: TObject);
+begin
+ if not RegTV.IsEditing then
+ DeleteKey;
+end;
+
+procedure TTreeWin.DublicateMIClick(Sender: TObject);
+begin
+ CloneKey;
+end;
+
+procedure TTreeWin.FindMIClick(Sender: TObject);
+begin
+ FindWin.SfCurKeyRB.Checked := True;
+ FindWin.Show;
+end;
+
+procedure TTreeWin.RegTVPUPopup(Sender: TObject);
+begin
+ RegTVChange(Sender, RegTV.Selected);
+ with NodeInfo(RegTV.Selected) do begin
+ NewSubKeyMI.Enabled := not CantWrite;
+ NewKeyMI.Enabled := not CantWrite and (not IsHost or IsShortcut);
+ DublicateMI.Enabled := not CantWrite and not IsHost;
+
+ with DeleteMI do
+ if HostType = uhUserShortcut then begin
+ Caption := '&Delete Shortcut';
+ Enabled := True;
+ end else begin
+ Caption := '&Delete';
+ Enabled := not CantWrite and not IsHost;
+ end;
+
+ RenameMI.Enabled := not CantWrite and (HostType in [uhNone, uhUserShortcut]);
+ TraceMI.Visible := IsShortcut;
+ EditShortcutMI.Visible := HostType = uhUserShortcut;
+ end;
+end;
+
+procedure CheckNode(Node: TTreeNode; OnlyOnce: Boolean = True;
+ TakeNodeSelected: Boolean = False);
+var
+ CurIcon, NewIcon: Integer;
+ Reg: TXRegistry;
+ OpenMode: TOpenNodeMode;
+ Info: TNodeInfo;
+{$IFDEF UNIKEY}
+ Uni: TUniKey;
+{$ENDIF}
+ KeyHasChildren: Boolean;
+
+ procedure SetShortcutIcon(Node: TTreeNode);
+ var
+ Full: string;
+ i: Integer;
+ begin
+ Full := TraceKey(PathOfNode(Node));
+ for i := Low(Shortcuts) to High(Shortcuts) do
+ if Full = Shortcuts[i].RealPath then begin
+ CurIcon := Shortcuts[i].Node.ImageIndex;
+ Exit; end;
+ if Node.ImageIndex in [iconShortcut, iconShortcut + 1] then
+ CurIcon := iconKey + (CurIcon - iconShortcut);
+ end;
+
+begin
+ if not Assigned(Node) then
+ Exit;
+
+ Info := NodeInfo(Node);
+ if OnlyOnce and Info.Checked then
+ Exit;
+
+ CurIcon := Node.ImageIndex;
+ if (CurIcon > iconFirstType) then begin
+{$IFDEF UNIKEY}
+ if RootOfNode(Node).ImageIndex <> iconHostUni then begin
+ SetShortcutIcon(Node);
+ CurIcon := (CurIcon div 2) * 2;
+ end;
+{$ELSE}
+ Exit;
+{$ENDIF}
+ end else begin
+ SetShortcutIcon(Node);
+ CurIcon := (CurIcon div 2) * 2;
+ end;
+ NewIcon := CurIcon;
+
+ Info.ExcludeFlag(nfDefect);
+ Info.ExcludeFlag(nfReadOnly);
+
+{$IFDEF UNIKEY}
+ KeyHasChildren := False;
+
+ if RootOfNode(Node).ImageIndex = iconHostUni then begin
+ Uni := UniOfNode(Node);
+ if Assigned(Uni) then
+ try
+ KeyHasChildren := Uni.HasKeys;
+ if usReadOnly >= Uni.Skills then
+ OpenMode := onReadOnly
+ else
+ OpenMode := onFull;
+ finally
+ Uni.Free;
+ end
+ else
+ OpenMode := onError;
+ end else begin
+{$ENDIF}
+ Reg := TXRegistry.Create;
+ try
+ OpenMode := OpenNode(Reg, Node);
+ KeyHasChildren := Reg.HasSubKeys;
+ finally
+ Reg.Free;
+ end;
+{$IFDEF UNIKEY}
+ end;
+{$ENDIF}
+
+ if OpenMode = onReadOnly then
+ Info.IncludeFlag(nfReadOnly);
+
+ if OpenMode in onOK then begin
+ //OK, could open
+ if not Node.Expanded then begin //Collapsed
+ if KeyHasChildren then begin //HasSubKeys
+ if not Node.HasChildren then begin
+ //Update: Ensure HasChildren
+ if TakeNodeSelected or Node.Selected then
+ TreeWin.RegTV.Items.AddChild(Node, '');
+ end;
+ //Ensure Plus-Icon
+ NewIcon := CurIcon + 1;
+ end else begin
+ //Has still Children?
+ if Node.HasChildren then
+ Node.DeleteChildren;
+ end;
+
+ end else begin //Expanded
+ //HasSubKeys?
+ if KeyHasChildren then begin
+ //OK
+ NewIcon := CurIcon + 1;
+ end else begin
+ //not OK --> update
+ Node.Collapse(True);
+ Node.DeleteChildren;
+ end;
+ end;
+
+ //not OK, couldn't open
+ end else begin //defect
+ if Node.HasChildren then
+ Node.DeleteChildren;
+ Info.IncludeFlag(nfDefect);
+ end;
+
+ if Node.ImageIndex <> iconHostUni then //don't change icon of UniHosts
+ Node.ImageIndex := NewIcon;
+
+ Info.IncludeFlag(nfChecked);
+end;
+
+procedure TTreeWin.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ MainWin.FormKeyDown(Sender, Key, Shift);
+end;
+
+function ShortcutIndex(Node: TTreeNode): Integer;
+//If Node is a Shortcut,
+//S. returns its index in the Shortcuts array
+//else -1
+begin
+ if Node.Level > 0 then begin
+ Result := -1;
+ Exit; end;
+
+ for Result := 0 to High(Shortcuts) do
+ if Shortcuts[Result].Node = Node then begin
+ Exit;
+ end;
+
+ Result := -1;
+end;
+
+function TraceKey(const Path: string; AllowedShortcutTypes: TUniHostTypes =
+ uhNonSystemShortcuts): string;
+var
+ i: Integer;
+ isAim: Boolean;
+
+ function NodeOkForTracing(Node: TTreeNode): Boolean;
+ begin
+ Result := Assigned(Node) and
+ (NodeInfo(Node).HostType in AllowedShortcutTypes);
+ end;
+
+begin
+ Result := MakeLongHKEY(Path);
+ repeat
+ isAim := True;
+ for i := 0 to High(ShortCuts) do begin
+ with Shortcuts[i] do
+ if NodeOkForTracing(Node) and
+ SameText(UntilChar(Result, '\'), Alias) then begin
+ if Alias = RealPath then
+ Break;
+ Delete(Result, 1, Length(Alias));
+ Result := RealPath + Result;
+ isAim := False;
+ Break; end;
+ end;
+ until isAim;
+end;
+
+procedure TTreeWin.RegTVKeyPress(Sender: TObject; var Key: Char);
+begin
+ if (Key = '*') and NoAsterisk then begin
+ Key := #0;
+ NoAsterisk := False;
+ end;
+end;
+
+procedure TTreeWin.RegTVAdvancedCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; Stage: TCustomDrawStage;
+ var PaintImages, DefaultDraw: Boolean);
+var
+ Rect: TRect;
+ MainValueName: string;
+ Reg: TXRegistry;
+ Info: TRegKeyInfo;
+ PreviewPosX: Integer;
+
+ procedure DefaultIconPreview(Reg: TXRegistry);
+ var
+ Icon: HICON;
+ IconFile: string;
+ begin
+ if (Node.Level = 0) and not RegTV.ShowLines then
+ Exit;
+
+ IconFile := Reg.ReadDefaultIcon;
+ if IconFile = '' then
+ Exit;
+
+ Icon := GetIconFromFile(ExpandString(IconFile));
+ if Icon = 0 then
+ Exit;
+
+ with Rect do begin
+ Dec(Left, TTreeView(Sender).Indent + 16);
+ DrawIconEx(Sender.Canvas.Handle, Left, Top,
+ Icon, 16, 16,
+ 0, 0, DI_NORMAL);
+ DestroyIcon(Icon);
+ end;
+ end;
+
+ procedure AddPreview(const PreviewText: string; Color: TColor);
+ begin
+ with Sender.Canvas do begin
+ SetTextColor(Handle, Color);
+ ExtTextOut(Handle, PreviewPosX, Rect.Top + 1, TextFlags, nil,
+ PChar(PreviewText), Length(PreviewText), nil);
+ Inc(PreviewPosX, TextWidth(PreviewText));
+ end;
+ end;
+
+begin
+ if Stage <> cdPostPaint then
+ Exit;
+
+ MainValueName := PrefWin.MainPreviewE.Text;
+
+ Rect := Node.DisplayRect(True);
+ PreviewPosX := Rect.Right + 5;
+
+ Reg := TXRegistry.Create(KEY_READ);
+ try
+ if OpenNodeOK(Reg, Node) then begin
+// Sender.Canvas.Font.Style := [];
+ if PrefWin.KeyInfoPreviewCB.Checked and Reg.GetKeyInfo(Info) then
+ with Info do begin
+ if NumSubKeys > 0 then
+ AddPreview(IntToStr(NumSubKeys) + 'k ', clCyan);
+ if NumValues > 0 then
+ AddPreview(IntToStr(NumValues) + 'v ', clBrightPurple);
+ end;
+
+ if PrefWin.MainPreviewCB.Checked then
+ if Reg.ValueReallyExists(MainValueName) then
+ AddPreview(DataPreviewOfContext(Reg.ReadContext(MainValueName)), $00AAFFFF);
+ {clBrightYellow}
+ if PrefWin.DefaultIconPreviewCB.Checked then
+ DefaultIconPreview(Reg);
+ end;
+ finally
+ Reg.Free;
+ end;
+
+ {if nfCopy in NodeInfo(Node).Flags then begin
+ //Node.StateIndex := 2;
+ Brush.Style := bsClear;
+ with Font do begin
+ Style := [fsItalic, fsBold];
+ Color := clRed;
+ end;
+ //TextOut(Rect.Left - 10, Rect.Top + 3, 'c');
+ end;}
+end;
+
+procedure TTreeWin.RenameMIClick(Sender: TObject);
+begin
+ RegTV.Selected.EditText;
+end;
+
+procedure TTreeWin.CopyPathMIClick(Sender: TObject);
+begin
+ UserCopyKeyFlag := True;
+ MainWin.CopyPathClick(Sender);
+end;
+
+procedure TTreeWin.InsertPathMIClick(Sender: TObject);
+begin
+ MainWin.InsertPathClick(Sender);
+end;
+
+procedure TTreeWin.RegTVGetImageIndex(Sender: TObject; Node: TTreeNode);
+begin
+ if not NodeInfo(Node).Checked then
+ CheckNode(Node);
+end;
+
+procedure TTreeWin.CheckRegTVHotTrack;
+const
+ FindCursorOfSwitch: array[Boolean] of TCursor = (crArrow, crHandPoint);
+var
+ NewHotTrack: Boolean;
+begin
+ NewHotTrack := ScrollON xor PrefWin.KeysSingleClickCB.Checked;
+ if NewHotTrack = RegTV.HotTrack then Exit;
+
+ with RegTV do begin
+ HotTrack := NewHotTrack;
+ Cursor := FindCursorOfSwitch[HotTrack];
+ Mouse.CursorPos := Mouse.CursorPos; //update cursor
+ end;
+end;
+
+procedure TTreeWin.PasteKeyMIClick(Sender: TObject);
+var
+ Src, Trg: TRegPath;
+ Node: TTreeNode;
+begin
+ Src := RegPathOfStr(Clipboard.AsText);
+ Trg := CurKey(uhNonSystemShortcuts);
+ Trg.Key := Trg.Key + '\' + FromLastChar(Src.Key, '\', True);
+
+ MoveKey(Src, Trg, UserCopyKeyFlag);
+
+ Node := RegTV.Selected;
+ if Node.Expanded then
+ Node.Collapse(False);
+ Node.Expanded := False;
+ CheckNode(Node, False);
+ Node.Expand(False);
+
+ if not UserCopyKeyFlag then
+ RegTV.Repaint; // CheckNode(Node, False);
+
+ UserCopyKeyFlag := True;
+end;
+
+procedure TTreeWin.CutPathMIClick(Sender: TObject);
+begin
+ UserCopyKeyFlag := False;
+ MainWin.CopyPathClick(Sender);
+end;
+
+procedure TTreeWin.OpenNextLevel(Node: TTreeNode);
+
+ procedure ExpandKeys(Node: TTreeNode);
+ begin
+ CheckNode(Node, False, True);
+ if not Node.HasChildren then
+ Exit;
+ if not Node.Expanded then
+ Node.Expand(False)
+ else begin
+ Node := Node.GetFirstChild;
+ while Assigned(Node) do begin
+ ExpandKeys(Node);
+ Node := Node.GetNextSibling; end;
+ end;
+ end;
+
+begin
+ DoSmartExpand := False;
+ ExpandKeys(Node);
+ DoSmartExpand := True;
+end;
+
+procedure TTreeWin.EditShortcutMIClick(Sender: TObject);
+var
+ NewPath: string;
+ i: Integer;
+ Node: TTreeNode;
+ Shortcut: PKeyShortcut;
+begin
+ Node := RegTV.Selected;
+ if NodeInfo(Node).HostType <> uhUserShortcut then
+ Exit;
+
+ i := ShortcutIndex(Node);
+ if i = -1 then
+ Exit;
+
+ with TIniFile.Create(PlutoDir + 'Shortcuts.ini') do
+ try
+ NewPath := ReadString('Shortcuts', Shortcuts[i].Alias, '');
+ finally
+ Free;
+ end;
+
+ if not InputQuery('Edit Shortcut', 'Shortcut to...', NewPath) then
+ Exit;
+
+ Node.Collapse(False);
+ Shortcut := @Shortcuts[i];
+ Shortcut.RealPath := TraceKey(NewPath);
+ with TIniFile.Create(PlutoDir + 'Shortcuts.ini') do
+ try
+ WriteString('Shortcuts', Shortcut.Alias, Shortcut.RealPath);
+ finally
+ Free;
+ end;
+
+ RegTVChange(Self, Node);
+end;
+
+procedure TTreeWin.SubKeylist1Click(Sender: TObject);
+var
+ SL: TStringList;
+begin
+ SL := TStringList.Create;
+ if OpenCurKey then
+ try
+ MainReg.GetKeyNames(SL);
+ if PrefWin.SortKeysCB.Checked then
+ SL.Sort;
+ Clipboard.AsText := SL.Text;
+ finally
+ MainReg.CloseKey;
+ SL.Free;
+ end;
+end;
+
+procedure TTreeWin.ValueNameslist1Click(Sender: TObject);
+var
+ SL: TStringList;
+begin
+ SL := TStringList.Create;
+ if OpenCurKey then
+ try
+ MainReg.GetValueNames(SL);
+ if PrefWin.SortKeysCB.Checked then
+ SL.Sort;
+ Clipboard.AsText := SL.Text;
+ finally
+ MainReg.CloseKey;
+ SL.Free;
+ end;
+end;
+
+procedure TTreeWin.KeyInfosMIClick(Sender: TObject);
+begin
+ MessageDlg(GetKeyInfos, mtInformation, [mbOK], 0);
+end;
+
+function TTreeWin.GetKeyInfos: string;
+const
+ sErrorMsg = 'Error! No: %d Msg: %s';
+
+var
+ Node: TTreeNode;
+ Reg: TXRegistry;
+ Mode: TOpenNodeMode;
+ Error: Integer;
+ Info: TNodeInfo;
+ Flag: TNodeFlag;
+
+ procedure Add(const S: string);
+ begin
+ Result := Result + S;
+ end;
+
+ procedure AddLn(const S: string = '');
+ begin
+ Add(S + EOL);
+ end;
+
+ procedure AddNodeInfo(Key: HKEY);
+ var
+ KeyInfo: TRegKeyInfo;
+ Res: Integer;
+ KeyAge: TDateTime;
+ begin
+ FillChar(KeyInfo, SizeOf(TRegKeyInfo), 0);
+ with KeyInfo do begin
+ Res := RegQueryInfoKey(Reg.CurrentKey, nil, nil, nil, @NumSubKeys,
+ @MaxSubKeyLen, nil, @NumValues, @MaxValueLen,
+ @MaxDataLen, nil, @LastWriteTime);
+
+ if Res = ERROR_SUCCESS then begin
+ Add(Format(
+ 'Subkeys: %0:d' + EOL +
+ 'Values: %2:d' + EOL +
+ 'Max subkeys length: %1:d' + EOL +
+ 'Max value name length: %3:d' + EOL +
+ 'Max data length: %4:d' + EOL +
+ '',
+ [NumSubKeys, MaxSubKeyLen, NumValues, MaxValueLen, MaxDataLen]));
+ KeyAge := DateTimeOfFileTime(LastWriteTime);
+ if KeyAge > 0 then
+ AddLn('Last write time: ' + DateTimeToStr(KeyAge));
+ end else
+ AddLn('Couldn''t get key info.' + EOL +
+ 'Error Code: ' + IntToStr(Res) + EOL +
+ 'Message: ' + SysErrorMessage(Res));
+ end;
+ end;
+
+begin
+ Result := '';
+ Node := RegTV.Selected;
+
+ Reg := TXRegistry.Create(KEY_READ);
+ try
+ try
+ Error := OpenNodeError(Reg, RegTV.Selected, Mode);
+
+ case Mode of
+ onFull: AddLn('Full Access');
+ onReadOnly: AddLn('Read only');
+ onError:
+ AddLn(Format(sErrorMsg, [Error, SysErrorMessage(Error)]));
+ onNodeNil: AddLn('Node is nil!');
+
+ else
+ AddLn('Unknown Mode: ' + IntToStr(Integer(Mode)));
+ end;
+
+ if Mode in onOK then
+ AddNodeInfo(Reg.CurrentKey);
+
+ except
+ on E: Exception do begin
+ Error := GetLastError;
+ if Error <> ERROR_SUCCESS then
+ AddLn(Format('Error! No: %d Msg: %s', [Error, SysErrorMessage(Error)]))
+ else
+ AddLn(E.Message);
+ end;
+ end;
+ finally
+ Reg.Free;
+ end;
+
+ if MurphyMode then begin
+ AddLn('[MM] ImageIndex: ' + IntToStr(Node.ImageIndex));
+ Info := NodeInfo(Node);
+
+ if Info.HostType in [uhNone..High(HostTypeStrings)] then
+ AddLn('[MM] HostType: ' + HostTypeStrings[Info.HostType])
+ else
+ AddLn('[MM] Unknown HostType: ' + IntToStr(Integer(Info.HostType)));
+ Add('[MM] Flags: ');
+ for Flag := Low(TNodeFlag) to High(TNodeFlag) do
+ if Flag in Info.Flags then
+ Add(NodeFlagStrings[Flag] + ' ');
+ AddLn;
+ end;
+end;
+
+procedure TTreeWin.ExportAsRegClick(Sender: TObject);
+var
+ Node: TTreeNode;
+ Reg: TXRegistry;
+
+ procedure ExportAsReg4(Reg: TXRegistry; const FileName: string);
+ var
+ Reg4Writer: TReg4Writer;
+ begin
+ Reg4Writer := TReg4Writer.Create(tpNormal, FileName,
+ TraceKey(PathOfNode(Node)), Reg.DeliverKey);
+ with Reg4Writer do begin
+ OnTerminate := Reg4WriterTerminate;
+ try
+ AddHint(Format('starting .reg-export: %s...',
+ [Root + '\' + Path]));
+ Resume;
+ except
+ Free;
+ end;
+ end;
+ AddToLastHint('started.');
+ end;
+
+
+ procedure ExportAsHive(Reg: TXRegistry; const FileName: string);
+ begin
+ if Reg.SaveKey('', FileName) then
+ AddHint('hive export successfull.')
+ else
+ AddHint(Format('hive export failed: %s',
+ [SysErrorMessage(LastSuccessRes)]));
+ end;
+
+begin
+ Node := RegTV.Selected;
+ with ExportD do begin
+ FileName := MakeValidFileName(Node.Text, 'key');
+
+ if Execute then begin
+ Reg := TXRegistry.Create;
+ try
+ if OpenNodeOK(Reg, Node) then begin
+ if FileExists(FileName) and (mrYes=MessageDlg(
+ 'File already exists.' + EOL +
+ 'Delete existing file?',
+ mtWarning, [mbYes, mbNo], 0)) then begin
+ FileSetAttr(FileName, 0);
+ DeleteFile(FileName);
+ end;
+ case FilterIndex of
+ 1: ExportAsReg4(Reg, FileName);
+ 2: ExportAsHive(Reg, FileName);
+ else
+ ShowMessage(Format('Wrong Filter: %d', [FilterIndex]));
+ end;
+ end;
+ finally
+ Reg.Free;
+ end;
+ end;
+ end;
+end;
+
+procedure TTreeWin.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+// Action := caNone;
+end;
+
+procedure TTreeWin.Load;
+var
+ NodeHKLM, NodeHKU, NodeHKDD, NodeHKPD: TTreeNode;
+ NodeHostReg: TTreeNode;
+
+ procedure LoadShortcuts(FileName: string; HostType: TUniHostType);
+ var
+ i: Integer;
+ SL: TStringList;
+ ShortcutIni: TIniFile;
+ begin
+ if not FileEx(FileName) then begin
+ AddToLastHint('not found:');
+ AddHint(FileName);
+ Exit end;
+
+ ShortcutIni := TIniFile.Create(FileName);
+ SL := TStringList.Create;
+
+ try
+ ShortcutIni.ReadSectionValues('Shortcuts', SL);
+ for i := 0 to SL.Count-1 do
+ AddShortcut(SL.Names[i], SL.Values[SL.Names[i]], iconShortcut,
+ HostType);
+ AddToLastHint('OK');
+ finally
+ SL.Free;
+ ShortcutIni.Free;
+ end;
+ end;
+
+begin
+ NodeHostReg := nil;
+
+ AddHint('Creating Hosts...');
+ RootNodes := TList.Create;
+ ChangeLastHint('Creating Hosts...HKEY_LOCAL_MACHINE');
+ NodeHKLM := RegTV.Items.AddChild(NodeHostReg, 'HKEY_LOCAL_MACHINE');
+ SetTNImage(NodeHKLM, iconHKLM);
+ NodeInfo(NodeHKLM).HostType := uhReg;
+ RootNodes.Add(NodeHKLM);
+
+ ChangeLastHint('Creating Hosts...HKEY_USERS');
+ NodeHKU := RegTV.Items.AddChild(NodeHostReg, 'HKEY_USERS');
+ SetTNImage(NodeHKU, iconHKU);
+ NodeInfo(NodeHKU).HostType := uhReg;
+ RootNodes.Add(NodeHKU);
+
+ ChangeLastHint('Creating Hosts...HKEY_CURRENT_USER');
+ if RegRealPath('HKEY_CURRENT_USER') = 'HKEY_CURRENT_USER' then
+ //could not dereference hkcu
+ AddShortcut('HKEY_CURRENT_USER', 'HKEY_CURRENT_USER',
+ iconHKCU, uhReg)
+ else
+ AddShortcut('HKEY_CURRENT_USER', RegRealPath('HKEY_CURRENT_USER'),
+ iconHKCU, uhSystemShortcut);
+
+ ChangeLastHint('Creating Hosts...HKEY_CURRENT_CONFIG');
+ AddShortcut('HKEY_CURRENT_CONFIG', RegRealPath('HKEY_CURRENT_CONFIG'),
+ iconHKCC, uhSystemShortcut);
+
+ ChangeLastHint('Creating Hosts...HKEY_CLASSES_ROOT');
+ AddShortcut('HKEY_CLASSES_ROOT', RegRealPath('HKEY_CLASSES_ROOT'),
+ iconHKCR, uhSystemShortcut);
+
+ MainReg.RootKey := HKEY_DYN_DATA;
+ if MainReg.OpenKeyReadOnly('') then begin
+ MainReg.CloseKey;
+ ChangeLastHint('Creating Hosts...HKEY_DYN_DATA');
+ NodeHKDD := RegTV.Items.AddChild(nil, 'HKEY_DYN_DATA');
+ NodeInfo(NodeHKDD).HostType := uhReg;
+ NodeInfo(NodeHKDD).IncludeFlag(nfReadOnly);
+ SetTNImage(NodeHKDD, iconHKDD);
+ RootNodes.Add(NodeHKDD);
+ end;
+
+ MainReg.RootKey := HKEY_PERFORMANCE_DATA;
+ if MainReg.OpenKeyReadOnly('') then begin
+ MainReg.CloseKey;
+ ChangeLastHint('Creating Hosts...HKEY_PERFORMANCE_DATA');
+ NodeHKPD := RegTV.Items.AddChild(nil, 'HKEY_PERFORMANCE_DATA');
+ NodeInfo(NodeHKPD).HostType := uhReg;
+ SetTNImage(NodeHKPD, iconHKPD);
+ RootNodes.Add(NodeHKPD);
+ end;
+
+ ChangeLastHint('Creating Host...OK');
+
+ AddHint('Loading Standard Shortcuts...');
+ LoadShortcuts(PlutoDir + StandardShortcutsFileName, uhStandardShortcut);
+
+ AddHint('Loading User Shortcuts...');
+ LoadShortcuts(PlutoDir + ShortcutsFileName, uhUserShortcut);
+
+{$IFDEF UNIKEY}
+ AddShortcut('Uni', '', iconHostUni);
+{$ENDIF}
+end;
+
+procedure TTreeWin.Reg4WriterTerminate(Sender: TObject);
+begin
+ with Sender as TRegFileWriter do
+ AddHint(Format('.reg-export finished (%0.2f s): %s',
+ [Clk.SecsPassed, Root + '\' + Path]));
+end;
+
+end.
+unit valuesU;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ ComCtrls, Menus, Clipbrd, XReg, CompEx, Math, YTools, Dialogs, YTypes,
+ PlutoConst, keybrd, ImgList, clock;
+
+type
+ TValuesWin = class(TForm)
+ ValueListPU: TPopupMenu;
+ NewStringMI: TMenuItem;
+ NewDWORDMI: TMenuItem;
+ NewBinaryMI: TMenuItem;
+ ConvertToMI: TMenuItem;
+ ConvStringMI: TMenuItem;
+ ConvDWORDMI: TMenuItem;
+ ConvBinaryMI: TMenuItem;
+ ValueList: TListView;
+ DeleteMI: TMenuItem;
+ N1: TMenuItem;
+ RenameMI: TMenuItem;
+ NewElseMI: TMenuItem;
+ NewMultiStringMI: TMenuItem;
+ REGNONE1: TMenuItem;
+ LINK1: TMenuItem;
+ NewExpandStringMI: TMenuItem;
+ N3BINARY1: TMenuItem;
+ N4DWORD1: TMenuItem;
+ N4DWORDLITTLEEDIAN1: TMenuItem;
+ NewBigEndianMI: TMenuItem;
+ N6LINK1: TMenuItem;
+ N7MULTISZ1: TMenuItem;
+ RESOURCELIST1: TMenuItem;
+ N9FULLRESOURCEDESCRIPTOR1: TMenuItem;
+ ARESOURCEREQUIREMENTSLIST1: TMenuItem;
+ NewDefaultValueMI: TMenuItem;
+ EditMI: TMenuItem;
+ EditBinaryMI: TMenuItem;
+ N3: TMenuItem;
+ CopyDataPreviewMI: TMenuItem;
+ DublicateMI: TMenuItem;
+ MultiString1: TMenuItem;
+ ZeromizeMI: TMenuItem;
+ N4: TMenuItem;
+ CopyPathMI: TMenuItem;
+ TakeAsMainValueMI: TMenuItem;
+ SelectAllMI: TMenuItem;
+ InvertSelectionMI: TMenuItem;
+ procedure FormCreate(Sender: TObject);
+ procedure InitListColumnTags;
+
+ procedure NewStringMIClick(Sender: TObject);
+ procedure NewDWORDMIClick(Sender: TObject);
+ procedure NewBinaryMIClick(Sender: TObject);
+ procedure ConvertValue(Sender: TObject);
+
+ procedure CreateValue(Typ: TRegDataType);
+ procedure ZeromizeValue;
+ procedure DeleteValue;
+ procedure CloneValue;
+ function TryRenameValue(OldName: string; var NewName: string): Boolean;
+
+ procedure ValueListChange(Sender: TObject; Item: TListItem; Change: TItemChange);
+ procedure ValueListCustomDrawItem(Sender: TCustomListView; Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure ValueListDblClick(Sender: TObject);
+ procedure ValueListEditing(Sender: TObject; Item: TListItem; var AllowEdit: Boolean);
+ procedure ValueListEdited(Sender: TObject; Item: TListItem; var S: String);
+ procedure ValueListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure ValueListResize(Sender: TObject);
+
+ function UpdateValue(Reg: TXRegistry; Item: TListItem): Boolean;
+ procedure UpdateValues(SelectedOnly: Boolean = False);
+ procedure Reload(JumpToNewValue: Boolean = False; ValueName: string = '');
+ procedure LoadValues(Reg: TXRegistry);
+
+ function AddValue(Reg: TXRegistry; const ValueName: string; AppendInfos: Boolean = True): TListItem;
+ procedure ValueListPUPopup(Sender: TObject);
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure ValueListDeletion(Sender: TObject; Item: TListItem);
+ procedure DeleteMIClick(Sender: TObject);
+ procedure RenameMIClick(Sender: TObject);
+ procedure NewBigEndianMIClick(Sender: TObject);
+ procedure NewExpandStringMIClick(Sender: TObject);
+ procedure NewMultiStringMIClick(Sender: TObject);
+ procedure NewStrangeTypeMIClick(Sender: TObject);
+ procedure NewDefaultValueMIClick(Sender: TObject);
+ procedure ValueListChanging(Sender: TObject; Item: TListItem; Change: TItemChange; var AllowChange: Boolean);
+ procedure ValueListMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ procedure EditBinaryMIClick(Sender: TObject);
+ procedure EditMIClick(Sender: TObject);
+ procedure ValueListCustomDrawSubItem(Sender: TCustomListView; Item: TListItem; SubItem: Integer; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure ValueListCompare(Sender: TObject; Item1, Item2: TListItem; Data: Integer; var Compare: Integer);
+ procedure ValueListColumnClick(Sender: TObject; Column: TListColumn);
+ procedure DublicateMIClick(Sender: TObject);
+ procedure CopyDataPreviewMIClick(Sender: TObject);
+ procedure CopyDataPreview;
+ procedure ZeromizeMIClick(Sender: TObject);
+ procedure CopyPathMIClick(Sender: TObject);
+
+ function FindItemByRealName(const ValueName: string): Integer;
+
+ function FocusItem(ARealValueName: string;
+ FocusValueList: Boolean = False): Boolean;
+ procedure TakeAsMainValueMIClick(Sender: TObject);
+ procedure FormShow(Sender: TObject);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure ValueListClick(Sender: TObject);
+ procedure CheckValueListHotTrack;
+ procedure SelectAllMIClick(Sender: TObject);
+ procedure InvertSelectionMIClick(Sender: TObject);
+ procedure FormDestroy(Sender: TObject);
+ private
+ ValueLabelClicked: Boolean;
+ SortBy: TValueListColumn;
+ SortByColumn: TListColumn;
+ SubItemIndex: array[TValueListColumn] of Integer;
+ public
+ ValueNames: TStringList;
+ ValuesCommon: Boolean;
+ ValueCommonType: TRegDataType;
+ end;
+
+var
+ ValuesWin: TValuesWin;
+ ValueList: TListView;
+
+ DefaultValueCaption: string = '';
+
+function ItemIsDefaultValue(Item: TListItem): Boolean;
+function RealValueName(Item: TListItem): string;
+procedure SetRealValueName(Item: TListItem; Caption: string);
+function IconOfDataType(Typ: TRegDataType): Integer;
+function IsMainValue(Item: TListItem): Boolean;
+
+function ColorOfDataType(DataType: TRegDataType;
+ DefaultColor: TColor = clWhite): TColor;
+function DataPreviewOfContext(Context: TRegContext): string;
+
+function ValueDataSize(Context: TRegContext): string;
+function ValueDataType(Context: TRegContext): string;
+function ValueDataPreview(Context: TRegContext): string;
+function ValueTypeIcon(Context: TRegContext): Integer;
+
+function StrOfRegDataType(Typ: TRegDataType): string;
+
+implementation
+
+uses PlutoMain, TreeU, WorkU, PrefU;
+
+{$R *.dfm}
+
+function ItemIsDefaultValue(Item: TListItem): Boolean;
+begin
+ Result := Item.Data = Pointer(DefaultValueFlag);
+end;
+
+function RealValueName(Item: TListItem): string;
+begin
+ if ItemIsDefaultValue(Item) then
+ Result := ''
+ else
+ Result := Item.Caption;
+end;
+
+procedure SetRealValueName(Item: TListItem; Caption: string);
+begin
+ if Caption = '' then begin
+ Item.Caption := DefaultValueCaption;
+ Item.Data := Pointer(DefaultValueFlag);
+ end else begin
+ Item.Caption := Caption;
+ Item.Data := nil;
+ end;
+end;
+
+function IsMainValue(Item: TListItem): Boolean;
+begin
+ Result := False;
+ if csDestroying in PrefWin.ComponentState then
+ Exit;
+
+ Result := RealValueName(Item) = PrefWin.MainPreviewE.Text;
+end;
+
+function ColorOfDataType(DataType: TRegDataType;
+ DefaultColor: TColor = clWhite): TColor;
+begin
+ if DataType in rdStringTypes then Result := clBrightRed
+ else if DataType = rdMultiString then Result := clBrightPurple
+ else if DataType in rdCardTypes then Result := clBrightBlue
+ else if DataType = rdBinary then Result := clBrightGreen
+ else Result := DefaultColor;
+end;
+
+function StrOfRegDataType(Typ: TRegDataType): string;
+const
+ RegDataTypeStrings: array[rdNone..rdLastType] of string = (
+ 'NONE',
+ 'SZ',
+ 'EXPAND_SZ',
+ 'BINARY',
+ 'DWORD',
+ 'DWORD_BIG_ENDIAN',
+ 'LINK',
+ 'MULTI_SZ',
+ 'RESOURCE_LIST',
+ 'FULL_RESOURCE_DESCRIPTOR',
+ 'RESOURCE_REQUIREMENTS_LIST',
+ 'QUAD_WORD'
+ );
+begin
+ if Typ in [rdNone..rdLastType] then
+ Result := RegDataTypeStrings[Typ]
+ else
+ Result := IntToStr(Typ);
+end;
+
+procedure TValuesWin.NewStringMIClick(Sender: TObject);
+begin
+ CreateValue(rdString);
+end;
+
+procedure TValuesWin.NewDWORDMIClick(Sender: TObject);
+begin
+ CreateValue(rdCardinal);
+end;
+
+procedure TValuesWin.NewBinaryMIClick(Sender: TObject);
+begin
+ CreateValue(rdBinary);
+end;
+
+procedure TValuesWin.CreateValue(Typ: TRegDataType);
+var
+ Item: TListItem;
+ ValueName: string;
+ i: Integer;
+ SL: TStringList;
+begin
+ if csDestroying in (TreeWin.ComponentState + MainWin.ComponentState) then
+ Exit;
+
+ if TreeWin.CantWrite then
+ Exit;
+
+ with MainReg do begin
+ try
+ OpenCurKey;
+
+ ValueName := 'New'; // find free name
+ i := 0;
+ while ValueExists(ValueName) do begin
+ Inc(i);
+ ValueName := 'New ' + IntToStr(i);
+ end;
+
+ case Typ of
+ rdString: begin
+ WriteString(ValueName, '');
+ end;
+ rdExpandString: begin
+ WriteExpandString(ValueName, '');
+ end;
+ rdCardinal: begin
+ WriteCardinal(ValueName, 0);
+ end;
+ rdCardBigEndian: begin
+ WriteCardinal(ValueName, 0, True);
+ end;
+ rdMultiString: begin
+ SL := TStringList.Create;
+ WriteMultiString(ValueName, SL);
+ SL.Free;
+ end;
+ rdBinary: begin
+ WriteBin(ValueName, nil);
+ end;
+ else
+ WriteBinType(ValueName, nil, Typ);
+ end;
+
+ if not ValueExists(ValueName) then begin
+ ShowMessage('Could not create Value.');
+ CloseKey;
+ Exit; end;
+
+ ValuesWin.AddValue(MainReg, ValueName);
+ finally
+ CloseKey;
+ end;
+ end;
+
+ Item := FindItem(ValueList, ValueName);
+
+ if not Assigned(Item) then begin
+ ShowMessage('Error, Value not found: ' + ValueName);
+ Exit; end;
+
+ SelectItemOnly(ValueList, Item);
+ MainWin.StatusBarUpdate;
+ ValueLabelClicked := True;
+ Item.EditCaption;
+end;
+
+procedure TValuesWin.FormCreate(Sender: TObject);
+begin
+ ValuesU.ValueList := ValueList;
+
+ DefaultValueCaption := PrefWin.DefaultValueNameE.Text;
+ ValueLabelClicked := False;
+ SortBy := vlcName;
+ SortByColumn := nil;
+
+ ValueListResize(Sender);
+ ValueList.Items.Clear;
+ CheckValueListHotTrack;
+
+ ValueNames := TStringList.Create;
+ ValuesCommon := False;
+ ValueCommonType := 0;
+
+ NewDefaultValueMI.ImageIndex := iconMainValue;
+ NewStringMI.ImageIndex := iconString;
+ NewDWORDMI.ImageIndex := iconCardinal;
+ NewBinaryMI.ImageIndex := iconBinary;
+ NewMultiStringMI.ImageIndex := iconMultiString;
+ NewElseMI.ImageIndex := iconValueElse;
+
+ DublicateMI.ImageIndex := iconValueDublicate;
+ DeleteMI.ImageIndex := iconDelete;
+ ZeromizeMI.ImageIndex := iconValueZeromize;
+
+ EditMI.ImageIndex := iconValueEdit;
+ EditBinaryMI.ImageIndex := iconValueEditBinary;
+ RenameMI.ImageIndex := iconRename;
+
+ TakeAsMainValueMI.ImageIndex := iconTakeAsMainValue;
+end;
+
+procedure TValuesWin.ConvertValue(Sender: TObject);
+{var
+ Allow: Boolean;
+ OldActive: Integer; }
+begin
+{ TargetPage := ShowPC.Pages[TMenuItem(Sender).Tag];
+
+ OldActive := ShowPC.ActivePageIndex;
+ ShowPC.ActivePageIndex := TMenuItem(Sender).Tag;
+ WorkWin.ShowPCChanging(Sender, Allow);
+ if not Allow then
+ ShowPC.ActivePageIndex := OldActive; }
+end;
+
+function ValueDataSize(Context: TRegContext): string;
+var
+ Typ: TRegDataType;
+ Size: Integer;
+// ValueName: string;
+// SL: TStringList;
+begin
+ Result := '';
+
+ if csDestroying in PrefWin.ComponentState then
+ Exit;
+
+// ValueName := RealValueName(Item);
+ Typ := Context.Typ;
+ Size := Length(Context.Data);
+
+ if Typ in rdStringTypes then
+ if not PrefWin.CountZeroByteCB.Checked then
+ Dec(Size);
+
+ if Typ = rdMultiString then
+ if PrefWin.ShowLineCountCB.Checked then begin
+ Size := CharCount(StrOfByteA(Context.Data), #0) - 2;
+{ SL := TStringList.Create;
+ try
+ Reg.ReadMultiString(ValueName, SL, PrefWin.UseExtendedModelCB.Checked);
+ Size := SL.Count;
+ finally
+ SL.Free;
+ end; }
+ Result := '#';
+ end;
+
+ Result := Result + IntToStr(Size);
+end;
+
+function ValueDataType(Context: TRegContext): string;
+begin
+ Result := StrOfRegDataType(Context.Typ);
+end;
+
+function DataPreviewOfContext(Context: TRegContext): string;
+
+ function DWORDPreview(Value: Integer): string;
+ begin
+ if PrefWin.ShowDwordAsHex.Checked then
+ Result := IntToStr(Value) + ' = $' + IntToHex(Value, 8)
+ else
+ Result := IntToStr(Value)
+ end;
+
+ function BinaryPreview(Context: TRegContext): string;
+ var
+ z: string;
+
+ function DWORDStringOfByteA(a: TByteA; AddBinary: Boolean = False): string;
+ var
+ piece: TByteA;
+ i: Integer;
+ begin
+ Result := '';
+
+ i := 0;
+ while (i <= High(a)) and (Length(Result) < MaxPreviewLen) do begin
+ piece := Copy(a, i, 4);
+ if AddBinary then
+ Result := Result + FriendlyStr(piece) + '=';
+ SetLength(piece, 4);
+ Result := Result + IntToStr(PInteger(piece)^) + ' ';
+ Inc(i, SizeOf(Integer));
+ end;
+ end;
+
+ begin
+ with Context do begin
+ Data := Copy(Data, 0, MaxPreviewLen);
+ case PrefWin.ShowBinaryAsRG.ItemIndex of
+ 0: z := FriendlyStr(Data);
+ 1: z := DWORDStringOfByteA(Data);
+ 2: z := DWORDStringOfByteA(Data, True);
+ 3: z := BinOfByteA(Data, 8, ' ');
+ 4: z := HexOfByteA(Data, 0);
+ 5: z := HexOfByteA(Data, 1);
+ 6: z := HexOfByteA(Data, 2);
+ 7: z := HexOfByteA(Data, 4);
+ end;
+ end;
+
+ Result := Copy(z, 1, MaxPreviewLen);
+ end;
+
+ function StringPreview(Context: TRegContext): string;
+ var
+ s: string;
+ Expanded: string;
+ DoExpand: Boolean;
+ begin
+ s := PChar(Context.Data);
+ with PrefWin do
+ Result := StringQuoterBegin + FriendlyStr(s) + StringQuoterEnd;
+ if s = '' then
+ Exit;
+
+ case PrefWin.ExpandStringsRG.ItemIndex of
+ 0: DoExpand := False;
+ 1: DoExpand := (Context.Typ = rdExpandString) and (CharCount(s, '%') >= 2);
+ 2: DoExpand := True;
+ else
+ ShowMessage('Error: Unknown PrefWin.ExpandStringsRG.ItemIndex!');
+ PrefWin.ExpandStringsRG.ItemIndex := 0;
+ Exit;
+ end;
+
+ if DoExpand then begin
+ Expanded := ExpandString(s);
+ if s <> Expanded then
+ Result := Result + ' <' + Expanded + '>';
+ end;
+ end;
+
+ function IntegerPreview(Context: TRegContext): string;
+ begin
+ if Length(Context.Data) >= SizeOf(Cardinal) then begin
+ Result := DWORDPreview(PInteger(Context.Data)^);
+ end else
+ Result := BinaryPreview(Context);
+ end;
+
+ function MultiStringPreview(Context: TRegContext): string;
+ var
+ z: string;
+ SL: TStringList;
+ i: Integer;
+ begin
+ z := '';
+
+ SL := TStringList.Create;
+ try
+ RegMultiStringOfByteA(Context.Data, SL, PrefWin.UseExtendedModelCB.Checked);
+
+ for i := 0 to SL.Count-1 do
+ z := z + SL[i] + ' ';
+ finally
+ SL.Free;
+ end;
+
+ Result := Copy(FriendlyStr(z), 1, MaxPreviewLen);
+ end;
+
+begin
+ Result := '';
+
+ if csDestroying in PrefWin.ComponentState then
+ Exit;
+
+ if (Context.Data = nil) or (Length(Context.Data) > RegMaxDataSize) then
+ Exit;
+
+ if Length(Context.Data) > MaxPreviewLen then
+ SetLength(Context.Data, MaxPreviewLen);
+
+ if PrefWin.ShowAsBinaryCB.Checked then begin
+ Result := BinaryPreview(Context);
+ Exit; end;
+
+ case Context.Typ of
+ rdExpandString, rdString: Result := StringPreview(Context);
+ rdCardinal, rdCardBigEndian: Result := IntegerPreview(Context);
+ rdMultiString: Result := MultiStringPreview(Context);
+ else
+ if PrefWin.Smart4BBCB.Checked and (Length(Context.Data) = 4) then
+ Result := IntegerPreview(Context)
+ else
+ Result := BinaryPreview(Context);
+ end;
+end;
+
+function ValueDataPreview(Context: TRegContext): string;
+begin
+ Result := DataPreviewOfContext(Context);
+end;
+
+function IconOfDataType(Typ: TRegDataType): Integer;
+begin
+ if Typ in [rdNone..rdLastType] then
+ Result := iconFirstType + Ord(Typ)
+ else
+ Result := iconUnknownType;
+end;
+
+function ValueTypeIcon(Context: TRegContext): Integer;
+begin
+ Result := IconOfDataType(Context.Typ);
+end;
+
+function TValuesWin.UpdateValue(Reg: TXRegistry; Item: TListItem): Boolean;
+//Return Value: True if something has changed
+var
+ Size, Typ, Data: string;
+ Icon: Integer;
+ Context: TRegContext;
+begin
+ Result := False;
+ if not Assigned(Item) then
+ Exit;
+
+ Context := Reg.ReadContext(RealValueName(Item));
+ Data := ValueDataPreview(Context);
+ Size := ValueDataSize(Context);
+ Typ := ValueDataType(Context);
+ Icon := ValueTypeIcon(Context);
+
+ if Icon <> Item.ImageIndex then begin
+ Item.ImageIndex := Icon;
+ Result := True;
+ end;
+
+ while Item.SubItems.Count < Integer(High(TValueListColumn)) do
+ Item.SubItems.Add('');
+
+ if Size <> Item.SubItems[SubItemIndex[vlcSize]] then begin
+ Result := True;
+ Item.SubItems[SubItemIndex[vlcSize]] := Size;
+ end;
+
+ if Typ <> Item.SubItems[SubItemIndex[vlcType]] then begin
+ Result := True;
+ Item.SubItems[SubItemIndex[vlcType]] := Typ;
+ end;
+
+ if (Data <> Item.SubItems[SubItemIndex[vlcData]]) then begin
+ Result := True;
+ Item.SubItems[SubItemIndex[vlcData]] := Data;
+ if IsMainValue(Item) then
+ RegTV.Repaint;
+ end;
+end;
+
+procedure AppendNewValueInfos(Item: TListItem; Context: TRegContext);
+begin
+ Item.ImageIndex := ValueTypeIcon(Context);
+ with Item.SubItems do begin
+ Append(ValueDataSize(Context));
+ Append(ValueDataType(Context));
+ Append(ValueDataPreview(Context));
+ end;
+end;
+
+function TValuesWin.AddValue(Reg: TXRegistry; const ValueName: string;
+ AppendInfos: Boolean = True): TListItem;
+begin
+ Result := ValueList.Items.AddItem(nil, -1);
+ Result.Indent := -1;
+ SetRealValueName(Result, ValueName);
+ if AppendInfos then
+ AppendNewValueInfos(Result, Reg.ReadContext(ValueName));
+end;
+
+procedure TValuesWin.ValueListChange(Sender: TObject; Item: TListItem;
+ Change: TItemChange);
+var
+ ValueName: string;
+ Reg: TXRegistry;
+
+ function ComputeValuesCommon(Reg: TXRegistry; var DataType: TRegDataType): Boolean;
+ var
+ i: Integer;
+ ItemType: TRegDataType;
+ begin
+ Result := False;
+
+ i := 0;
+ DataType := 0;
+ while i < ValueList.Items.Count do begin
+ Item := ValueList.Items[i];
+ if not Item.Selected then begin
+ Inc(i);
+ Continue; end;
+
+ ValueName := RealValueName(Item);
+ if Reg.ValueReallyExists(ValueName) then begin
+
+ ItemType := Reg.GetDataType(ValueName);
+ if not Result then begin
+ DataType := ItemType;
+ Result := True;
+ end else if ItemType <> DataType then begin
+ Result := False;
+ DataType := 0;
+ Break; end;
+
+ with ValueNames do
+ if Item.Focused then
+ Insert(0, ValueName)
+ else
+ Add(ValueName);
+
+ end else begin
+ ShowMessage('Value has been deleted!');
+ DataType := 0;
+ Result := False;
+ Reload;
+ Break; end;
+
+ Inc(i);
+ end;
+ end;
+
+begin
+ if not Assigned(Item) or ValueList.IsEditing or not ValueList.Enabled then
+ Exit;
+
+ if Change <> ctState then
+ Exit;
+
+ if csDestroying in WorkWin.ComponentState then
+ Exit;
+
+ if (ValueList.SelCount = 0) then begin
+ ValueNames.Clear;
+ WorkWin.ReInitShowPC;
+ Exit; end;
+
+ if not Item.Focused then
+ Exit;
+
+ WorkWin.ReInitShowPC;
+
+ ValueNames.Clear;
+ Reg := TXRegistry.Create;
+ try
+ if OpenNodeOK(Reg, RegTV.Selected) then begin
+ ValuesCommon := ComputeValuesCommon(Reg, ValueCommonType);
+ if ValuesCommon then
+ WorkWin.ShowValues(Reg);
+ end;
+ finally
+ Reg.Free;
+ end;
+
+ if csDestroying in MainWin.ComponentState then
+ Exit;
+
+ if ActiveControl = ValueList then
+ MainWin.SetStatus;
+end;
+
+procedure TValuesWin.ValueListCustomDrawItem(Sender: TCustomListView;
+ Item: TListItem; State: TCustomDrawState; var DefaultDraw: Boolean);
+begin
+ with ValueList.Canvas.Font do begin
+ if Item.Focused then
+ Style := Style + [fsBold];
+ if ItemIsDefaultValue(Item) then
+ Color := clBrightYellow
+ else
+ Color := ColorOfDataType(TRegDataType(Item.ImageIndex - iconFirstType));
+ end;
+end;
+
+procedure TValuesWin.ValueListDblClick(Sender: TObject);
+begin
+ ValueListChange(Sender, ValueList.ItemFocused, ctState);
+ MainPC.ActivePage := WorkWin.WorkPage;
+
+ if not Assigned(ValueList.ItemFocused) then
+ Exit;
+
+ if csDestroying in WorkWin.ComponentState then
+ Exit;
+
+ WorkWin.EditData;
+end;
+
+procedure TValuesWin.ValueListEditing(Sender: TObject; Item: TListItem;
+ var AllowEdit: Boolean);
+begin
+ if not ValueLabelClicked then begin
+ AllowEdit := False;
+ Exit; end;
+
+ if ItemIsDefaultValue(Item) then //unschön, aber beste Lösung bisher
+ Keyboard.SimKey(VK_DELETE);
+end;
+
+procedure TValuesWin.ValueListEdited(Sender: TObject; Item: TListItem;
+ var S: string);
+var
+ Old: string;
+ OldCaption: string;
+begin
+ OldCaption := Item.Caption;
+ Old := RealValueName(Item);
+
+ if s = Old then begin
+ if ItemIsDefaultValue(Item) then
+ s := DefaultValueCaption;
+ Exit; end;
+
+ SpyThread.Suspend;
+ try
+ Item.Caption := s;
+
+ if TryRenameValue(Old, s) then begin
+ SetRealValueName(Item, s); //Sichere Zuweisung des Standard-Flags
+ s := Item.Caption; //Anschließend externer Aufruf "Item.Caption := s"!
+ end else begin
+ s := OldCaption;
+ end;
+
+ finally
+ SpyThread.Restart := True;
+ SpyThread.Resume;
+ end;
+end;
+
+procedure TValuesWin.ValueListKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+var
+ T: string;
+ Item: TListItem;
+begin
+ if ValueList.IsEditing then
+ Exit;
+
+ if csDestroying in TreeWin.ComponentState then
+ Exit;
+
+ Item := ValueList.ItemFocused;
+
+ case Key of
+ VK_SPACE: JumpToSel(ValueList);
+
+ VK_F9: SwapFonts(ValueList);
+
+ VK_F5: Reload;
+
+ VK_F12: begin //Sort
+ if Assigned(Item) then
+ T := Item.Caption;
+ ValueList.SortType := TSortType(2 - (Integer(ValueList.SortType)));
+ if ValueList.SortType = stNone then
+ TreeWin.RegTVChange(Sender, RegTV.Selected);
+ ValueList.ItemFocused := FindItem(ValueList, T);
+ if Assigned(ValueList.ItemFocused) then
+ ValueList.ItemFocused.MakeVisible(True);
+ end;
+
+ VK_DELETE: DeleteMIClick(Sender);
+
+ VK_RETURN: ValueListDblCLick(Sender);
+
+ Ord('C'):
+ if not ValueList.IsEditing then
+ CopyPathMIClick(Sender);
+
+ VK_SCROLL: CheckValueListHotTrack;
+ end;
+end;
+
+procedure TValuesWin.ValueListResize(Sender: TObject);
+begin
+ with ValueList do
+ Columns[3].Width := ClientWidth - (0 +
+ Columns[0].Width + Columns[1].Width + Columns[2].Width);
+end;
+
+procedure TValuesWin.DeleteValue;
+var
+ Item, NewSel: TListItem;
+ YesToAll: Boolean;
+ i: Integer;
+
+ procedure DeleteIt(Item: TListItem);
+ begin
+ OpenCurKey;
+ if MainReg.DeleteValue(RealValueName(Item))
+ and not MainReg.ValueReallyExists(RealValueName(Item)) then begin
+ Item.Delete;
+ end else begin
+ ShowMessage('Could not delete Value ' + Quote(RealValueName(Item)));
+ Inc(i);
+ end;
+ MainReg.CloseKey;
+
+ if IsMainValue(Item) then
+ RegTV.Repaint;
+ end;
+
+begin
+ SpyThread.Suspend;
+
+ NewSel := GetNextBestNotSelected(ValueList.ItemFocused);
+
+ YesToAll := False;
+ i := 0;
+ while i < ValueList.Items.Count do begin
+ Item := ValueList.Items[i];
+ if not Item.Selected then begin
+ Inc(i);
+ Continue; end;
+
+ if YesToAll then
+ DeleteIt(Item)
+ else begin
+ case MessageDlg('Do you really want to delete the Value ' +
+ Quote(RealValueName(Item)) + '?',
+ mtConfirmation, [mbYes, mbYesToAll, mbNo, mbCancel], 0) of
+ mrYes: DeleteIt(Item);
+ mrYesToAll: YesToAll := True;
+ mrCancel: Exit;
+ mrNo: begin
+ Item.Selected := False;
+ NewSel := Item;
+ end;
+ end;
+ end;
+ end;
+
+ if Assigned(NewSel) then begin
+ ValueList.ItemFocused := NewSel;
+ NewSel.Selected := True;
+ end else
+ WorkWin.ReInitShowPC;
+
+ SpyThread.Restart := True;
+ SpyThread.Resume;
+end;
+
+procedure TValuesWin.ZeromizeValue;
+var
+ Item: TListItem;
+ YesToAll: Boolean;
+ i: Integer;
+
+ procedure ZeromizeIt(Item: TListItem);
+ begin
+ with MainReg do begin
+ OpenCurKey;
+ ZeromizeValue(RealValueName(Item));
+ UpdateValue(MainReg, Item);
+ CloseKey;
+ end;
+ end;
+
+begin
+ SpyThread.Suspend;
+
+ YesToAll := False;
+ i := 0;
+ while i < ValueList.Items.Count do begin
+ Item := ValueList.Items[i];
+ if not Item.Selected then begin
+ Inc(i);
+ Continue; end;
+
+ if YesToAll then
+ ZeromizeIt(Item)
+ else
+ case MessageDlg('Do you really want to zeromize ValueData of ' +
+ Quote(RealValueName(Item)) + ' ?',
+ mtConfirmation, [mbYes, mbYesToAll, mbNo, mbCancel], 0) of
+
+ mrYes: begin
+ ZeromizeIt(Item);
+ Inc(i);
+ end;
+
+ mrYesToAll: begin
+ YesToAll := True;
+ ZeromizeIt(Item);
+ end;
+ mrCancel: Exit;
+ end;
+
+ if IsMainValue(Item) then
+ RegTV.Repaint;
+ end;
+
+
+ SpyThread.Resume;
+end;
+
+procedure TValuesWin.ValueListPUPopup(Sender: TObject);
+var
+ Writable, ValueOK, OnlyOneValue, OneValueOK: Boolean;
+ Item: TListItem;
+begin
+ if Assigned(ValueList.ItemFocused) then
+ ValueList.ItemFocused.Selected := True;
+
+ if csDestroying in (TreeWin.ComponentState + PrefWin.ComponentState) then
+ Exit;
+
+ Writable := not TreeWin.CantWrite;
+ NewDefaultValueMI.Visible := Writable;
+ NewStringMI.Visible := Writable;
+ NewDWORDMI.Visible := Writable;
+ NewBinaryMI.Visible := Writable;
+ NewMultiStringMI.Visible := Writable;
+ NewElseMI.Visible := Writable;
+
+ ValueOK := Writable and (ValueList.ItemFocused <> nil);
+ OnlyOneValue := ValueList.SelCount = 1;
+ OneValueOK := OnlyOneValue and ValueOK;
+
+ EditMI.Visible := ValueOK;
+ EditBinaryMI.Visible := ValueOK;
+ DublicateMI.Visible := OneValueOK;
+ CopyPathMI.Visible := OnlyOneValue;
+ CopyDataPreviewMI.Visible := OnlyOneValue;
+ TakeAsMainValueMI.Visible := OnlyOneValue;
+ RenameMI.Visible := OneValueOK;
+ DeleteMI.Visible := ValueOK;
+ ZeromizeMI.Visible := ValueOK;
+
+ Item := ValueList.ItemFocused;
+ if not Assigned(Item) then
+ Exit;
+
+ TakeAsMainValueMI.Checked := RealValueName(Item) = PrefWin.MainPreviewE.Text;
+end;
+
+procedure TValuesWin.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if ValueList.IsEditing then
+ Exit;
+
+ if csDestroying in MainWin.ComponentState then
+ Exit;
+ MainWin.FormKeyDown(Sender, Key, Shift);
+end;
+
+procedure TValuesWin.ValueListDeletion(Sender: TObject; Item: TListItem);
+begin
+ if Assigned(SpyThread) then
+ SpyThread.Restart := True;
+
+ if csDestroying in WorkWin.ComponentState then
+ Exit;
+
+ if Assigned(ShowPC.ActivePage)
+ and Item.Selected and Item.Focused then begin
+ ValueList.ItemFocused := GetNextBest(Item);
+ WorkWin.ReInitShowPC;
+ end;
+end;
+
+procedure TValuesWin.DeleteMIClick(Sender: TObject);
+begin
+ if ValueList.IsEditing then
+ Exit;
+
+ DeleteValue;
+end;
+
+procedure TValuesWin.RenameMIClick(Sender: TObject);
+begin
+ if Assigned(ValueList.ItemFocused) then begin
+ ValueLabelClicked := True;
+ ValueList.ItemFocused.EditCaption;
+ ValueLabelClicked := False;
+ end;
+end;
+
+procedure TValuesWin.NewBigEndianMIClick(Sender: TObject);
+begin
+ CreateValue(rdCardBigEndian);
+end;
+
+procedure TValuesWin.NewExpandStringMIClick(Sender: TObject);
+begin
+ CreateValue(rdExpandString);
+end;
+
+procedure TValuesWin.NewMultiStringMIClick(Sender: TObject);
+begin
+ CreateValue(rdMultiString);
+end;
+
+procedure TValuesWin.NewStrangeTypeMIClick(Sender: TObject);
+begin
+ CreateValue(TRegDataType(TMenuItem(Sender).Tag));
+end;
+
+procedure TValuesWin.NewDefaultValueMIClick(Sender: TObject);
+var
+ DefaultItem: TListItem;
+ i: Integer;
+begin
+ if csDestroying in (TreeWin.ComponentState + MainWin.ComponentState) then
+ Exit;
+ if TreeWin.CantWrite then
+ Exit;
+
+ with MainReg do begin
+ try
+ OpenCurKey;
+
+ if StandardValueExists then begin
+ ShowMessage('Default Value already exists.');
+ CloseKey;
+ Exit; end;
+
+ WriteString('', '');
+
+ if not StandardValueExists then begin
+ ShowMessage('Could not create Default Value.');
+ CloseKey;
+ Exit; end;
+
+ ValuesWin.AddValue(MainReg, '');
+ finally
+ CloseKey;
+ end;
+ end;
+
+ with ValueList.Items do begin
+ DefaultItem := nil;
+ for i := 0 to Count-1 do
+ if ItemIsDefaultValue(Item[i]) then
+ Break;
+
+ if i < Count then
+ DefaultItem := Item[i];
+ end;
+
+ if not Assigned(DefaultItem) then
+ ShowMessage('Error: Lost Default Value!')
+ else begin
+ SelectItemOnly(ValueList, DefaultItem);
+ MainWin.StatusBarUpdate;
+ ValueListDblClick(Sender);
+ end;
+end;
+
+procedure TValuesWin.ValueListChanging(Sender: TObject; Item: TListItem;
+ Change: TItemChange; var AllowChange: Boolean);
+begin
+ if Item = nil then
+ AllowChange := False;
+end;
+
+procedure TValuesWin.ValueListMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ ValueLabelClicked := False;
+ with ValueList do
+ if ([htOnIcon, htOnLabel] * GetHitTestInfoAt(X, Y)) <> [] then
+ ValueLabelClicked := True;
+end;
+
+procedure TValuesWin.EditBinaryMIClick(Sender: TObject);
+begin
+ if csDestroying in WorkWin.ComponentState then
+ Exit;
+
+ WorkWin.ShowAsBinary := True;
+ ValueListChange(Sender, ValueList.ItemFocused, ctState);
+ ValueListDblClick(Sender);
+end;
+
+procedure TValuesWin.EditMIClick(Sender: TObject);
+begin
+ ValueListDblClick(Sender);
+end;
+
+procedure TValuesWin.ValueListCustomDrawSubItem(Sender: TCustomListView;
+ Item: TListItem; SubItem: Integer; State: TCustomDrawState;
+ var DefaultDraw: Boolean);
+begin
+ with ValueList.Canvas.Font do begin
+ Style := [];
+ if SubItem = 1 then
+ Color := clSilver
+ else
+ Color := ColorOfDataType(TRegDataType(Item.ImageIndex - iconFirstType));
+ end;
+end;
+
+procedure TValuesWin.ValueListCompare(Sender: TObject; Item1, Item2: TListItem;
+ Data: Integer; var Compare: Integer);
+begin
+ case SortBy of
+ vlcName: Compare := AnsiCompareText(RealValueName(Item1), RealValueName(Item2));
+ vlcSize: Compare := Integer(
+ StrToIntDef(Item1.SubItems[SubItemIndex[vlcSize]], -1) >
+ StrToIntDef(Item2.SubItems[SubItemIndex[vlcSize]], -1));
+ vlcData: Compare := Integer(Item1.SubItems[SubItemIndex[vlcData]] >
+ Item2.SubItems[SubItemIndex[vlcData]]);
+ vlcType: Compare := Integer(Item1.ImageIndex > Item2.ImageIndex);
+ end;
+
+ if Assigned(SortByColumn)
+ and (SortByColumn.ImageIndex = iconSortArrowDesc) then
+ Compare := 1 - Compare;
+end;
+
+procedure TValuesWin.ValueListColumnClick(Sender: TObject; Column: TListColumn);
+begin
+ case Column.ImageIndex of
+ iconSortArrowAsc: Column.ImageIndex := iconSortArrowDesc;
+ iconSortArrowDesc: Column.ImageIndex := -1;
+ else
+ if Assigned(SortByColumn) then
+ SortByColumn.ImageIndex := -1;
+ if TValueListColumn(Column.Tag) in ValueListColumnRange then
+ SortBy := TValueListColumn(Column.Tag)
+ else
+ ShowMessage('Unknown Column Tag');
+ Column.ImageIndex := iconSortArrowAsc;
+ end;
+
+ if Column.ImageIndex = -1 then
+ ValueList.SortType := stNone
+ else begin
+ ValueList.SortType := stData;
+ SortByColumn := Column;
+ end;
+
+ Update;
+ ValueList.AlphaSort;
+end;
+
+procedure TValuesWin.CloneValue;
+var
+ OldName, NewName: string;
+
+ function GetNewName(Reg: TXRegistry; const OldName: string): string;
+ var
+ i: Integer;
+ Prefix: string;
+ begin
+ if OldName = '' then
+ Result := 'New Default Value'
+ else if Copy(OldName, 1, 4) <> 'New ' then
+ Result := 'New ' + OldName
+ else
+ Result := OldName;
+
+ Prefix := Result;
+ i := 1;
+ while Reg.ValueExists(Result) do begin
+ Result := Prefix + ' ' + IntToStr(i);
+ Inc(i);
+ end;
+ end;
+
+begin
+ if csDestroying in TreeWin.ComponentState then
+ Exit;
+
+ if TreeWin.CantWrite then
+ Exit;
+
+ OldName := RealValueName(ValueList.ItemFocused);
+
+ try
+ OpenCurKey;
+
+ NewName := GetNewName(MainReg, OldName);
+ MainReg.CopyValue(OldName, NewName);
+ AddValue(MainReg, NewName);
+ finally
+ MainReg.CloseKey;
+ end;
+end;
+
+procedure TValuesWin.DublicateMIClick(Sender: TObject);
+begin
+ CloneValue;
+end;
+
+procedure TValuesWin.CopyDataPreviewMIClick(Sender: TObject);
+begin
+ if ValueList.IsEditing then
+ Exit;
+
+ CopyDataPreview;
+end;
+
+procedure TValuesWin.CopyDataPreview;
+begin
+ OpenCurKey;
+ Clipboard.AsText := DataPreviewOfContext(MainReg.ReadContext(
+ RealValueName(ValueList.ItemFocused)));
+ MainReg.CloseKey;
+end;
+
+procedure TValuesWin.UpdateValues(SelectedOnly: Boolean = False);
+var
+ i: Integer;
+ Reg: TXRegistry;
+begin
+ if not Started then
+ Exit;
+
+ SpyThread.Suspend;
+
+ Reg := TXRegistry.Create;
+ try
+ if OpenNodeOK(Reg, RegTV.Selected) then
+ with ValueList.Items do begin
+ for i := 0 to Count-1 do begin
+ if SelectedOnly and not Item[i].Selected then
+ Continue;
+ UpdateValue(Reg, Item[i]);
+ end;
+ end;
+ finally
+ Reg.Free;
+ end;
+
+ SpyThread.Resume;
+end;
+
+function TValuesWin.TryRenameValue(OldName: string;
+ var NewName: string): Boolean;
+var
+ x: string;
+begin
+ Result := False;
+ if OldName = NewName then
+ Exit;
+
+ if (Length(NewName) > RegMaxValueNameLen) then begin
+ NewName := Copy(NewName, 1, RegMaxValueNameLen);
+ if MessageDlg(
+ 'The maximum size of a value name is ' + IntToStr(RegMaxValueNameLen) + ' characters.' + EOL +
+ 'Shorten the value name to:' + EOL +
+ Quote(StringWrap(NewName, 80)),
+ mtConfirmation, [mbOK, mbCancel], 0) <> mrOK then
+ Exit;
+ end;
+
+ if CharIn(NewName, [#0..#31]) then begin
+ NewName := ReplaceChars(NewName, [#0..#31], '#');
+ if MessageDlg('The following chars are not allowed in ValueNames:' + EOL +
+ '- Control chars (#0..#31)' + EOL +
+ 'The following name is allowed:' + EOL +
+ NewName + EOL +
+ 'Use this name instead?',
+ mtConfirmation, [mbYes, mbNo], 0) <> mrYes then
+ Exit;
+ end;
+
+ if not OpenCurKey then
+ Exit;
+
+ if SameText(OldName, NewName) then begin //CharCase ändern
+ x := MainReg.GetFreeValueName;
+ MainReg.RenameValue(OldName, x);
+ MainReg.RenameValue(x, NewName);
+ end else begin
+ if not MainReg.ValueReallyExists(NewName) then begin
+ MainReg.RenameValue(OldName, NewName);
+ end else begin
+ if NewName = '' then
+ ShowMessage('Default value already exists.')
+ else
+ ShowMessage('Value ' + Quote(NewName) + ' already exists.');
+ Exit; end;
+ end;
+ MainReg.CloseKey;
+
+ if TextIn(NewName, 'default') then
+ AddHint('You can create default values by empty string ValueNames.');
+
+ Result := True;
+end;
+
+procedure TValuesWin.ZeromizeMIClick(Sender: TObject);
+begin
+ ZeromizeValue;
+end;
+
+procedure TValuesWin.CopyPathMIClick(Sender: TObject);
+begin
+ if ValueList.IsEditing then
+ Exit;
+
+ if csDestroying in MainWin.ComponentState then
+ Exit;
+
+ MainWin.CopyPathClick(Sender);
+end;
+
+function TValuesWin.FindItemByRealName(const ValueName: string): Integer;
+begin
+ with ValueList.Items do begin
+ for Result := 0 to Count-1 do
+ if SameText(RealValueName(Item[Result]), ValueName) then
+ Exit;
+ end;
+ Result := -1;
+end;
+
+function TValuesWin.FocusItem(ARealValueName: string;
+ FocusValueList: Boolean = False): Boolean;
+var
+ i: Integer;
+begin
+ with ValueList do begin
+ i := FindItemByRealName(ARealValueName);
+
+ if (i > -1) and (i < Items.Count) then
+ Selected := Items[i]
+ else
+ Selected := nil;
+
+ ItemFocused := Selected;
+
+ Result := Assigned(Selected);
+ if Result then
+ JumpToSel(ValueList);
+
+ if FocusValueList then
+ FocusControl(ValueList);
+ end;
+end;
+
+procedure TValuesWin.TakeAsMainValueMIClick(Sender: TObject);
+var
+ Item: TListItem;
+ ValueName: string;
+begin
+ if csDestroying in PrefWin.ComponentState then
+ Exit;
+
+ Item := ValueList.ItemFocused;
+ if not Assigned(Item) then
+ Exit;
+
+ ValueName := RealValueName(Item);
+ with PrefWin.MainPreviewE do
+ if ValueName = Text then
+ Text := ''
+ else
+ Text := ValueName;
+end;
+
+procedure TValuesWin.InitListColumnTags;
+var
+ i: Integer;
+begin
+ for i := 0 to ValueList.Columns.Count-1 do
+ with ValueList.Columns.Items[i] do begin
+ Tag := -1;
+ if Caption = 'Name' then
+ Tag := Integer(vlcName)
+ else if Caption = 'Size' then
+ Tag := Integer(vlcSize)
+ else if Caption = 'Type' then
+ Tag := Integer(vlcType)
+ else if Caption = 'Data' then
+ Tag := Integer(vlcData)
+ else
+ ShowMessage(Format('Error: Unknown ValueList.Columns[%d].Caption = "%s"',
+ [Index, Caption]));
+ if Tag > -1 then
+ SubItemIndex[TValueListColumn(Tag)] := Index - 1;
+ end;
+end;
+
+procedure TValuesWin.FormShow(Sender: TObject);
+begin
+ InitListColumnTags;
+end;
+
+procedure TValuesWin.Reload(JumpToNewValue: Boolean = False;
+ ValueName: string = '');
+var
+ Sel: TListItem;
+ SelIndex: Integer;
+ SelRealValueName: string;
+begin
+ if csDestroying in TreeWin.ComponentState then
+ Exit;
+
+ SelIndex := -1;
+ if JumpToNewValue then
+ SelRealValueName := ValueName
+ else begin
+ Sel := ValueList.ItemFocused;
+ if Assigned(Sel) then
+ SelIndex := Sel.Index;
+
+ if SelIndex > -1 then
+ SelRealValueName := RealValueName(ValueList.Items[SelIndex]);
+ end;
+
+ TreeWin.RegTVChange(Self, RegTV.Selected);
+
+ if SelIndex > -1 then
+ if not FocusItem(SelRealValueName, True) then begin
+ SelIndex := GetBestIndex(ValueList, SelIndex);
+ if SelIndex > -1 then
+ with ValueList do begin
+ Selected := Items[SelIndex];
+ ItemFocused := Selected;
+ end;
+ end;
+end;
+
+procedure TValuesWin.LoadValues(Reg: TXRegistry);
+var
+ SL: TStringList;
+ i: Integer;
+ Clock: TClock;
+begin
+ if csDestroying in WorkWin.ComponentState then
+ Exit;
+
+ with ValueList.Items do begin
+ Clock := TClock.Create(1, tfSecs);
+ ValueList.Enabled := False;
+ BeginUpdate;
+ try
+ Clear;
+ WorkWin.ReInitShowPC;
+
+ SL := TStringList.Create;
+ try
+ Reg.GetValueNames(SL);
+ for i := 0 to SL.Count-1 do
+ ValuesWin.AddValue(Reg, SL[i]);
+ finally
+ SL.Free;
+ end;
+
+ finally
+ EndUpdate;
+ ValueList.Enabled := True;
+ Clock.Stop;
+ if MurphyMode then
+ AddHint(Format('Values loaded after %0.2f secs.', [Clock.SecsPassed]));
+ Clock.Free;
+ end;
+ end;
+end;
+
+procedure TValuesWin.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+// Action := caNone;
+end;
+
+procedure TValuesWin.ValueListClick(Sender: TObject);
+begin
+ CheckValueListHotTrack;
+ if ValueList.HotTrack then
+ ValueListDblClick(Sender);
+end;
+
+procedure TValuesWin.CheckValueListHotTrack;
+const
+ StyleOfSwitch: array[Boolean] of TListHotTrackStyles = (
+ [], [htHandPoint, htUnderlineHot] );
+var
+ NewHotTrack: Boolean;
+begin
+ if csDestroying in PrefWin.ComponentState then
+ Exit;
+
+ NewHotTrack := ScrollON xor PrefWin.ValuesSingleClickCB.Checked;
+ if NewHotTrack = ValueList.HotTrack then Exit;
+
+ with ValueList do begin
+ HotTrack := NewHotTrack;
+ HotTrackStyles := StyleOfSwitch[HotTrack];
+ Mouse.CursorPos := Mouse.CursorPos;
+ end;
+end;
+
+procedure TValuesWin.SelectAllMIClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ with ValueList.Items do
+ for i := 0 to Count-1 do
+ Item[i].Selected := True;
+end;
+
+procedure TValuesWin.InvertSelectionMIClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ with ValueList.Items do
+ for i := 0 to Count-1 do
+ Item[i].Selected := not Item[i].Selected;
+end;
+
+procedure TValuesWin.FormDestroy(Sender: TObject);
+begin
+ ValueNames.Free;
+end;
+
+end.
+unit WorkU;
+
+interface
+
+uses
+ Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
+ Dialogs, StdCtrls, ComCtrls, NewPanels, Grids, Clipbrd,
+ IntEdit, ExtCtrls, Menus, YTools, CompEx, PlutoConst,
+ XReg, Clock, Colors, ShellAPI, IniFiles, Math,
+ keybrd, Buttons, YTypes, LinkLabel, start,
+ PrefTools, ImgList, PHexMemo, PipelineTh, DropSource, DropTarget,
+ CrackTools;
+
+type
+ TColorStringFmt = (csfThreeSpacedDecimals);
+
+ TWorkWin = class(TForm)
+ StringPU: TPopupMenu;
+ SpaceMI: TMenuItem;
+ FileMI: TMenuItem;
+ FileOpenD: TOpenDialog;
+ MainPC: TPageControl;
+ HintPage: TTabSheet;
+ Splitter1: TSplitter;
+ HintLB: TListBox;
+ InfoMemo: TMemo;
+ WorkPage: TTabSheet;
+ WorkP: TPanel;
+ ShowPC: TPageControl;
+ StringPage: TTabSheet;
+ BorderPanel1: TBorderPanel;
+ StringE: TEdit;
+ OKStringB: TButton;
+ BoolStrCB: TCheckBox;
+ CancelStringB: TButton;
+ StringAsColorP: TPanel;
+ StringAsFileP: TBorderPanel;
+ IconImage: TImage;
+ IntPage: TTabSheet;
+ BorderPanel5: TBorderPanel;
+ OKIntB: TButton;
+ CardBoolCB: TCheckBox;
+ CancelIntB: TButton;
+ BinaryPage: TTabSheet;
+ BorderPanel6: TBorderPanel;
+ Panel2: TPanel;
+ Label5: TLabel;
+ OffsetHE: THexEdit;
+ OKBinaryB: TButton;
+ CancelBinaryB: TButton;
+ StringTypeRG: TRadioGroup;
+ SpyPage: TTabSheet;
+ BorderPanel2: TBorderPanel;
+ SpyResumeB: TButton;
+ SpySuspendB: TButton;
+ SpyLB: TListBox;
+ Label4: TLabel;
+ Label7: TLabel;
+ CardTypeRG: TRadioGroup;
+ MultiStringPage: TTabSheet;
+ BorderPanel7: TBorderPanel;
+ OKMultiStringB: TButton;
+ CancelMultiStringB: TButton;
+ MultiStringM: TMemo;
+ DataTypeComB: TComboBox;
+ CardinalE: TCardEdit;
+ ColorDlg: TColorDialog;
+ MultiStringOpenD: TOpenDialog;
+ MultiStringSaveD: TSaveDialog;
+ MultiStringPU: TPopupMenu;
+ LadenMI: TMenuItem;
+ SpeichernMI: TMenuItem;
+ Hinzufgen1: TMenuItem;
+ N1: TMenuItem;
+ SisyPage: TTabSheet;
+ SpyClearTracesB: TButton;
+ Label11: TLabel;
+ HexEdit1: THexEdit;
+ Label12: TLabel;
+ Label13: TLabel;
+ SortMultiStringMI: TMenuItem;
+ SpyTestL: TLabel;
+ Panel3: TPanel;
+ CurValueE: TEdit;
+ BorderPanel8: TBorderPanel;
+ BorderPanel9: TBorderPanel;
+ SisyTV: TTreeView;
+ TabImages: TImageList;
+ ChangeImages: TImageList;
+ Panel7: TPanel;
+ ColorPanel1: TColorPanel;
+ Splitter2: TSplitter;
+ SpyDelayIE: TPrefIntEdit;
+ ListTracesCB: TPrefCheckBox;
+ Panel5: TPanel;
+ Panel8: TPanel;
+ SisyExpandGroupsCB: TPrefCheckBox;
+ ClearChangesB: TButton;
+ FilterChangesB: TButton;
+ SisyTVPU: TPopupMenu;
+ SisyGotoKeyMI: TMenuItem;
+ SisyDeleteChangeMI: TMenuItem;
+ SisyActivateChangeMI: TMenuItem;
+ N3: TMenuItem;
+ SisyCopyPathMI: TMenuItem;
+ N4: TMenuItem;
+ Panel9: TPanel;
+ ExternalEditB: TButton;
+ LoadExternalB: TButton;
+ ReloadStringB: TButton;
+ BinaryHM: TPHexMemo;
+ PipelineCB: TCheckBox;
+ ReloadDWordB: TButton;
+ ReloadBinaryB: TButton;
+ ReloadMultiStringB: TButton;
+ DescL: TLabel;
+ SisyHKUCB: TPrefCheckBox;
+ SisyHKLMCB: TPrefCheckBox;
+ SisyHKUL: TLabel;
+ SisyHKLML: TLabel;
+ SisyListCB: TPrefCheckBox;
+ CardSpecial0B: TButton;
+ CardSpecial1B: TButton;
+ CardSpecial_1B: TButton;
+ CardSpecial7FB: TButton;
+ SisyPU: TPopupMenu;
+ Idle1: TMenuItem;
+ Lowest1: TMenuItem;
+ Lower1: TMenuItem;
+ Normal1: TMenuItem;
+ Higher1: TMenuItem;
+ Highes1: TMenuItem;
+ SisyShowCurrentPathMI: TMenuItem;
+ N5: TMenuItem;
+ MultiStringTypeRG: TRadioGroup;
+ SeparatorE: TEdit;
+ Label1: TLabel;
+ MultiStringCountL: TLabel;
+ DropFileTarget: TDropFileTarget;
+ CryptoPage: TTabSheet;
+ BorderPanel3: TBorderPanel;
+ CryptoE: TEdit;
+ OKCryptoB: TButton;
+ CancelCryptoB: TButton;
+ ReloadCryptoB: TButton;
+ CryptoTypeRG: TRadioGroup;
+ Label2: TLabel;
+ LinkLabel2: TLinkLabel;
+ procedure FormKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure SpyResumeBClick(Sender: TObject);
+ procedure SpySuspendBClick(Sender: TObject);
+ procedure ArrPlutoBClick(Sender: TObject);
+ procedure ArrRegEdBClick(Sender: TObject);
+ procedure ArrFreeBClick(Sender: TObject);
+ procedure ArrBigValBClick(Sender: TObject);
+
+ procedure SpaceMIClick(Sender: TObject);
+ procedure FileMIClick(Sender: TObject);
+ procedure HintLBClick(Sender: TObject);
+ procedure MainPCDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
+ procedure ValueMIClick(Sender: TObject);
+ procedure StringEKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure StringEChange(Sender: TObject);
+ procedure OKStringBClick(Sender: TObject);
+ procedure BoolStrCBClick(Sender: TObject);
+ procedure CardinalEChange(Sender: TObject);
+ procedure CardBoolCBClick(Sender: TObject);
+ procedure CardinalEKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure OKIntBClick(Sender: TObject);
+ procedure ShowPCChange(Sender: TObject);
+ procedure ShowPCChanging(Sender: TObject; var AllowChange: Boolean);
+ procedure ShowPCDrawTab(Control: TCustomTabControl; TabIndex: Integer; const Rect: TRect; Active: Boolean);
+ procedure ShowPCMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ procedure FormCreate(Sender: TObject);
+ procedure OKBinaryBClick(Sender: TObject);
+ procedure HexGrid1Click(Sender: TObject);
+ procedure HexGrid1KeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure BoolStrPopup(Sender: TObject);
+ procedure StringPageEnter(Sender: TObject);
+ procedure IntPageEnter(Sender: TObject);
+ procedure BinaryPageEnter(Sender: TObject);
+ procedure ReInitShowPC;
+ procedure ActivateIt(Sender: TObject);
+ procedure DeActivateIt(Sender: TObject);
+ procedure FormDeactivate(Sender: TObject);
+ procedure FormActivate(Sender: TObject);
+ procedure MultiStringMChange(Sender: TObject);
+ procedure OKMultiStringBClick(Sender: TObject);
+ procedure StringAsColorPDblClick(Sender: TObject);
+ procedure MultiStringMEnter(Sender: TObject);
+ procedure LadenMIClick(Sender: TObject);
+ procedure SpeichernMIClick(Sender: TObject);
+ procedure Hinzufgen1Click(Sender: TObject);
+ procedure CancelBClick(Sender: TObject);
+ procedure HexGrid1Enter(Sender: TObject);
+ procedure SpyClearTracesBClick(Sender: TObject);
+ procedure SpyLBKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ //procedure BinLMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
+ procedure BinLClick(Sender: TObject);
+ procedure HexGrid1KeyUp(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure ValueViewChanged(Sender: TObject);
+ procedure HexEdit1Change(Sender: TObject);
+ procedure SortMultiStringMIClick(Sender: TObject);
+ procedure SpyTestLClick(Sender: TObject);
+ procedure FocusForEditing;
+ procedure CurValueEKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure CurValueEEnter(Sender: TObject);
+
+ procedure AddAHint(const Hint: string);
+ procedure SisyTVGetSelectedIndex(Sender: TObject; Node: TTreeNode);
+ procedure SisyTVDblClick(Sender: TObject);
+ procedure SisyTVKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure SisyCBClick(Sender: TObject);
+ procedure BinaryHMLineChange(NewLine: Cardinal);
+ procedure OffsetHEChange(Sender: TObject);
+ procedure SpyDelayIEChange(Sender: TObject);
+ procedure SisyTVExpanded(Sender: TObject; Node: TTreeNode);
+ procedure ClearChangesBClick(Sender: TObject);
+ procedure FilterChangesBClick(Sender: TObject);
+ procedure SisyTVPUPopup(Sender: TObject);
+ procedure SisyActivateChangeMIClick(Sender: TObject);
+ procedure SisyDeleteChangeMIClick(Sender: TObject);
+ procedure SisyCopyPathMIClick(Sender: TObject);
+ procedure ExternalEditBClick(Sender: TObject);
+ procedure LoadExternalBClick(Sender: TObject);
+ procedure ReloadBClick(Sender: TObject);
+ procedure PipelineCBClick(Sender: TObject);
+ procedure BinaryHMEnter(Sender: TObject);
+ procedure xUseExtendedModelCBClick(Sender: TObject);
+ procedure SeparatorEChange(Sender: TObject);
+ procedure HintLBKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
+ procedure DWORDSpecialBClick(Sender: TObject);
+ procedure Button1Click(Sender: TObject);
+ procedure SisyPUPopup(Sender: TObject);
+ procedure SisyPriorityMIClick(Sender: TObject);
+ procedure SisyShowCurrentPathMIClick(Sender: TObject);
+ procedure DropFileTargetDrop(Sender: TObject; ShiftState: TShiftState;
+ Point: TPoint; var Effect: Integer);
+ procedure FormClose(Sender: TObject; var Action: TCloseAction);
+ procedure FormResize(Sender: TObject);
+ procedure IconImageDblClick(Sender: TObject);
+ procedure SisyTVCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+ procedure SisyTVMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+ procedure OKCryptoBClick(Sender: TObject);
+ procedure CryptoEKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+ private
+ PipelineThread: TPipelineThread;
+ BoolStr: array of array[Boolean] of string;
+ HexEditAutoChange: Boolean;
+ TargetPage: TTabSheet;
+ procedure DeleteChange(Node: TTreeNode);
+ procedure DeactivateChange(Node: TTreeNode);
+ procedure CopySelectedChangeName;
+ procedure ClearChanges;
+ public
+ ShowAsBinary: Boolean;
+ function LastHint: string;
+ function LoadBoolStr: Boolean;
+ function LoadSisyFilter: Boolean;
+ procedure ShowValues(Reg: TXRegistry);
+ procedure UpdateWriteButtons;
+ procedure EditData;
+ end;
+
+var
+ WorkWin: TWorkWin;
+ ShowPC: TPageControl;
+ MainPC: TPageControl;
+
+implementation
+
+uses TreeU, ValuesU, plutomain, splash, SisyphusTH, PrefU, ShellEx;
+
+{$R *.dfm}
+
+function ColorOfString(s: string; Format: TColorStringFmt;
+ Default: TColor = clBlack): TColor;
+var
+ SA: TStrA;
+ i: Integer;
+begin
+ Result := Default;
+ SA := nil;
+
+ case Format of
+ csfThreeSpacedDecimals: begin
+ SA := Split(s, ' ');
+ if Length(SA) <> 3 then
+ Exit;
+ for i := 0 to 2 do
+ if not (IsValidInteger(SA[i]) and (StrToIntDef(SA[i], -1) in [0..255])) then
+ Exit;
+ Result := ColorOfRGB(StrToIntDef(SA[0], 0),
+ StrToIntDef(SA[1], 0),
+ StrToIntDef(SA[2], 0));
+ end;
+ end;
+end;
+
+function StringOfColor(Color: TColor; Format: TColorStringFmt): string;
+var
+ RGB: TRGB;
+begin
+ Result := '';
+
+ RGB := RGBOfColor(Color);
+ case Format of
+ csfThreeSpacedDecimals: begin
+ with RGB do
+ Result := IntToStr(R) + ' ' + IntToStr(G) + ' ' + IntToStr(B);
+ end;
+ end;
+end;
+
+function TWorkWin.LastHint: string;
+begin
+ with HintLB.Items do
+ if Count > 0 then
+ Result := Strings[Count-1]
+ else
+ Result := '';
+end;
+
+procedure TWorkWin.AddAHint(const Hint: string);
+begin
+ if not Assigned(HintLB) then
+ Exit;
+
+ with HintLB.Items do begin
+ if Count > 0 then begin
+ if StrAtBegin(LastHint, Hint) then begin //same hint again
+ with HintLB do
+ Tag := Tag + 1;
+ Strings[Count-1] := Format('%s (%d)', [Hint, HintLB.Tag]);
+ Exit end else
+ HintLB.Tag := 1;
+ end;
+ Add(Hint);
+ end;
+ Application.ProcessMessages; //draw
+// Sleep(1000); //wait to read hints
+end;
+
+procedure TWorkWin.ReInitShowPC;
+begin
+ with CurValueE do begin
+ Text := NoValueCaption;
+ Font.Color := clSilver;
+ Enabled := False;
+ end;
+
+ ShowPC.ActivePage := nil;
+
+ StringE.Text := '';
+ StringTypeRG.ItemIndex := 0;
+
+ MultiStringTypeRG.Buttons[1].Enabled := False;
+
+ CardinalE.Value := 0;
+ CardTypeRG.ItemIndex := 0;
+
+ BinaryHM.Data := nil;
+ PipelineCB.Checked := False;
+
+ DataTypeComB.ItemIndex := Integer(rdBinary);
+
+ MultiStringM.Clear;
+end;
+
+procedure TWorkWin.FormKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ MainWin.FormKeyDown(Sender, Key, Shift);
+end;
+
+procedure TWorkWin.SpyResumeBClick(Sender: TObject);
+begin
+ SpyThread.Resume;
+ SpyTestLClick(Sender);
+end;
+
+procedure TWorkWin.SpySuspendBClick(Sender: TObject);
+begin
+ SpyThread.Suspend;
+ SpyTestLClick(Sender);
+end;
+
+procedure TWorkWin.ArrPlutoBClick(Sender: TObject);
+begin
+ ArrangePlutoStyle;
+end;
+
+procedure TWorkWin.ArrRegEdBClick(Sender: TObject);
+begin
+ ArrangeRegEdStyle;
+end;
+
+procedure TWorkWin.ArrFreeBClick(Sender: TObject);
+begin
+ ArrangeFreeStyle;
+end;
+
+procedure TWorkWin.ArrBigValBClick(Sender: TObject);
+begin
+ ArrangeBigValStyle;
+end;
+
+procedure TWorkWin.SpaceMIClick(Sender: TObject);
+begin
+ StringE.Text := '';
+end;
+
+procedure TWorkWin.HintLBClick(Sender: TObject);
+begin
+ StatusBar.Panels[0].Text := GetSel(HintLB);
+ WorkWin.InfoMemo.Text := StatusBar.Panels[0].Text;
+end;
+
+procedure TWorkWin.MainPCDrawTab(Control: TCustomTabControl; TabIndex: Integer;
+ const Rect: TRect; Active: Boolean);
+var
+ PC: TPageControl;
+ Page: TTabSheet;
+begin
+ PC := TPageControl(Control);
+ Page := PC.Pages[TabIndex];
+ with PC.Canvas.Font do begin
+ if Page.Caption = 'Hint' then
+ Color := clBrightRed
+ else if Page.Caption = 'Edit' then
+ Color := clBrightGreen
+ else if Page.Caption = 'Spy' then
+ Color := clBrightBlue
+ else if Page.Caption = 'Sisyphus' then
+ Color := clBrightCyan
+ else
+ Color := clWhite;
+ end;
+
+ with PC.Canvas do
+ if Active then begin
+ Font.Style := [fsBold];
+ Brush.Color := clDarkGray;
+ FillRect(Rect);
+ TextOut(Rect.Left + 18 + 5, Rect.Top + 3, Page.Caption);
+ PC.Images.Draw(PC.Canvas, Rect.Left + 4, Rect.Top + 2, Page.ImageIndex);
+ end else begin
+ Font.Style := [];
+ Brush.Color := clDarkGray;
+ FillRect(Rect);
+ TextOut(Rect.Left + 18 + 3, Rect.Top + 2, Page.Caption);
+ PC.Images.Draw(PC.Canvas, Rect.Left + 1, Rect.Top + 1, Page.ImageIndex);
+ end;
+end;
+
+procedure TWorkWin.ValueMIClick(Sender: TObject);
+begin
+ StringE.Text := UntilStr(TMenuItem(Sender).Caption,' = ');
+ OKStringBClick(Sender);
+end;
+
+procedure TWorkWin.StringEKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if key = VK_RETURN then begin
+ OKStringBClick(Sender);
+ ValuesWin.FocusControl(ValueList);
+ end;
+ if key = VK_ESCAPE then
+ CancelBClick(Sender);
+end;
+
+procedure TWorkWin.StringEChange(Sender: TObject);
+var
+ i: Integer;
+ State: TCheckBoxState;
+ Desc: string;
+begin
+ IconImage.Picture := nil;
+
+ with StringAsColorP do begin
+ Color := ColorOfString(StringE.Text, csfThreeSpacedDecimals, -1);
+ Visible := Color <> -1;
+ end;
+
+ try
+ with IconImage.Picture.Icon do begin
+ ReleaseHandle;
+ Handle := GetIconFromFile(StringE.Text);
+ StringAsFileP.Visible := Handle <> 0;
+ end;
+ except
+ end;
+
+ State := cbGrayed;
+ for i := 0 to High(BoolStr) do begin
+ if StringE.Text = BoolStr[i][False] then
+ State := cbUnchecked
+ else if StringE.Text = BoolStr[i][True] then
+ State := cbChecked
+ else
+ Continue;
+ Break;
+ end;
+
+ BoolStrCB.Visible := State in [cbChecked, cbUnchecked];
+ BoolStrCB.State := State;
+
+ Desc := StringE.Text;
+ Desc := RegNameOfCLSID(Desc);
+ with DescL do begin
+ Visible := (Desc <> '');
+ if Visible then
+ Caption := 'CLSID is: ' + Desc;
+ end;
+end;
+
+procedure TWorkWin.OKStringBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ try
+ OpenCurKey;
+ with ValuesWin.ValueNames do
+ for i := 0 to Count-1 do begin
+ case StringTypeRG.ItemIndex of
+ 0: MainReg.WriteString(Strings[i], StringE.Text);
+ 1: MainReg.WriteExpandString(Strings[i], StringE.Text);
+ end;
+ end;
+ ValuesWin.UpdateValues(True);
+ finally
+ MainReg.CloseKey;
+ end;
+ ValuesWin.ValueListDblClick(Sender);
+end;
+
+procedure TWorkWin.BoolStrCBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ for i := 0 to High(BoolStr) do begin
+ if (BoolStr[i, False] = StringE.Text)
+ or (BoolStr[i, True] = StringE.Text) then
+ Break;
+ end;
+
+ if i > High(BoolStr) then
+ Exit;
+
+ StringE.Text := BoolStr[i][BoolStrCB.Checked];
+end;
+
+procedure TWorkWin.CardinalEChange(Sender: TObject);
+begin
+ HexEditAutoChange := True;
+ with CardBoolCB do begin
+ Enabled := True;
+ case CardinalE.Value of
+ 1: Checked := True;
+ 0: Checked := False;
+ else
+ Enabled := False;
+ end;
+ end;
+ HexEdit1.Value := CardinalE.Value;
+ HexEditAutoChange := False;
+end;
+
+procedure TWorkWin.CardBoolCBClick(Sender: TObject);
+begin
+ if HexEditAutoChange then
+ Exit;
+ CardinalE.Value := Ord(CardBoolCB.Checked);
+end;
+
+procedure TWorkWin.CardinalEKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if key = VK_RETURN then begin
+ OKIntBClick(Sender);
+ ValuesWin.FocusControl(ValueList);
+ end;
+
+ if key = VK_ESCAPE then
+ CancelBClick(Sender);
+end;
+
+procedure TWorkWin.OKIntBClick(Sender: TObject);
+var
+ i: Integer;
+
+ procedure Write4BB(const ValueName: string; Value: Cardinal);
+ var
+ Typ: TRegDataType;
+ begin
+ if MainReg.ValueReallyExists(ValueName) then
+ Typ := MainReg.GetDataType(ValueName)
+ else
+ Typ := rdBinary;
+
+ if Typ in rdCardTypes then
+ Typ := rdBinary;
+
+ MainReg.WriteBinType(ValueName, ByteAOfInt(CardinalE.Value), Typ);
+ end;
+
+begin
+ try
+ OpenCurKey;
+ with ValuesWin.ValueNames do
+ for i := 0 to Count-1 do begin
+ case CardTypeRG.ItemIndex of
+ 0: MainReg.WriteCardinal(Strings[i], CardinalE.Value);
+ 1: MainReg.WriteCardinal(Strings[i], CardinalE.Value, True);
+ 2: Write4BB(Strings[i], CardinalE.Value);
+ end;
+ end;
+ ValuesWin.UpdateValues(True);
+ finally
+ MainReg.CloseKey;
+ end;
+end;
+
+procedure TWorkWin.ShowPCChange(Sender: TObject);
+begin
+ FocusControl(TObject(ShowPC.ActivePage.Tag) as TWinControl);
+end;
+
+procedure TWorkWin.ShowPCChanging(Sender: TObject; var AllowChange: Boolean);
+
+ function ByteAOfDWORD(a: DWORD): TByteA;
+ begin
+ SetLength(Result, SizeOf(DWORD));
+ Move(a, Pointer(Result)^, SizeOf(DWORD));
+ end;
+
+var
+ SourcePage: TTabSheet;
+ ValueName: string;
+begin
+ SourcePage := ShowPC.ActivePage;
+ if SourcePage = IntPage then begin
+
+ if TargetPage = StringPage then begin
+ AddHint('Converting: DWORD --> String');
+ StringE.Text := CardinalE.Text;
+ end else if TargetPage = BinaryPage then begin
+ AddHint('Converting: DWORD --> Binary');
+ BinaryHM.Data := ByteAOfDWORD(CardinalE.Value);
+ end else
+ AllowChange := False;
+
+ end else if SourcePage = StringPage then begin
+ if TargetPage = IntPage then begin
+ if IsValidCardinal(StringE.Text) then begin
+ AddHint('Converting: String --> DWORD');
+ CardinalE.Text := StringE.Text;
+ end else begin
+ AddHint('This no valid DWORD; Converting aborted.', True);
+ AllowChange := False;
+ end;
+ end else if TargetPage = BinaryPage then begin
+ AddHint('Converting: String --> Binary');
+ BinaryHM.Data := TByteA(StringE.Text);
+ end else if TargetPage = MultiStringPage then begin
+ AddHint('Converting: String --> MultiString');
+ if SeparatorE.Text = '' then
+ MultiStringM.Text := StringE.Text;
+ SeparatorEChange(Sender);
+ end else
+ AllowChange := False;
+
+ end else if SourcePage = BinaryPage then begin
+ if TargetPage = StringPage then begin
+ AddHint('Converting: Binary --> String');
+ StringE.Text := FriendlyStr(string(BinaryHM.Data));
+ end else if TargetPage = IntPage then begin
+ if Length(BinaryHM.Data) >= SizeOf(DWORD) then begin
+ AddHint('Converting: Binary --> DWORD');
+ CardinalE.Value := PDWORD(BinaryHM.Data)^;
+ end else begin
+ AddHint('Binary value not long enough (4 Byte); Converting aborted.', True);
+ AllowChange := False;
+ end;
+ end else if TargetPage = CryptoPage then begin
+ if ValuesWin.ValueNames.Count = 1 then begin
+ ValueName := ValuesWin.ValueNames[0];
+ with CryptoTypeRG do begin
+ ItemIndex := -1;
+ if SameText(ValueName, 'ScreenSave_Data') then begin
+ ItemIndex := 0;
+ CryptoE.Text := DecodeScreenSaver(BinaryHM.Data);
+ end else if SameText(ValueName, 'parm1enc')
+ or SameText(ValueName, 'parm2enc') then begin
+ ItemIndex := 1;
+ CryptoE.Text := DecodeSharedFolder(BinaryHM.Data);
+ end;
+ end;
+ if CryptoTypeRG.ItemIndex = -1 then
+ AllowChange := False;
+ end;
+ end else
+ AllowChange := False;
+
+ end else if SourcePage = MultiStringPage then begin
+ if TargetPage = StringPage then begin
+ AddHint('Converting: MultiString --> String ');
+ if SeparatorE.Text = '' then
+ StringE.Text := MultiStringM.Text
+ else
+ StringE.Text := Join(MultiStringM.Lines, SeparatorE.Text);
+ //end else if TargetPage = BinaryPage then begin
+ end else
+ AllowChange := False;
+
+ end else
+ AllowChange := False;
+end;
+
+procedure TWorkWin.ShowPCDrawTab(Control: TCustomTabControl; TabIndex: Integer;
+ const Rect: TRect; Active: Boolean);
+var
+ PC: TPageControl;
+ Page: TTabSheet;
+begin
+ PC := TPageControl(Control);
+ Page := PC.Pages[TabIndex];
+ with PC.Canvas.Font do begin
+ if Page = StringPage then
+ Color := clBrightRed
+ else if Page = MultiStringPage then
+ Color := clBrightPurple
+ else if Page = IntPage then
+ Color := clBrightBlue
+ else if Page = BinaryPage then
+ Color := clBrightGreen
+ else if Page = CryptoPage then
+ Color := clBrightCyan;
+ end;
+
+ with PC.Canvas do begin
+ if Active then
+ Brush.Color := clGray
+ else
+ Brush.Color := clDarkGray;
+ FillRect(Rect);
+ TextOut(Rect.Left + 18 + 3, Rect.Top, Page.Caption);
+ MainWin.ImageList1.Draw(Control.Canvas, Rect.Left - 1, Rect.Top - 1, Page.ImageIndex);
+ end;
+end;
+
+procedure TWorkWin.ShowPCMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+begin
+ with ShowPC do
+ if htOnItem in GetHitTestInfoAt(X, Y) then
+ TargetPage := Pages[IndexOfTabAt(X, Y)];
+end;
+
+procedure TWorkWin.FormCreate(Sender: TObject);
+var
+ i: Integer;
+begin
+ WorkU.ShowPC := ShowPC;
+ WorkU.MainPC := MainPC;
+
+ //Zeromize
+ ShowPC.ActivePage := nil;
+ InfoMemo.Text := '';
+ MultiStringM.Clear;
+ SisyTV.Items.Clear;
+ CurValueE.Text := NoValueCaption;
+ HexEditAutoChange := False;
+ TargetPage := nil;
+
+ //Tagging
+ StringPage.Tag := Integer(StringE);
+ IntPage.Tag := Integer(CardinalE);
+ BinaryPage.Tag := Integer(BinaryHM);
+ MultiStringPage.Tag := Integer(MultiStringM);
+ ShowAsBinary := False;
+
+ if not Win9x then
+ CryptoPage.TabVisible := False;
+
+ MainPC.ActivePage := HintPage;
+ ShowPC.ActivePage := nil;
+
+ DropFileTarget.register(StringE);
+
+ with StringTypeRG do
+ for i := 0 to ControlCount-1 do
+ (Controls[i] as TRadioButton).OnKeyDown := StringEKeyDown;
+
+ ExternalEditB.Enabled := FileEx(PrefWin.ExternalHexEditE.Text);
+
+ PipelineThread := TPipelineThread.CreateIt(tpIdle, '', BinaryHM);
+ PipelineThread.OnChange := LoadExternalBClick;
+end;
+
+procedure TWorkWin.OKBinaryBClick(Sender: TObject);
+var
+ Typ: Cardinal;
+ i: Integer;
+begin
+ try
+ Typ := StrToIntDef(UntilChar(DataTypeComB.Text, ' '), Integer(rdBinary));
+ OpenCurKey;
+ with ValuesWin.ValueNames do
+ for i := 0 to Count-1 do
+ MainReg.WriteBinType(Strings[i], BinaryHM.Data, Typ);
+ ValuesWin.UpdateValues(True);
+ finally
+ MainReg.CloseKey;
+ end;
+end;
+
+procedure TWorkWin.HexGrid1Click(Sender: TObject);
+begin
+ {with BinaryHM do begin
+ with BinL, Font do
+ if ActiveByte < ByteCount then
+ Color := clBrightGreen
+ else begin
+ Color := clSilver;
+ Caption := '00000000';
+ end;
+ BinL.Caption := IntToBinFill(CurrentByte, 8);
+ end; }
+end;
+
+procedure TWorkWin.HexGrid1KeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if key = VK_RETURN then begin
+ OKBinaryBClick(Sender);
+ ValuesWin.FocusControl(ValueList);
+ end;
+ if key = VK_ESCAPE then
+ CancelBClick(Sender);
+end;
+
+procedure TWorkWin.BoolStrPopup(Sender: TObject);
+begin
+ StringE.Text := TMenuItem(Sender).Caption;
+end;
+
+procedure TWorkWin.StringPageEnter(Sender: TObject);
+begin
+ FocusControl(StringE);
+end;
+
+procedure TWorkWin.IntPageEnter(Sender: TObject);
+begin
+ FocusControl(CardinalE);
+end;
+
+procedure TWorkWin.BinaryPageEnter(Sender: TObject);
+begin
+ FocusControl(BinaryHM);
+end;
+
+procedure TWorkWin.ActivateIt(Sender: TObject);
+begin
+ ActivateThis(Sender);
+end;
+
+procedure TWorkWin.DeActivateIt(Sender: TObject);
+begin
+ DeActivateThis(Sender);
+end;
+
+procedure TWorkWin.FormDeactivate(Sender: TObject);
+begin
+ if Assigned(ActiveControl) and (ActiveControl.Tag = EditControlFlag) then
+ TEdit(ActiveControl).OnExit(Sender);
+end;
+
+procedure TWorkWin.FormActivate(Sender: TObject);
+begin
+ if Assigned(ActiveControl) and (ActiveControl.Tag = EditControlFlag) then
+ TEdit(ActiveControl).OnEnter(Sender);
+end;
+
+procedure TWorkWin.MultiStringMChange(Sender: TObject);
+begin
+ MultiStringCountL.Caption := StrNumerus(MultiStringM.Lines.Count,
+ 'Line', 'Lines', 'No');
+end;
+
+procedure TWorkWin.OKMultiStringBClick(Sender: TObject);
+var
+ UseExtendedModel: Boolean;
+ i: Integer;
+ JoinedText: string;
+begin
+ if (MultiStringTypeRG.ItemIndex = 1) then begin
+ if ValuesWin.ValueCommonType = rdMultiString then
+ if mrYes<>MessageDlg('Do you want to change the type of this value?' + EOL +
+ 'MultiString --> String', mtWarning, [mbYes, mbCancel], 0) then
+ Exit;
+
+ try
+ OpenCurKey;
+ JoinedText := Join(MultiStringM.Lines, SeparatorE.Text);
+ with ValuesWin.ValueNames do
+ for i := 0 to Count-1 do
+ MainReg.WriteString(Strings[i], JoinedText);
+ ValuesWin.UpdateValues(True);
+ finally
+ MainReg.CloseKey;
+ end;
+ Exit; end;
+
+ UseExtendedModel := True;
+ if ContainsEmptyLines(MultiStringM.Lines) then
+ case MessageDlg('This text contains empty lines.' + EOL +
+ 'These are not allowed in the standard MultiString model.' + EOL +
+ 'Do you want to delete them?' + EOL +
+ EOL +
+ 'Yes: Delete empty lines' + EOL +
+ 'No: Use the Extended Model',
+ mtWarning, [mbYes, mbNo, mbCancel], 0) of
+
+ mrNo: UseExtendedModel := True;
+
+ mrYes: begin
+ with MultiStringM do begin
+ Lines.BeginUpdate;
+ DeleteEmptyLines(Lines);
+ Lines.EndUpdate;
+ end;
+ end;
+
+ else Exit;
+
+ end;
+
+ try
+ OpenCurKey;
+ with ValuesWin.ValueNames do
+ for i := 0 to Count-1 do begin
+ if MainReg.GetDataType(Strings[i]) <> rdMultiString then
+ if mrYes <> MessageDlg('Do you want to change the type of this value?' + EOL +
+ '--> MultiString', mtWarning, [mbYes, mbCancel], 0) then
+ Exit;
+ if UseExtendedModel then
+ MainReg.WriteStringList(Strings[i], MultiStringM.Lines)
+ else
+ MainReg.WriteMultiString(Strings[i], MultiStringM.Lines);
+ end;
+ ValuesWin.UpdateValues(True);
+ finally
+ MainReg.CloseKey;
+ end;
+
+ ValuesWin.ValueListDblClick(Sender);
+end;
+
+procedure TWorkWin.StringAsColorPDblClick(Sender: TObject);
+begin
+ if ColorDlg.Execute then
+ StringE.Text := StringOfColor(ColorDlg.Color, csfThreeSpacedDecimals);
+end;
+
+procedure TWorkWin.MultiStringMEnter(Sender: TObject);
+begin
+ MultiStringM.SelectAll;
+ ActivateIt(MultiStringM);
+end;
+
+procedure TWorkWin.LadenMIClick(Sender: TObject);
+begin
+ with MultiStringOpenD do begin
+ InitialDir := ExtractFileDrive(MyDir);
+ if Execute then
+ MultiStringM.Lines.LoadFromFile(FileName);
+ end;
+end;
+
+procedure TWorkWin.SpeichernMIClick(Sender: TObject);
+begin
+ with MultiStringSaveD do begin
+ InitialDir := ExtractFileDrive(MyDir);
+ if Execute then
+ MultiStringM.Lines.SaveToFile(FileName);
+ end;
+end;
+
+procedure TWorkWin.Hinzufgen1Click(Sender: TObject);
+var
+ SL: TStringList;
+begin
+ with MultiStringOpenD do begin
+ InitialDir := ExtractFileDrive(MyDir);
+ if Execute then begin
+ SL := TStringList.Create;
+ SL.LoadFromFile(FileName);
+ MultiStringM.Lines.AddStrings(SL);
+ SL.Free;
+ end;
+ end;
+end;
+
+procedure TWorkWin.CancelBClick(Sender: TObject);
+begin
+ ValuesWin.FocusControl(ValueList);
+ ValuesWin.ValueListChange(Sender, ValueList.Selected, ctState);
+end;
+
+procedure TWorkWin.HexGrid1Enter(Sender: TObject);
+begin
+ HexGrid1Click(Sender);
+end;
+
+procedure TWorkWin.SpyClearTracesBClick(Sender: TObject);
+begin
+ SpyLB.Clear;
+end;
+
+procedure TWorkWin.SpyLBKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if (ssShift in Shift) and (key = VK_DELETE) then begin
+ key := 0;
+ SpyLB.Clear;
+ Exit; end;
+
+ if key = VK_F9 then begin
+ key := 0;
+ SwapFonts(SpyLB);
+ Exit; end;
+end;
+
+procedure TWorkWin.BinLClick(Sender: TObject);
+begin
+ // with HexGrid1 do
+ // Byt[ActiveByte] := IntOfBin(BinL.Caption);
+end;
+
+procedure TWorkWin.HexGrid1KeyUp(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ //HexGrid1Click(Sender);
+end;
+
+procedure TWorkWin.ValueViewChanged(Sender: TObject);
+var
+ i: Integer;
+begin
+ if not Started then
+ Exit;
+
+ SpyThread.Suspend;
+ OpenCurKey;
+ for i := 0 to ValueList.Items.Count-1 do
+ ValuesWin.UpdateValue(MainReg, ValueList.Items[i]);
+
+ MainReg.CloseKey;
+ SpyThread.Resume;
+end;
+
+procedure TWorkWin.HexEdit1Change(Sender: TObject);
+begin
+ if not HexEditAutoChange then
+ CardinalE.Value := HexEdit1.Value;
+end;
+
+procedure TWorkWin.SortMultiStringMIClick(Sender: TObject);
+var
+ SL: TStringList;
+begin
+ SL := TStringList.Create;
+ with SL do begin
+ Assign(MultiStringM.Lines);
+ Sort;
+ end;
+ MultiStringM.Lines.Assign(SL);
+ SL.Free;
+end;
+
+procedure TWorkWin.SpyTestLClick(Sender: TObject);
+begin
+ SpyTestL.Caption := StrOfBool(SpyThread.Suspended, 'No Spy.', 'Spy active.');
+end;
+
+procedure TWorkWin.FocusForEditing;
+begin
+ FocusControl(MainPC);
+end;
+
+function TWorkWin.LoadBoolStr: Boolean;
+var
+ SL: TStringList;
+ FileName: string;
+ i, p: Integer;
+begin
+ Result := True;
+
+ AddHint('Loading Boolean Strings...');
+
+ FileName := PlutoDir + BoolStrFileName;
+ if not FileEx(FileName) then begin
+ AddToLastHint('not found:');
+ AddHint(FileName);
+ Result := False;
+ end else begin
+ SL := TStringList.Create;
+ try
+ SL.LoadFromFile(FileName);
+ DeleteCommentLines(SL);
+ BoolStr := nil;
+ SetLength(BoolStr, SL.Count);
+ for i := 0 to SL.Count-1 do begin
+ //Split the string by the '|'-sign
+ p := Pos('|', SL[i]);
+ BoolStr[i][False] := Copy(SL[i], 1, p-1);
+ BoolStr[i][True] := Copy(SL[i], p+1, Length(SL[i]) - p);
+ end;
+ finally
+ SL.Free;
+ AddToLastHint('OK');
+ end;
+ end;
+end;
+
+function TWorkWin.LoadSisyFilter: Boolean;
+var
+ SL: TStringList;
+ FileName: string;
+ i: Integer;
+begin
+ Result := True;
+
+ FileName := PlutoDir + SisyFilterFileName;
+ if not FileEx(FileName) then
+ Result := False
+ else begin
+ AddHint('Loading Sisyphus Filter Settings...');
+ SL := TStringList.Create;
+ try
+ SL.LoadFromFile(FileName);
+ DeleteCommentLines(SL, '#');
+ for i := 0 to SL.Count-1 do
+ SL[i] := TrimLeft(SL[i]);
+
+ SisyFilter.Clear;
+ SisyFilter.AddStrings(SL);
+ finally
+ SL.Free;
+ AddToLastHint('OK');
+ end;
+ end;
+end;
+
+procedure TWorkWin.SisyTVGetSelectedIndex(Sender: TObject; Node: TTreeNode);
+begin
+ Node.SelectedIndex := Node.ImageIndex;
+end;
+
+procedure TWorkWin.SisyTVDblClick(Sender: TObject);
+var
+ Node: TTreeNode;
+ Path: string;
+begin
+ Node := SisyTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ Path := RootOfNode(Node).Text;
+
+ if Node.Level > 0 then begin
+ if Node.Level = 2 then
+ Node := Node.Parent;
+ if Node.HasChildren then
+ Path := Path + '\\' + Node.Text //Value
+ else
+ Path := Path + '\' + Node.Text //SubKey
+ end;
+
+ MainWin.GotoKey(Path);
+end;
+
+procedure TWorkWin.DeleteChange(Node: TTreeNode);
+var
+ SubNode: TTreeNode;
+
+ procedure FreeSisyChangeNode(Node: TTreeNode);
+ begin
+ try
+ with (TObject(Node.Data) as TSisyChange) do
+ Free;
+ except
+ ReportFmt('errors', 'Context could not be freed: "%s"', [Node.Text]);
+ end;
+
+ Node.Delete;
+ end;
+
+begin
+ if not Assigned(Node) then
+ Exit;
+
+ if Node.Level = 2 then
+ Node := Node.Parent;
+
+ if Node.Level = 0 then begin
+ SisyTV.Selected := GetNextBest(RootOfNode(Node));
+ SubNode := Node.GetFirstChild;
+ while Assigned(SubNode) do begin
+ FreeSisyChangeNode(SubNode);
+ SubNode := Node.GetFirstChild; end;
+ Node.Delete;
+ end else begin
+ SisyTV.Selected := GetNextBest(Node);
+ FreeSisyChangeNode(Node);
+ end;
+end;
+
+procedure TWorkWin.DeactivateChange(Node: TTreeNode);
+begin
+ Node := RootOfNode(Node);
+
+ if not Assigned(Node) then
+ Exit;
+
+ if SisyChangeActivated(Node) then begin
+ SetSisyChangeState(Node, False);
+ Node.Cut := True;
+ end else begin
+ SetSisyChangeState(Node, True);
+ Node.Cut := False;
+ end;
+ SisyTV.Repaint;
+end;
+
+procedure TWorkWin.CopySelectedChangeName;
+var
+ Node: TTreeNode;
+begin
+ Node := SisyTV.Selected;
+ if not Assigned(Node) then
+ Exit;
+
+ Clipboard.AsText := Node.Text;
+end;
+
+procedure TWorkWin.SisyTVKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+var
+ Node: TTreeNode;
+begin
+ Node := RootOfNode(SisyTV.Selected);
+ if not Assigned(Node) then
+ Exit;
+
+ {if Key = VK_RETURN then
+ SisyTVDblCLick(Sender);
+
+ if Key = VK_DELETE then
+ if (ssCtrl in Shift) and (Key = VK_DELETE) then
+ DeactivateChange(Node)
+ else
+ DeleteChange(Node);
+
+ if (ssCtrl in Shift) and (Char(Key) = 'C') then
+ CopySelectedChangeName;}
+end;
+
+procedure TWorkWin.SisyCBClick(Sender: TObject);
+begin
+ if not Started then
+ Exit;
+
+ with TCheckBox(Sender), TSisyThread(Sisys[Tag]) do begin
+ if Checked then
+ Resume
+ else
+ Suspend;
+ end;
+end;
+
+procedure TWorkWin.CurValueEEnter(Sender: TObject);
+begin
+ CurValueE.Text := RealValueName(ValueList.ItemFocused);
+ CurValueE.SelectAll;
+end;
+
+procedure TWorkWin.CurValueEKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+
+ procedure RenameValue(NewName: string);
+ var
+ Item: TListItem;
+ begin
+ Item := ValueList.ItemFocused;
+ if ValuesWin.TryRenameValue(CurKey.Value, NewName) then
+ SetRealValueName(Item, NewName);
+ end;
+
+begin
+ if Key = VK_RETURN then begin
+ SpyThread.Suspend;
+ try
+ RenameValue(CurValueE.Text);
+ ValuesWin.ValueListDblClick(Self);
+ FocusControl(CurValueE);
+ finally
+ SpyThread.Restart := True;
+ SpyThread.Resume;
+ end;
+ Key := 0;
+ //CurValueE.SelectAll;
+ end else if Key = VK_ESCAPE then begin
+ ValuesWin.ValueListDblClick(Self);
+ end;
+end;
+
+procedure TWorkWin.BinaryHMLineChange(NewLine: Cardinal);
+begin
+ OffsetHE.Value := BinaryHM.Pos;
+ // BinaryAsIntL.Value := Integer(BinaryHM.CurentCard);
+end;
+
+procedure TWorkWin.OffsetHEChange(Sender: TObject);
+begin
+ BinaryHM.Pos := OffsetHE.Value;
+end;
+
+procedure TWorkWin.SpyDelayIEChange(Sender: TObject);
+begin
+ if Assigned(SpyThread) then
+ SpyThread.Delay := SpyDelayIE.Value;
+end;
+
+procedure TWorkWin.SisyTVExpanded(Sender: TObject; Node: TTreeNode);
+begin
+ if Node.ImageIndex = 8 then
+ Node.ImageIndex := 7;
+end;
+
+procedure TWorkWin.ClearChanges;
+var
+ Node: TTreeNode;
+begin
+ with SisyTV.Items do begin
+ Node := GetFirstNode;
+ while Assigned(Node) do begin
+ DeleteChange(Node);
+ Node := GetFirstNode;
+ end;
+ end;
+end;
+
+procedure TWorkWin.ClearChangesBClick(Sender: TObject);
+begin
+ if mrOK <> MessageDlg('Do you really want to clear all changes?',
+ mtWarning, [mbOK, mbCancel], 0) then
+ Exit;
+
+ ClearChanges;
+end;
+
+procedure TWorkWin.FilterChangesBClick(Sender: TObject);
+begin
+ NotePad(PlutoDir + SisyFilterFileName);
+ ShowMessage('Click OK when you finished editing.' + EOL +
+ '(Pluto will reload the filter settings then.)');
+ LoadSisyFilter;
+end;
+
+procedure TWorkWin.SisyTVPUPopup(Sender: TObject);
+var
+ KeySelected: Boolean;
+ Node: TTreeNode;
+begin
+ Node := SisyTV.Selected;
+ KeySelected := Assigned(Node);
+
+ SisyGoToKeyMI.Enabled := KeySelected;
+ SisyDeleteChangeMI.Enabled := KeySelected;
+ SisyActivateChangeMI.Enabled := KeySelected;
+ SisyCopyPathMI.Enabled := KeySelected;
+ if not KeySelected then
+ Exit;
+
+ SisyActivateChangeMI.Checked := SisyChangeActivated(RootOfNode(Node));
+end;
+
+procedure TWorkWin.SisyActivateChangeMIClick(Sender: TObject);
+begin
+ DeactivateChange(SisyTV.Selected)
+end;
+
+procedure TWorkWin.SisyDeleteChangeMIClick(Sender: TObject);
+begin
+ DeleteChange(SisyTV.Selected)
+end;
+
+procedure TWorkWin.SisyCopyPathMIClick(Sender: TObject);
+begin
+ CopySelectedChangeName;
+end;
+
+procedure TWorkWin.FileMIClick(Sender: TObject);
+var
+ s: string;
+begin
+ with FileOpenD do begin
+ s := ExtractPath(StringE.Text);
+ if s <> '' then
+ InitialDir := s
+ else
+ InitialDir := MyDir;
+
+ s := ExtractFileName(StringE.Text);
+ s := DeleteChars(s, '/');
+ if s <> '' then
+ FileName := s;
+
+ if Execute then
+ StringE.Text := FileName;
+ end;
+end;
+
+procedure TWorkWin.ExternalEditBClick(Sender: TObject);
+var
+ FileName: string;
+begin
+ FileName := TempDir + '~' + DeleteChars(CurValueE.Text, FileNameEnemies) +
+ '.bin';
+ if SaveByteA(BinaryHM.Data, FileName) then
+ ExecFileWith(PrefWin.ExternalHexEditE.Text, FileName)
+ else
+ ShowMessage('Could not write into file:' + EOL + FileName);
+
+ PipelineThread.FileName := FileName;
+end;
+
+procedure TWorkWin.LoadExternalBClick(Sender: TObject);
+var
+ FileName: string;
+ Data: TByteA;
+ i: Integer;
+begin
+ Data := nil;
+
+ FileName := TempDir + '~' + CurValueE.Text + '.bin';
+ if not FileEx(FileName) then begin
+ {ShowMessage('File not found:' + EOL +
+ FileName);}
+ Exit;
+ end;
+
+ Data := LoadByteA(FileName);
+ if Length(Data) = Length(BinaryHM.Data) then begin
+ for i := 0 to High(Data) do
+ if Data[i] <> BinaryHM.Data[i] then begin
+ BinaryHM.Data := Data;
+ Exit;
+ end;
+ end else
+ BinaryHM.Data := Data;
+end;
+
+procedure TWorkWin.PipelineCBClick(Sender: TObject);
+begin
+ with PipelineThread, PipelineCB do
+ if Checked then begin
+ if Suspended then
+ Resume;
+ end else
+ if not Suspended then
+ Suspend;
+end;
+
+procedure TWorkWin.ReloadBClick(Sender: TObject);
+begin
+ ValuesWin.ValueListDblClick(Self);
+end;
+
+procedure TWorkWin.BinaryHMEnter(Sender: TObject);
+begin
+ PipelineCB.Checked := False;
+end;
+
+procedure TWorkWin.xUseExtendedModelCBClick(Sender: TObject);
+begin
+ PrefWin.UseExtendedModelCB.Load;
+end;
+
+procedure TWorkWin.SeparatorEChange(Sender: TObject);
+begin
+ if not SeparatorE.Enabled then
+ Exit;
+
+ if SeparatorE.Text = '' then begin
+ if StringE.Text = '' then
+ Exit
+ else
+ MultiStringM.Text := StringE.Text;
+ MultiStringTypeRG.Buttons[1].Enabled := False;
+ MultiStringTypeRG.ItemIndex := 0;
+ end else begin
+ if StringE.Text = '' then
+ StringE.Text := Join(MultiStringM.Lines, SeparatorE.Text);
+ MultiStringTypeRG.Buttons[1].Enabled := True;
+ MultiStringTypeRG.ItemIndex := 1;
+ Split(StringE.Text, SeparatorE.Text, MultiStringM.Lines, False);
+ end;
+end;
+
+procedure TWorkWin.HintLBKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if (Key = Byte('C')) and (ssCtrl in Shift) then
+ with HintLb do
+ if ItemIndex >= 0 then
+ Clipboard.AsText := Items[ItemIndex];
+end;
+
+procedure TWorkWin.DWORDSpecialBClick(Sender: TObject);
+begin
+ CardinalE.Value := StrToIntDef((Sender as TButton).Caption, 0);
+end;
+
+procedure TWorkWin.Button1Click(Sender: TObject);
+begin
+ ShowPC.SelectNextPage(True);
+end;
+
+procedure TWorkWin.SisyPUPopup(Sender: TObject);
+begin
+ with SisyPU, TSisyThread(Sisys[PopupComponent.Tag]) do
+ Items[Integer(Priority)].Checked := True;
+end;
+
+procedure TWorkWin.SisyPriorityMIClick(Sender: TObject);
+begin
+ with TSisyThread(Sisys[SisyPU.PopupComponent.Tag]) do begin
+ Priority := TThreadPriority(TMenuItem(Sender).MenuIndex);
+ if Priority <= tpNormal then
+ Uni.WriteInteger('Priority', Integer(Priority));
+ end;
+end;
+
+procedure TWorkWin.SisyShowCurrentPathMIClick(Sender: TObject);
+begin
+ with SisyPU, TSisyThread(Sisys[PopupComponent.Tag]) do begin
+ Suspend;
+ ShowMessage(CurrentSpyKey.Path);
+ Resume;
+ end;
+end;
+
+procedure TWorkWin.DropFileTargetDrop(Sender: TObject;
+ ShiftState: TShiftState; Point: TPoint; var Effect: Integer);
+begin
+ StringE.Text := DropFileTarget.Files[0];
+end;
+
+procedure TWorkWin.FormClose(Sender: TObject; var Action: TCloseAction);
+begin
+// Action := caNone;
+ DropFileTarget.Unregister;
+ ClearChanges;
+end;
+
+procedure TWorkWin.FormResize(Sender: TObject);
+begin
+ Realign;
+end;
+
+procedure TWorkWin.IconImageDblClick(Sender: TObject);
+var
+ Filename: string;
+begin
+ FileName := GetFileNew(StringE.Text);
+ if FileName <> '' then
+ ExecFile(FileName);
+end;
+
+procedure TWorkWin.ShowValues(Reg: TXRegistry);
+var
+ MainValueName: string;
+ ValueCommonType: TRegDataType;
+
+ procedure ShowValueAsBinary(const ValueName: string;
+ Smart4BB: Boolean = True);
+ begin
+ if Smart4BB
+ and PrefWin.Smart4BBCB.Checked
+ and (Reg.GetDataSize(ValueName) = 4) then begin
+ CardinalE.Value := Reg.ReadCardinal(ValueName);
+ CardTypeRG.ItemIndex := 2;
+ ShowPC.ActivePage := IntPage;
+ Exit; end;
+ BinaryHM.Data := Reg.ReadBin(ValueName);
+ DataTypeComB.ItemIndex := ValueCommonType;
+ if IsValidDataType(ValueCommonType) then
+ DataTypeComB.ItemIndex := ValueCommonType
+ else begin
+ DataTypeComB.Text := IntToStr(ValueCommonType);
+ AddHint('Value has unknown data type (' + DataTypeComB.Text + '): ' +
+ Quote(ValueName));
+ end;
+ ShowPC.ActivePage := BinaryPage;
+ end;
+
+begin
+ with ValuesWin do begin
+ if not Assigned(ValueNames) or (ValueNames.Count = 0) then
+ raise EReadError.Create('ValueNameList error');
+ MainValueName := ValueNames[0];
+ end;
+ ValueCommonType := ValuesWin.ValueCommonType;
+
+ with CurValueE do begin
+ Enabled := True;
+ if ValuesWin.ValueNames.Count = 1 then
+ Text := MainValueName
+ else
+ Text := Copy(ValuesWin.ValueNames.CommaText, 1, 255);
+
+ Font.Color := ColorOfDataType(ValueCommonType);
+ end;
+
+ if KeyIsDown(VK_MENU) or ShowAsBinary then begin
+ ShowValueAsBinary(MainValueName, False);
+ end else if ValueCommonType in rdStringTypes then begin
+ StringE.Text := Reg.ReadString(MainValueName);
+ case ValueCommonType of
+ rdString: StringTypeRG.ItemIndex := 0;
+ rdExpandString: StringTypeRG.ItemIndex := 1;
+ end;
+ ShowPC.ActivePage := StringPage;
+ end else if ValueCommonType in rdCardTypes then begin
+ CardinalE.Value := Reg.ReadCardinal(MainValueName);
+ case ValueCommonType of
+ rdCardinal: StringTypeRG.ItemIndex := 0;
+ rdCardBigEndian: StringTypeRG.ItemIndex := 1;
+ end;
+ ShowPC.ActivePage := IntPage;
+ end else if ValueCommonType = rdMultiString then begin
+ MultiStringM.Clear;
+ Reg.ReadMultiString(MainValueName, MultiStringM.Lines, PrefWin.UseExtendedModelCB.Checked);
+ SeparatorEChange(Self);
+ MultiStringTypeRG.ItemIndex := 0;
+ ShowPC.ActivePage := MultiStringPage;
+ end else begin
+ ShowValueAsBinary(MainValueName);
+ end;
+
+ ShowAsBinary := False;
+
+ UpdateWriteButtons;
+end;
+
+procedure TWorkWin.UpdateWriteButtons;
+const
+ BtnTextOfMultiEdit: array[Boolean] of string = ('Write', 'Write all');
+var
+ BtnText: string;
+begin
+ BtnText := BtnTextOfMultiEdit[ValuesWin.ValueNames.Count > 1];
+ OKStringB.Caption := BtnText;
+ OKIntB.Caption := BtnText;
+ OKMultiStringB.Caption := BtnText;
+ OKBinaryB.Caption := BtnText;
+end;
+
+procedure TWorkWin.EditData;
+begin
+ AddHint('Edit');
+ MainPC.ActivePage := WorkPage;
+
+ with ShowPC do
+ if ActivePage = nil then
+ Exit
+ else if ActivePage = WorkWin.StringPage then begin
+ FocusControl(StringE);
+ StringE.SelectAll;
+ end
+ else if ActivePage = WorkWin.IntPage then
+ FocusControl(CardinalE)
+ else if ActivePage = WorkWin.MultiStringPage then
+ FocusControl(MultiStringM)
+ else if ActivePage = WorkWin.BinaryPage then
+ FocusControl(BinaryHM)
+ else
+ ShowMessage('Error: ShowPC.ActivePage!');
+end;
+
+procedure TWorkWin.SisyTVCustomDrawItem(Sender: TCustomTreeView;
+ Node: TTreeNode; State: TCustomDrawState; var DefaultDraw: Boolean);
+begin
+ with TTreeView(Sender).Canvas.Font do begin
+ if Node.Cut then
+ Color := $AAAAAA
+ else
+ Color := clWhite;
+ end;
+end;
+
+procedure TWorkWin.SisyTVMouseDown(Sender: TObject; Button: TMouseButton;
+ Shift: TShiftState; X, Y: Integer);
+var
+ Node: TTreeNode;
+ RelX, RelY: Integer;
+begin
+ with SisyTV do begin
+ RelX := ScreenToClient(Mouse.CursorPos).X;
+ RelY := ScreenToClient(Mouse.CursorPos).Y;
+ Node := GetNodeAt(RelX, RelY);
+ end;
+ if not Assigned(Node) then
+ Exit;
+
+ if not Node.Selected then
+ Node.Selected := True;
+end;
+
+procedure TWorkWin.OKCryptoBClick(Sender: TObject);
+var
+ i: Integer;
+begin
+ try
+ OpenCurKey;
+ with ValuesWin.ValueNames do
+ for i := 0 to Count-1 do begin
+ case CryptoTypeRG.ItemIndex of
+ 0: MainReg.WriteBin(Strings[i], EncodeScreenSaver(CryptoE.Text));
+ 1: MainReg.WriteBin(Strings[i], EncodeSharedFolder(CryptoE.Text));
+ end;
+ end;
+ ValuesWin.UpdateValues(True);
+ finally
+ MainReg.CloseKey;
+ end;
+ ValuesWin.ValueListDblClick(Sender);
+end;
+
+procedure TWorkWin.CryptoEKeyDown(Sender: TObject; var Key: Word;
+ Shift: TShiftState);
+begin
+ if Key = VK_RETURN then begin
+ OKCryptoBClick(Sender);
+ ValuesWin.FocusControl(ValueList);
+ end;
+ if Key = VK_ESCAPE then
+ CancelBClick(Sender);
+end;
+
+end.
|