Componentes.Terceros.DevExp.../official/x.42/ExpressWeb Framework/Sources/cxWebVariants.pas
2009-02-27 12:02:10 +00:00

256 lines
7.3 KiB
ObjectPascal

{*******************************************************************}
{ }
{ ExpressWeb Framework by Developer Express }
{ Named Variants Storage }
{ }
{ Copyright (c) 2000-2009 Developer Express Inc. }
{ ALL RIGHTS RESERVED }
{ }
{ The entire contents of this file is protected by U.S. and }
{ International Copyright Laws. Unauthorized reproduction, }
{ reverse-engineering, and distribution of all or any portion of }
{ the code contained in this file is strictly prohibited and may }
{ result in severe civil and criminal penalties and will be }
{ prosecuted to the maximum extent possible under the law. }
{ }
{ RESTRICTIONS }
{ }
{ THIS SOURCE CODE AND ALL RESULTING INTERMEDIATE FILES }
{ (DCU, OBJ, DLL, ETC.) ARE CONFIDENTIAL AND PROPRIETARY TRADE }
{ SECRETS OF DEVELOPER EXPRESS INC. THE REGISTERED DEVELOPER IS }
{ LICENSED TO DISTRIBUTE THE EXPRESSWEB FRAMEWORK AND ALL }
{ ACCOMPANYING VCL CLASSES AS PART OF AN EXECUTABLE WEB }
{ APPLICATION ONLY. }
{ }
{ THE SOURCE CODE CONTAINED WITHIN THIS FILE AND ALL RELATED }
{ FILES OR ANY PORTION OF ITS CONTENTS SHALL AT NO TIME BE }
{ COPIED, TRANSFERRED, SOLD, DISTRIBUTED, OR OTHERWISE MADE }
{ AVAILABLE TO OTHER INDIVIDUALS WITHOUT EXPRESS WRITTEN CONSENT }
{ AND PERMISSION FROM DEVELOPER EXPRESS INC. }
{ }
{ CONSULT THE END USER LICENSE AGREEMENT FOR INFORMATION ON }
{ ADDITIONAL RESTRICTIONS. }
{ }
{*******************************************************************}
unit cxWebVariants;
interface
{$I cxVer.inc}
uses
Classes, SysUtils;
type
TcxWebNamedVariants = class(TPersistent)
private
FList: TList;
function GetName(Index: Integer): string;
function GetValue(const Name: string): Variant;
procedure SetValue(const Name: string; const Value: Variant);
function GetVariant(Index: Integer): Variant;
procedure PutVariant(Index: Integer; const Value: Variant);
protected
function GetCount: Integer;
function CompareStrings(const S1, S2: string): Integer; virtual;
public
constructor Create;
destructor Destroy; override;
function Add(const S: string; const AValue: Variant): Integer;
procedure Assign(Source: TPersistent); override;
procedure Clear;
procedure Delete(Index: Integer);
function IndexOfName(const Name: string): Integer;
procedure Insert(Index: Integer; const S: string; const AValue: Variant);
procedure LoadFromStream(Stream: TStream);
procedure SaveToStream(Stream: TStream);
property Count: Integer read GetCount;
property Names[Index: Integer]: string read GetName;
property Values[const Name: string]: Variant read GetValue write SetValue;
property Variants[Index: Integer]: Variant read GetVariant write PutVariant;
end;
implementation
uses Variants, cxVariants;
type
PcxWebNamedVariant = ^TcxWebNamedVariant;
TcxWebNamedVariant = record
FString: string;
FVariant: Variant;
end;
{ TcxWebNamedVariants }
constructor TcxWebNamedVariants.Create;
begin
inherited;
FList := TList.Create;
end;
destructor TcxWebNamedVariants.Destroy;
begin
Clear;
FList.Free;
inherited;
end;
function TcxWebNamedVariants.Add(const S: string;
const AValue: Variant): Integer;
begin
Result := GetCount;
Insert(Result, S, AValue);
end;
procedure TcxWebNamedVariants.Assign(Source: TPersistent);
var
I: Integer;
NamedVariants: TcxWebNamedVariants;
begin
if Source is TcxWebNamedVariants then
begin
Clear;
NamedVariants := TcxWebNamedVariants(Source);
for I := 0 to NamedVariants.Count - 1 do
Add(NamedVariants.Names[I], NamedVariants.Variants[I]);
end
else
inherited Assign(Source);
end;
procedure TcxWebNamedVariants.Clear;
var
I: Integer;
Item: PcxWebNamedVariant;
begin
for I := 0 to Count - 1 do
begin
Item := PcxWebNamedVariant(FList[I]);
Dispose(Item);
end;
FList.Clear;
end;
function TcxWebNamedVariants.CompareStrings(const S1, S2: string): Integer;
begin
Result := AnsiCompareText(S1, S2);
end;
procedure TcxWebNamedVariants.Delete(Index: Integer);
var
Item: PcxWebNamedVariant;
begin
Item := PcxWebNamedVariant(FList[Index]);
Dispose(Item);
FList.Delete(Index);
end;
function TcxWebNamedVariants.GetCount: Integer;
begin
Result := FList.Count;
end;
function TcxWebNamedVariants.GetName(Index: Integer): string;
begin
Result := PcxWebNamedVariant(FList[Index])^.FString
end;
function TcxWebNamedVariants.GetValue(const Name: string): Variant;
var
I: Integer;
begin
I := IndexOfName(Name);
if I >= 0 then
Result := Variants[I]
else
Result := Unassigned;
end;
function TcxWebNamedVariants.GetVariant(Index: Integer): Variant;
begin
Result := PcxWebNamedVariant(FList[Index])^.FVariant
end;
function TcxWebNamedVariants.IndexOfName(const Name: string): Integer;
var
I: Integer;
begin
Result := -1;
for I := 0 to Count - 1 do
if CompareStrings(Names[I], Name) = 0 then
begin
Result := I;
break;
end;
end;
procedure TcxWebNamedVariants.Insert(Index: Integer; const S: string;
const AValue: Variant);
var
Item: PcxWebNamedVariant;
begin
New(Item);
Item^.FString := S;
Item^.FVariant := AValue;
FList.Insert(Index, Item);
end;
procedure TcxWebNamedVariants.LoadFromStream(Stream: TStream);
var
I, L, Count: Integer;
S: string;
V: Variant;
begin
FList.Clear;
Stream.ReadBuffer(Count, SizeOf(Count));
for I := 0 to Count - 1 do
begin
Stream.ReadBuffer(L, SizeOf(L));
SetLength(S, L);
Stream.ReadBuffer(S[1], L);
ReadVariantProc(Stream, V);
Add(S, V);
end;
end;
procedure TcxWebNamedVariants.SaveToStream(Stream: TStream);
var
I, L: Integer;
S: string;
V: Variant;
begin
Stream.WriteBuffer(FList.Count, SizeOf(FList.Count));
for I := 0 to FList.Count - 1 do
begin
S := Names[I];
L := Length(S);
Stream.WriteBuffer(L, SizeOf(L));
Stream.WriteBuffer(S[1], L);
V := Variants[I];
WriteVariantProc(Stream, V);
end;
end;
procedure TcxWebNamedVariants.PutVariant(Index: Integer;
const Value: Variant);
begin
PcxWebNamedVariant(FList[Index])^.FVariant := Value;
end;
procedure TcxWebNamedVariants.SetValue(const Name: string;
const Value: Variant);
var
I: Integer;
begin
I := IndexOfName(Name);
if I < 0 then
Add(Name, Value)
else
PutVariant(I, Value);
end;
end.