david
13eee3f7f4
git-svn-id: https://192.168.0.254/svn/Componentes.Terceros.jcl@20 c37d764d-f447-7644-a108-883140d013fb
239 lines
9.8 KiB
ObjectPascal
239 lines
9.8 KiB
ObjectPascal
{**************************************************************************************************}
|
|
{ }
|
|
{ The contents of this file are subject to the Mozilla Public License Version 1.1 (the "License") }
|
|
{ you may not use this file except in compliance with the License. You may obtain a copy of the }
|
|
{ License at http://www.mozilla.org/MPL/MPL-1.1.html }
|
|
{ }
|
|
{ Software distributed under the License is distributed on an "AS IS" basis, WITHOUT WARRANTY OF }
|
|
{ ANY KIND, either expressed or implied. See the License for the specific language governing }
|
|
{ rights and limitations under the License. }
|
|
{ }
|
|
{ The Original Code is: JediInfo.pas, released on 2006-02-26. }
|
|
{ }
|
|
{ The Initial Developer of the Original Code is Andreas Hausladen }
|
|
{ (Andreas dott Hausladen att gmx dott de) }
|
|
{ Portions created by Andreas Hausladen are Copyright (C) 2006 Andreas Hausladen. }
|
|
{ All Rights Reserved. }
|
|
{ }
|
|
{ Contributor(s): }
|
|
{ }
|
|
{ You may retrieve the latest version of this file at the Project JEDI's JCL / JVCL }
|
|
{ home page, located at http://jcl.sourceforge.net / http://jvcl.sourceforge.net }
|
|
{ }
|
|
{ Known Issues: }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
{ }
|
|
{ Last modified: $Date:: 2009-08-09 19:36:17 +0200 (dim., 09 août 2009) $ }
|
|
{ Revision: $Rev:: 2931 $ }
|
|
{ Author: $Author:: outchy $ }
|
|
{ }
|
|
{**************************************************************************************************}
|
|
|
|
{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
|
|
|
|
unit JediRegInfo;
|
|
|
|
{$I jedi.inc}
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, SysUtils, Classes;
|
|
|
|
type
|
|
TJediInformation = record
|
|
Version: string; // example: '1.98'
|
|
DcpDir: string; // example: 'C:\Program Files\Borland\Delphi7\Projects\BPL', the JVCL Installer resolves macros
|
|
BplDir: string; // example: 'C:\Program Files\Borland\Delphi7\Projects\BPL', the JVCL Installer resolves macros
|
|
RootDir: string; // example: 'C:\Program Files\Borland\Delphi7', the JVCL Installer resolves macros
|
|
end;
|
|
|
|
{ InstallJediInformation() writes the "Version", "DcpDir", "BplDir" and "RootDir"
|
|
values into the registry key IdeRegKey\Jedi\ProjectName. Returns True if the
|
|
values could be written. }
|
|
function InstallJediRegInformation(const IdeRegKey, ProjectName, Version, DcpDir,
|
|
BplDir, RootDir: string; RootKey: HKEY = HKEY_CURRENT_USER): Boolean;
|
|
|
|
{ RemoveJediInformation() deletes the registry key IdeRegKey\Jedi\ProjectName.
|
|
If there is no further subkeys to IdeRegKey\Jedi and no values in this key,
|
|
the whole Jedi-key is deleted. }
|
|
procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string;
|
|
RootKey: HKEY = HKEY_CURRENT_USER);
|
|
|
|
{ ReadJediInformation() reads the JEDI Information from the registry. Returns
|
|
False if Version='' or DcpDir='' or BplDir='' or RootDir=''. }
|
|
function ReadJediRegInformation(const IdeRegKey, ProjectName: string; out Version,
|
|
DcpDir, BplDir, RootDir: string; RootKey: HKEY = HKEY_CURRENT_USER): Boolean; overload;
|
|
|
|
{ ReadJediInformation() reads the JEDI Information from the registry. }
|
|
function ReadJediRegInformation(const IdeRegKey, ProjectName: string
|
|
; RootKey: HKEY = HKEY_CURRENT_USER): TJediInformation; overload;
|
|
|
|
{ ParseVersionNumber() converts a version number 'major.minor.release.build' to
|
|
cardinal like the JclBase JclVersion constant. If the VersionStr is invalid
|
|
the function returns 0. }
|
|
function ParseVersionNumber(const VersionStr: string): Cardinal;
|
|
|
|
implementation
|
|
|
|
uses
|
|
Registry;
|
|
|
|
function InstallJediRegInformation(const IdeRegKey, ProjectName, Version, DcpDir,
|
|
BplDir, RootDir: string; RootKey: HKEY): Boolean;
|
|
var
|
|
Reg: TRegistry;
|
|
begin
|
|
Result := False;
|
|
if (Version <> '') and (DcpDir <> '') and (BplDir <> '') and (RootDir <> '') then
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RootKey;
|
|
if Reg.OpenKey(IdeRegKey + '\Jedi', True) then // do not localize
|
|
Reg.CloseKey;
|
|
if Reg.OpenKey(IdeRegKey + '\Jedi\' + ProjectName, True) then // do not localize
|
|
begin
|
|
Reg.WriteString('Version', Version); // do not localize
|
|
Reg.WriteString('DcpDir', ExcludeTrailingPathDelimiter(DcpDir)); // do not localize
|
|
Reg.WriteString('BplDir', ExcludeTrailingPathDelimiter(BplDir)); // do not localize
|
|
Reg.WriteString('RootDir', ExcludeTrailingPathDelimiter(RootDir)); // do not localize
|
|
Result := True;
|
|
end;
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure RemoveJediRegInformation(const IdeRegKey, ProjectName: string; RootKey: HKEY);
|
|
var
|
|
Reg: TRegistry;
|
|
Names: TStringList;
|
|
JediKeyName, ProjectKeyName: string;
|
|
begin
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RootKey;
|
|
// (outchy) do not delete target settings
|
|
// Reg.DeleteKey(IdeRegKey + '\Jedi\' + ProjectName); // do not localize
|
|
|
|
JediKeyName := IdeRegKey + '\Jedi'; // do not localize
|
|
ProjectKeyName := JediKeyName + '\' + ProjectName; // do not localize
|
|
|
|
if Reg.OpenKey(ProjectKeyName, False) then
|
|
begin
|
|
Reg.DeleteValue('Version'); // do not localize
|
|
Reg.DeleteValue('DcpDir'); // do not localize
|
|
Reg.DeleteValue('BplDir'); // do not localize
|
|
Reg.DeleteValue('RootDir'); // do not localize
|
|
|
|
Names := TStringList.Create;
|
|
try
|
|
Reg.GetKeyNames(Names);
|
|
if Names.Count = 0 then
|
|
begin
|
|
Reg.GetValueNames(Names);
|
|
if Names.Count = 0 then
|
|
begin
|
|
Reg.CloseKey;
|
|
Reg.DeleteKey(ProjectKeyName); // do not localize
|
|
end;
|
|
end;
|
|
finally
|
|
Names.Free;
|
|
end;
|
|
end;
|
|
|
|
|
|
if Reg.OpenKey(JediKeyName, False) then // do not localize
|
|
begin
|
|
Names := TStringList.Create;
|
|
try
|
|
Reg.GetKeyNames(Names);
|
|
if Names.Count = 0 then
|
|
begin
|
|
Reg.GetValueNames(Names);
|
|
if Names.Count = 0 then
|
|
begin
|
|
Reg.CloseKey;
|
|
Reg.DeleteKey(JediKeyName); // do not localize
|
|
end;
|
|
end;
|
|
finally
|
|
Names.Free;
|
|
end;
|
|
end;
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
end;
|
|
|
|
function ReadJediRegInformation(const IdeRegKey, ProjectName: string; out Version,
|
|
DcpDir, BplDir, RootDir: string; RootKey: HKEY): Boolean; overload;
|
|
var
|
|
Reg: TRegistry;
|
|
begin
|
|
Version := '';
|
|
DcpDir := '';
|
|
BplDir := '';
|
|
RootDir := '';
|
|
Reg := TRegistry.Create;
|
|
try
|
|
Reg.RootKey := RootKey;
|
|
if Reg.OpenKeyReadOnly(IdeRegKey + '\Jedi\' + ProjectName) then // do not localize
|
|
begin
|
|
if Reg.ValueExists('Version') then // do not localize
|
|
Version := Reg.ReadString('Version'); // do not localize
|
|
if Reg.ValueExists('DcpDir') then // do not localize
|
|
DcpDir := ExcludeTrailingPathDelimiter(Reg.ReadString('DcpDir')); // do not localize
|
|
if Reg.ValueExists('BplDir') then // do not localize
|
|
BplDir := ExcludeTrailingPathDelimiter(Reg.ReadString('BplDir')); // do not localize
|
|
if Reg.ValueExists('RootDir') then // do not localize
|
|
RootDir := ExcludeTrailingPathDelimiter(Reg.ReadString('RootDir')); // do not localize
|
|
end;
|
|
finally
|
|
Reg.Free;
|
|
end;
|
|
Result := (Version <> '') and (DcpDir <> '') and (BplDir <> '') and (RootDir <> '');
|
|
end;
|
|
|
|
function ReadJediRegInformation(const IdeRegKey, ProjectName: string; RootKey: HKEY): TJediInformation;
|
|
begin
|
|
ReadJediRegInformation(IdeRegKey, ProjectName, Result.Version, Result.DcpDir,
|
|
Result.BplDir, Result.RootDir, RootKey);
|
|
end;
|
|
|
|
function ParseVersionNumber(const VersionStr: string): Cardinal;
|
|
const
|
|
Shifts: array[0..3] of Integer = (24, 16, 15, 0);
|
|
var
|
|
S: string;
|
|
ps: Integer;
|
|
Count: Integer;
|
|
begin
|
|
S := VersionStr;
|
|
Result := 0;
|
|
if S <> '' then
|
|
begin
|
|
Result := 0;
|
|
try
|
|
Count := 0;
|
|
ps := Pos('.', S);
|
|
while (ps > 0) and (Count < High(Shifts)) do
|
|
begin
|
|
Result := Result or (Cardinal(StrToInt(Copy(S, 1, ps - 1))) shl Shifts[Count]);
|
|
S := Copy(S, ps + 1, MaxInt);
|
|
ps := Pos('.', S);
|
|
Inc(Count);
|
|
end;
|
|
Result := Result or (Cardinal(StrToInt(Copy(S, 1, MaxInt))) shl Shifts[Count]);
|
|
except
|
|
Result := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|