Hallo,
ich sitze nun seit 2 Tagen an meheren Problemen mit der Komponente "TLMDSimplePropInspector".
Mein erstes Problem ist, dass immer ein Published Property weniger angezeigt werden als meine Klasse hat.
Viel grösser ist das Problem, dass ich nach Bearbeitung eines CollectionItem nicht mehr in den "normal" Inspektor zurück gelange.
Was muss ich tuen?
Bitte um schnelle Hilfe, da ich verzweifele....
Hier der entrechende Teil des Source:
unit omsoConfigApp;
interface
uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, ExtCtrls, ComCtrls, Forms, Dialogs, omsoTools, omsoBaseDialog, xpPanel, xpPages, TypInfo, DB, Grids, XMLDoc, XMLIntf, DCPcrypt2, DCPblockciphers, DCPblowfish, DCPmd5, LMDTypes, LMDInsPropEditors, LMDCustomComponent, LMDCustomParentPanel, LMDCustomPanelFill, LMDPanelFill, LMDControl, LMDCustomControl, LMDCustomPanel, LMDCustomBevelPanel, LMDCustomStatusBar, LMDStatusBar, LMDGraphicControl, LMDBaseMeter, LMDCustomProgress, LMDProgress, LMDBaseControl, LMDBaseGraphicControl, LMDBaseLabel, LMDCustomLabel, LMDLabel, LMDSimplePanel, LMDInsPropPage, LMDInsPropInsp, LMDDsgObjects, LMDDsgPropInsp;
type //--------------------------------------------------------------------------- TConfigSection = class(TCollectionItem) private F0Dummy : WideString;
FSectionName : WideString; FServerName : WideString; FDatabaseName : WideString; FUserName : WideString; FuserPWD : WideString; public procedure Assign (Source : TPersistent); override;
property _0Dummy : WideString read F0Dummy write F0Dummy ; published property SectionName : WideString read FSectionName write FSectionName ; property ServerName : WideString read FServerName write FServerName ; property DatabaseName : WideString read FDatabaseName write FDatabaseName ; property UserName : WideString read FUserName write FUserName ; property UserPWD : WideString read FUserPWD write FUserPWD ; end;
//--------------------------------------------------------------------------- TConfigSections = class(TOwnedCollection) private function GetItem (Value: Integer ) : TConfigSection; procedure SetItem (Value: Integer; xConfig: TConfigSection); protected public constructor Create (AOwner: TComponent; AItemClass: TCollectionItemClass); destructor Destroy ;
function AddConfig (SectionName : WideString = ''; ServerName : WideString = ''; DatabaseName : WideString = ''; UserName : WideString = ''; UserPWD : WideString = ''): TConfigSection;
property Items ; property Item[i: Integer] : TConfigSection read GetItem write SetItem; default; published end;
//--------------------------------------------------------------------------- TConfigBase = class(TObject) private FApp0Dummy : WideString ;
FAppAutor : WideString ; FAppTitle : WideString ; FAppComment : WideString ; public constructor Create (AOwner: TComponent); destructor Destroy ;
published property app0Dummy : WideString read FApp0Dummy write FApp0Dummy ;
property appAutor : WideString read FAppAutor write FAppAutor ; property appTitle : WideString read FAppTitle write FAppTitle ; property appComment : WideString read FAppComment write FAppComment ; end;
//--------------------------------------------------------------------------- TConfigXML = class(TControl) private { Private-Deklarationen } FConfigBase : TConfigBase ; FConfigSections : TConfigSections; protected { Protected-Deklarationen } public { Public-Deklarationen } propNames : TStringList;
FileNameXML : WideString; StreamXML : TStringStream;
FileNamePWD : WideString; StreamPWD : TStringStream;
Password : String ; UseEncryption : Boolean ;
constructor Create (AOwner: TComponent); override; destructor Destroy ; override;
procedure XMLLoadFromFile ; procedure XMLDecrypt ; procedure XMLToProperties ;
procedure XMLFromProperties ; procedure XMLEncrypt ; procedure XMLSaveToFile ;
published { Published-Deklarationen } property ConfigBase : TConfigBase read FConfigBase write FConfigBase ; property ConfigSections : TConfigSections read FConfigSections write FConfigSections; end;
TomsoConfigAppForm = class(TomsoBaseDialogForm) propi : TLMDSimplePropInspector;
procedure FormCreate (Sender: TObject); procedure FormShow (Sender: TObject); procedure FormClose (Sender: TObject; var Action: TCloseAction); procedure FormDestroy (Sender: TObject); private { Private-Deklarationen } public { Public-Deklarationen } end;
var configXML : TConfigXML;
implementation
{$R *.dfm}
//----------------------------------------------------------------------------- //----------------------------------------------------------------------------- // Klasse TConfigSection //----------------------------------------------------------------------------- //----------------------------------------------------------------------------- procedure TConfigSection.Assign(Source: TPersistent); begin if Source is TConfigSection then begin FSectionName := TConfigSection(Source).FSectionName; FServerName := TConfigSection(Source).FServerName; FDatabaseName := TConfigSection(Source).FDatabaseName; FUserName := TConfigSection(Source).FUserName; FUserPWD := TConfigSection(Source).FUserPWD; end else begin inherited Assign(Source); end; end;
//----------------------------------------------------------------------------- //----------------------------------------------------------------------------- // Klasse TConfigSections //----------------------------------------------------------------------------- //----------------------------------------------------------------------------- constructor TConfigSections.Create(AOwner: TComponent; AItemClass: TCollectionItemClass); begin inherited Create(AOwner, AItemClass); end;
//----------------------------------------------------------------------------- destructor TConfigSections.Destroy; begin inherited Destroy; end;
//----------------------------------------------------------------------------- function TConfigSections.GetItem(Value: Integer): TConfigSection; begin Result := TConfigSection(Items[Value]); end;
//----------------------------------------------------------------------------- procedure TConfigSections.SetItem(Value: Integer; xConfig: TConfigSection); begin TConfigSection(Items[Value]).Assign(xConfig); end;
//----------------------------------------------------------------------------- function TConfigSections.AddConfig(SectionName : WideString; ServerName : WideString; DatabaseName : WideString; UserName : WideString; UserPWD : WideString): TConfigSection; begin Result := TConfigSection(Add);
Result.SectionName := SectionName ; Result.ServerName := ServerName ; Result.DatabaseName := DatabaseName; Result.UserName := UserName ; Result.UserPWD := UserPWD ; end;
//----------------------------------------------------------------------------- //----------------------------------------------------------------------------- // Klasse TConfigBase //----------------------------------------------------------------------------- //----------------------------------------------------------------------------- constructor TConfigBase.Create(AOwner: TComponent); begin inherited Create;
FAppAutor := '1'; FAppTitle := '2'; FAppComment := '3'; end;
//----------------------------------------------------------------------------- destructor TConfigBase.Destroy; begin inherited Destroy; end;
//----------------------------------------------------------------------------- //----------------------------------------------------------------------------- // Klasse TConfigXML //----------------------------------------------------------------------------- //----------------------------------------------------------------------------- constructor TConfigXML.Create(AOwner: TComponent); begin inherited Create(AOwner);
Password := '190202' ; UseEncryption := True ;
propNames := TStringList.Create ;
FileNameXML := 'omsoConfig.xml' ; StreamXML := TStringStream.Create;
FileNamePWD := 'omsoConfig.config' ; StreamPWD := TStringStream.Create;
FConfigBase := TConfigBase.Create (self); propnames.Add('ConfigBase' ); propnames.Add('AppAutor' ); propnames.Add('AppTitle' ); propnames.Add('AppComment' );
FConfigSections := TConfigSections.Create (self, TConfigSection); propnames.Add('ConfigSections' ); propnames.Add('SectionName' ); propnames.Add('ServerName' ); propnames.Add('DatabaseName' ); propnames.Add('UserName' ); propnames.Add('UserPWD' ); end;
//----------------------------------------------------------------------------- destructor TConfigXML.Destroy; begin FreeAndNil(propNames );
FreeAndNil(StreamXML ); FreeAndNil(StreamPWD );
FreeAndNil(FConfigSections ); FreeAndNil(FConfigBase ); inherited; end;
//----------------------------------------------------------------------------- //----------------------------------------------------------------------------- // Public Proceduren der Klasse TConfigXML //----------------------------------------------------------------------------- //----------------------------------------------------------------------------- procedure TConfigXML.XMLLoadFromFile; var fileStream : TFileStream; begin try fileStream := TFileStream.Create(FileNamePWD, fmOpenRead); StreamPWD.CopyFrom (fileStream, 0); fileStream.Free; except end; end;
//----------------------------------------------------------------------------- procedure TConfigXML.XMLDecrypt; var xCipher : TDCP_Blowfish; begin //--------------------------------------------------------------------------- // Unverschlüsselter String gefunden! //--------------------------------------------------------------------------- if Pos('<?xml version="1.0"', StreamPWD.DataString) > 0 then begin StreamXML.CopyFrom(StreamPWD, 0); Exit; end;
//--------------------------------------------------------------------------- // Keine Verschlüsselung gewünscht //--------------------------------------------------------------------------- if not UseEncryption then begin StreamXML.CopyFrom(StreamPWD, 0); Exit; end;
try StreamXML.Clear; StreamPWD.Position := 0;
xCipher := TDCP_Blowfish.Create(Self); xCipher.InitStr(Password, TDCP_MD5); xCipher.DecryptStream(StreamPWD, StreamXML, StreamPWD.Size); xCipher.Burn; xCipher.Free; except end; end;
//----------------------------------------------------------------------------- procedure TConfigXML.XMLToProperties; var sPath : String ; xDocBase : IXMLNode;
//--------------------------------------------------------------------------- function _IsProperty(xObject: TObject; sSuchName: WideString): Boolean; var TempList : PPropList ; iPropCount : Integer ; i,j : Integer ; sPropName : WideString; begin Result := False;
iPropCount := GetPropList(xObject.ClassInfo, [tkUnknown , tkInteger, tkChar , tkEnumeration, tkFloat, tkString , tkSet , tkClass , tkMethod , tkWChar, tkLString , tkWString, tkVariant, tkArray , tkRecord, tkInterface, tkInt64 , tkDynArray], nil);
GetMem(TempList, iPropCount * SizeOf(Pointer));
GetPropList(xObject.ClassInfo, [tkUnknown , tkInteger, tkChar , tkEnumeration, tkFloat, tkString , tkSet , tkClass , tkMethod , tkWChar, tkLString , tkWString, tkVariant, tkArray , tkRecord, tkInterface, tkInt64 , tkDynArray], TempList);
for i := 0 to iPropCount - 1 do begin sPropName := TempList[i]^.Name; Result := (sPropName = sSuchName); if Result then begin Break; end; end;
FreeMem(TempList); end;
//--------------------------------------------------------------------------- procedure _loadProperties(xObject: TObject; xDocBase: IXMLNode); var xNode : IXMLNode ;
TempList : PPropList ; iPropCount : Integer ; i,j,k : Integer ;
sPropName : WideString; sValue : WideString; AClass : TClass ; AObj : TObject ;
iIndex : Integer ;
xNodeSecS : IXMLNode ; xNodeSec : IXMLNode ;
sNodeSecS : WideString; sNodeSec : WideString;
xSecS : TConfigSection; begin iPropCount := GetPropList(xObject.ClassInfo, [tkUnknown , tkInteger, tkChar , tkEnumeration, tkFloat, tkString , tkSet , tkClass , tkMethod , tkWChar, tkLString , tkWString, tkVariant, tkArray , tkRecord, tkInterface, tkInt64 , tkDynArray], nil);
GetMem(TempList, iPropCount * SizeOf(Pointer));
GetPropList(xObject.ClassInfo, [tkUnknown , tkInteger, tkChar , tkEnumeration, tkFloat, tkString , tkSet , tkClass , tkMethod , tkWChar, tkLString , tkWString, tkVariant, tkArray , tkRecord, tkInterface, tkInt64 , tkDynArray], TempList);
for i := 0 to iPropCount - 1 do begin sPropName := TempList[i]^.Name; sValue := '';
iIndex := configXML.propNames.IndexOf(sPropName); if iIndex = -1 then begin Continue; end;
case PropType(xObject, sPropName) of tkClass : begin AClass := GetObjectPropClass(xObject, TempList[i]); AObj := GetObjectProp (xObject, TempList[i], AClass); if Assigned(AObj) then begin if AOBj is TConfigSections then begin sPath := sPath + sPropName + '/';
xNode := XMLGetNodeFromNode(xDocBase, sPath); if Assigned(xNode) then begin if xNode.HasChildNodes then begin TConfigSections(AObj).Clear;
for j := 0 to xNode.ChildNodes.Count -1 do begin xNodeSecS := xNode.ChildNodes.Nodes[j]; sNodeSecS := xNodeSecS.LocalName;
if xNodeSecS.HasChildNodes then begin xSecS := TConfigSections(AObj).AddConfig(sNodeSecS); for k := 0 to xNodeSecS.ChildNodes.Count -1 do begin xNodeSec := xNodeSecS.ChildNodes.Nodes[k]; sNodeSec := xNodeSec.LocalName; SetPropValue(xSecS, sNodeSec, xNodeSec.Text); end;
end; end; end; end;
end else begin sPath := sPath + sPropName + '/'; _loadProperties(AObj, xDocBase); sPath := StrTran(sPath, sPropName + '/', ''); end; end; end; else begin xNode := XMLGetNodeFromNode(xDocBase, sPath + sPropName); if Assigned(xNode) then begin sValue := xNode.Text; end; end; end;
if sValue <> '' then begin SetPropValue(xObject, TempList[i]^.Name, sValue); end; end;
FreeMem(TempList); end;
begin sPath := '';
xDocBase := XMLGetDocFromStream(StreamXML); _loadProperties(self, xDocBase); end;
//----------------------------------------------------------------------------- procedure TConfigXML.XMLFromProperties; var slXML : TStringList ; iLevel : Integer ;
//--------------------------------------------------------------------------- function Tab(iAnzahl: Integer): string; var i: Integer; begin Result := ''; for i := 0 to iAnzahl do begin Result := Result + #9; end; end;
//--------------------------------------------------------------------------- procedure _saveProperties(xObject: TObject); var TempList : PPropList ; iPropCount : Integer ; i, j : Integer ; sSpace : String ;
sPropName : WideString; sValue : WideString; AClass : TClass ; AObj : TObject ;
iIndex : Integer ;
sPropSec : WideString; iLevelSec : Integer ; sSpaceSec : WideString; begin iPropCount := GetPropList(xObject.ClassInfo, [tkUnknown , tkInteger, tkChar , tkEnumeration, tkFloat, tkString , tkSet , tkClass , tkMethod , tkWChar, tkLString , tkWString, tkVariant, tkArray , tkRecord, tkInterface, tkInt64 , tkDynArray], nil);
GetMem(TempList, iPropCount * SizeOf(Pointer));
GetPropList(xObject.ClassInfo, [tkUnknown , tkInteger, tkChar , tkEnumeration, tkFloat, tkString , tkSet , tkClass , tkMethod , tkWChar, tkLString , tkWString, tkVariant, tkArray , tkRecord, tkInterface, tkInt64 , tkDynArray], TempList);
sSpace := Tab(iLevel);
for i := 0 to iPropCount - 1 do begin sPropName := TempList[i]^.Name; sValue := '';
iIndex := configXML.propNames.IndexOf(sPropName); if iIndex = -1 then begin Continue; end;
case PropType(xObject, sPropName) of tkClass : begin AClass := GetObjectPropClass(xObject, TempList[i]); AObj := GetObjectProp (xObject, TempList[i], AClass);
if Assigned(AObj) then begin slXML.Add(sSpace + '<' + sPropName + '>');
if AOBj is TConfigSections then begin for j := 0 to TConfigSections(AObj).Count - 1 do begin iLevelSec := iLevel + 1; sSpaceSec := Tab(iLevelSec);
sPropSec := TConfigSection(TConfigSections(AObj).Items[j]).FSectionName; slXML.Add(sSpaceSec + '<' + sPropSec + '>');
Inc(iLevel, 2); _saveProperties(TConfigSections(AObj).Items[j]); Dec(iLevel, 2);
slXML.Add(sSpaceSec + '</' + sPropSec + '>'); end;
end else begin Inc(iLevel); _saveProperties(AObj); Dec(iLevel); end;
slXML.Add(sSpace + '</' + sPropName + '>');
end; end; else sValue := GetPropValue(xObject, TempList[i]^.Name, True); end;
if sValue <> '' then begin slXML.Add(sSpace + '<' + sPropName + '>' + sValue + '</' + sPropName + '>'); end; end;
FreeMem(TempList); end;
begin iLevel := 0; slXML := TStringList.Create;
slXML.Add('<?xml version="1.0" encoding="UTF-8"?>'); slXML.Add('<ConfigItems>'); _saveProperties(self); slXML.Add('</ConfigItems>');
StreamXML.Clear; slXML.SaveToStream(StreamXML, TEncoding.UTF8);
FreeAndNil(slXML ); end;
//----------------------------------------------------------------------------- procedure TConfigXML.XMLEncrypt; var xCipher : TDCP_Blowfish; begin //--------------------------------------------------------------------------- // Keine Verschlüsselung gewünscht //--------------------------------------------------------------------------- if not UseEncryption then begin StreamPWD.CopyFrom(StreamXML, 0); Exit; end;
try StreamPWD.Clear; StreamXML.Position := 0;
xCipher := TDCP_Blowfish.Create(Self); xCipher.InitStr(Password, TDCP_MD5); xCipher.EncryptStream(StreamXML, StreamPWD, StreamXML.Size); xCipher.Burn; xCipher.Free; except end; end;
//----------------------------------------------------------------------------- procedure TConfigXML.XMLSaveToFile; var fileStream : TFileStream; begin try FileMove (FileNamePWD, FileNamePWD + '.bak'); fileStream := TFileStream.Create(FileNamePWD, fmCreate ); fileStream.CopyFrom (StreamPWD, 0); fileStream.Free;
if UseEncryption then begin FileMove (FileNameXML, FileNameXML + '.bak'); fileStream := TFileStream.Create(FileNameXML, fmCreate ); fileStream.CopyFrom (StreamXML, 0); fileStream.Free; end; except end; end;
//----------------------------------------------------------------------------- procedure TomsoConfigAppForm.FormCreate(Sender: TObject); begin inherited; // end;
//----------------------------------------------------------------------------- procedure TomsoConfigAppForm.FormShow(Sender: TObject); begin inherited; configXML := TConfigXML.Create(self); configXML.ConfigSections.AddConfig('Config1', 'Server', 'Database', 'Username', 'UserPWD'); configXML.ConfigSections.AddConfig('Config2', 'Server', 'Database', 'Username', 'UserPWD'); configXML.ConfigSections.AddConfig('Config3', 'Server', 'Database', 'Username', 'UserPWD'); configXML.ConfigSections.AddConfig('Config4', 'Server', 'Database', 'Username', 'UserPWD');
propi.Objects.Clear; propi.Objects.SetOne(configxml); end;
//----------------------------------------------------------------------------- procedure TomsoConfigAppForm.FormClose(Sender: TObject; var Action: TCloseAction); begin inherited; // end;
//----------------------------------------------------------------------------- procedure TomsoConfigAppForm.FormDestroy(Sender: TObject); begin inherited; configXML.Free; end;
end.