cxstorage.pas

来自「胜天进销存源码,国产优秀的进销存」· PAS 代码 · 共 2,215 行 · 第 1/5 页

procedure TcxRegistryWriter.EndWriteObject(const AObjectName, AClassName: string);
var
  AName: string;
  AParents: TStringList;
  ANewKey: string;
  I: Integer;
begin
  FRegistry.CloseKey;

  AParents := TStringList.Create;
  try
    ExtractObjectFullName(AObjectName, AParents, AName);
    ANewKey := GenRegistryPath(FStorageName);
    for I := 0 to AParents.Count - 1 do
      ANewKey := ANewKey + '\' + AParents[I];
    FRegistry.OpenKey(ANewKey, False);
  finally
    AParents.Free;
  end;
end;

procedure TcxRegistryWriter.WriteProperty(const AObjectName, AClassName, AName: string; AValue: Variant);
begin                                             
  case VarType(AValue) of
    // CLR: varDecimal TODO
  {$IFDEF DELPHI6}
    varInt64, varLongWord, varWord, varShortInt,
  {$ENDIF}
    varInteger, varSmallInt, varByte:
      FRegistry.WriteInteger(AName, AValue);
    varSingle, varDouble:
      FRegistry.WriteFloat(AName, AValue);
    varCurrency:
      FRegistry.WriteCurrency(AName, AValue);
    varString, varOleStr:
      FRegistry.WriteString(AName, CorrectStringValue(AValue));
    varDate:
      FRegistry.WriteDateTime(AName, AValue);
    varBoolean:
      FRegistry.WriteBool(AName, AValue);
  end;
end;

procedure TcxRegistryWriter.CreateRootKey;
begin
  if not FRootKeyCreated then
  begin
    if not FRegistry.CreateKey(GenRegistryPath(FStorageName)) then
      raise ERegistryException.CreateFmt(cxGetResourceString(@scxCantCreateRegistryKey), [FStorageName]);
    FRootKeyCreated := True;
  end;

  if not FRootKeyOpened then
  begin
    if not FRegistry.OpenKey(GenRegistryPath(FStorageName), False) then
      raise ERegistryException.CreateFmt(cxGetResourceString(@scxCantOpenRegistryKey), [FStorageName]);

    FRootKeyOpened := True;
  end;
end;

{ TcxIniFileReader }

constructor TcxIniFileReader.Create(const AStorageName: string);
//var
//  AFileName: string;
begin
  inherited Create(AStorageName);

//  AFileName := ChangeFileExt(AStorageName, '.ini');
  FIniFile := TMemIniFile.Create(AStorageName);
  FPathList := nil;
  FObjectNameList := nil;
  FClassNameList := nil;
end;

destructor TcxIniFileReader.Destroy;
begin
  FIniFile.Free;
  FPathList.Free;
  FObjectNameList.Free;
  FClassNameList.Free;

  inherited Destroy;
end;

procedure TcxIniFileReader.ReadChildren(const AObjectName, AClassName: string;
  AChildrenNames, AChildrenClassNames: TStrings);
var
  I: Integer;
  AParentPath: string;
begin
  CreateLists;

  if AObjectName <> '' then
    AParentPath := UpperCase(AObjectName) + '/'
  else
    AParentPath := UpperCase(AObjectName);

  for I := 0 to FPathList.Count - 1 do
  begin
    if FPathList[I] = AParentPath then
    begin
      AChildrenNames.Add(FObjectNameList[I]);
      AChildrenClassNames.Add(FClassNameList[I]);
    end;
  end;
end;

procedure TcxIniFileReader.ReadProperties(const AObjectName, AClassName: string; AProperties: TStrings);
var
  ASectionName: string;
begin
  ASectionName := AObjectName + ': ' + AClassName;
  FIniFile.ReadSection(ASectionName, AProperties);
end;

function TcxIniFileReader.ReadProperty(const AObjectName, AClassName, AName: string): Variant;
var
  ASectionName: string;
  AValue: string;
  AIntegerValue: Integer;
  ARealValue: Double;
  ACode: Integer;
begin
  ASectionName := AObjectName + ': ' + AClassName;
  AValue := FIniFile.ReadString(ASectionName, AName, '');

  if IsStringValue(AValue) then
  begin
    Result := AValue;
    Exit;
  end;

  Val(AValue, AIntegerValue, ACode);
  if ACode = 0 then
    Result := AIntegerValue
  else
  begin
    Val(AValue, ARealValue, ACode);
    if ACode = 0 then
      Result := ARealValue
    else
      Result := DateTimeOrStr(AValue);
  end;
end;

procedure TcxIniFileReader.CreateLists;
var
  ASectionList: TStringList;
  I: Integer;
  APath: string;
  AObjectName: string;
  AClassName: string;
begin
  if (FPathList = nil) or (FObjectNameList = nil) or (FClassNameList = nil) then
  begin
    FPathList := TStringList.Create;
    FObjectNameList := TStringList.Create;
    FClassNameList := TStringList.Create;
    ASectionList := TStringList.Create;
    try
      FIniFile.ReadSections(ASectionList);
      for I := 0 to ASectionList.Count - 1 do
      begin
        GetSectionDetail(ASectionList[I], APath, AObjectName, AClassName);
        FPathList.Add(UpperCase(APath));
        FObjectNameList.Add(AObjectName);
        FClassNameList.Add(AClassName);
      end;
    finally
      ASectionList.Free;
    end;
  end;
end;

procedure TcxIniFileReader.GetSectionDetail(const ASection: string; var APath, AObjectName, AClassName: string);
var
  I: Integer;
  AName: string;
begin
  AName := '';
  APath := '';
  AObjectName := '';
  AClassName := '';

  for I := 1 to Length(ASection) do
    if ASection[I] = '/' then
    begin
      APath := APath + AName + '/';
      AName := '';
    end
    else
      if ASection[I] = ':' then
      begin
        AObjectName := AName;
        AName := '';
      end
      else
        AName := AName + ASection[I];
  AClassName := Trim(AName);
end;

{ TcxIniFileWriter }

constructor TcxIniFileWriter.Create(const AStorageName: string; AReCreate: Boolean);
//var
//  AFileName: string;
begin
  inherited Create(AStorageName, AReCreate);

//  AFileName := ChangeFileExt(AStorageName, '.ini');
  FIniFile := TMemIniFile.Create(AStorageName);

  if FReCreate then
    FIniFile.Clear;

  {$IFDEF DELPHI6}
    FIniFile.CaseSensitive := False;
  {$ENDIF}
end;

destructor TcxIniFileWriter.Destroy;
begin
  FIniFile.UpdateFile;
  FIniFile.Free;

  inherited Destroy;
end;

procedure TcxIniFileWriter.BeginWriteObject(const AObjectName, AClassName: string);
begin
  FIniFile.WriteString(AObjectName + ': ' + AClassName, '', '');
end;

procedure TcxIniFileWriter.WriteProperty(const AObjectName, AClassName, AName: string;
  AValue: Variant);
var
  ASectionName: string;
begin
  ASectionName := AObjectName + ': ' + AClassName;
  case VarType(AValue) of
    // CLR: varDecimal TODO
    varSmallInt, varInteger, varByte
    {$IFDEF DELPHI6}, varShortInt, varWord, varLongWord, varInt64{$ENDIF}
    :
        FIniFile.WriteInteger(ASectionName, AName, AValue);
    varSingle, varDouble, varCurrency:
      FIniFile.WriteFloat(ASectionName, AName, AValue);
    varString
    , varOleStr:
      FIniFile.WriteString(ASectionName, AName, CorrectStringValue(AValue));
    varDate
    :
      FIniFile.WriteDateTime(ASectionName, AName, AValue);
  end;
end;

{ TcxStreamPropertyData }

constructor TcxStreamPropertyData.Create(AName: string; AValue: Variant);
begin
  inherited Create;
  FName := AName;
  FValue := AValue;
end;

procedure TcxStreamPropertyData.Read(AReader: TReader);
begin
  with AReader do
    FName := ReadString;
  ReadValue(AReader);
end;

procedure TcxStreamPropertyData.Write(AWriter: TWriter);
begin
  with AWriter do
    WriteString(FName);
  WriteValue(AWriter);
end;

procedure TcxStreamPropertyData.ReadValue(AReader: TReader);
var
  AStreamType: Integer;
begin
  AStreamType := AReader.ReadInteger;
  case AStreamType of
    cxStreamBoolean:
      FValue := AReader.ReadBoolean;
    cxStreamChar:
      FValue := Byte(AReader.ReadChar);
    cxStreamCurrency:
      FValue := AReader.ReadCurrency;
    cxStreamDate:
      FValue := AReader.ReadDate;
    cxStreamFloat:
      FValue := AReader.ReadFloat;
    cxStreamInteger:
      FValue := AReader.ReadInteger;
    cxStreamSingle:
      FValue := AReader.ReadSingle;
    cxStreamString:
      FValue := AReader.ReadString;
    cxStreamWideString:
      FValue := AReader.ReadWideString;
  end;
end;

procedure TcxStreamPropertyData.WriteValue(AWriter: TWriter);
begin
  // CLR: varChar, varDateTime, varDecimal TODO
  case VarType(FValue) of
    varSmallInt, varInteger
    {$IFDEF DELPHI6}, varShortInt, varWord, varLongWord, varInt64{$ENDIF}
    :
      begin
        AWriter.WriteInteger(cxStreamInteger);
        AWriter.WriteInteger(FValue);
      end;
    varSingle:
      begin
        AWriter.WriteInteger(cxStreamSingle);
        AWriter.WriteSingle(FValue);
      end;
    varDouble:
      begin
        AWriter.WriteInteger(cxStreamFloat);
        AWriter.WriteFloat(FValue);
      end;
    varCurrency:
      begin
        AWriter.WriteInteger(cxStreamCurrency);
        AWriter.WriteCurrency(FValue);
      end;
    varDate:
      begin
        AWriter.WriteInteger(cxStreamDate);
        AWriter.WriteDate(FValue);
      end;
    varOleStr:
      begin
        AWriter.WriteInteger(cxStreamWideString);
        AWriter.WriteWideString(FValue);
      end;
    varBoolean:
      begin
        AWriter.WriteInteger(cxStreamBoolean);
        AWriter.WriteBoolean(FValue);
      end;
    varByte:
      begin
        AWriter.WriteInteger(cxStreamChar);
        AWriter.WriteChar(Char(Byte(FValue)));
      end;
    varString:
      begin
        AWriter.WriteInteger(cxStreamString);
        AWriter.WriteString(FValue);
      end;
  end;
end;

{ TcxStreamObjectData }

constructor TcxStreamObjectData.Create(const AName, AClassName: string);
begin
  inherited Create;
  FName := AName;
  FClassName := AClassName;
  FChildren := TList.Create;
  FProperties := TList.Create;
end;

destructor TcxStreamObjectData.Destroy;
begin
  Clear;
  FChildren.Free;
  FProperties.Free;

  inherited Destroy;
end;

procedure TcxStreamObjectData.Clear;
var
  I: Integer;
begin
  for I := 0 to FProperties.Count - 1 do
    TcxStreamPropertyData(FProperties[I]).Free;
  FProperties.Clear;

  for I := 0 to FChildren.Count - 1 do
    TcxStreamObjectData(FChildren[I]).Free;
  FChildren.Clear;
end;

procedure TcxStreamObjectData.AddChild(AChild: TcxStreamObjectData);
begin
  FChildren.Add(AChild);
end;

procedure TcxStreamObjectData.AddProperty(AProperty: TcxStreamPropertyData);
begin
  FProperties.Add(AProperty);
end;

procedure TcxStreamObjectData.Read(AReader: TReader);
var
  ACount: Integer;
  I: Integer;
begin
  with AReader do
  begin
    FName := ReadString;
    FClassName := ReadString;
    ACount := ReadInteger;
    for I := 0 to ACount - 1 do
    begin
      AddProperty(TcxStreamPropertyData.Create('', Null));
      TcxStreamPropertyData(FProperties.Last).Read(AReader);
    end;
    ACount := ReadInteger;
    for I := 0 to ACount - 1 do
    begin
      AddChild(TcxStreamObjectData.Create('', ''));
      TcxStreamObjectData(FChildren.Last).Read(AReader);
    end;
  end;
end;

procedure TcxStreamObjectData.Write(AWriter: TWriter);
var
  I: Integer;
begin
  with AWriter do
  begin
    WriteString(FName);
    WriteString(FClassName);
    WriteInteger(PropertyCount);
    for I := 0 to PropertyCount - 1 do
      Properties[I].Write(AWriter);
    WriteInteger(ChildCount);
    for I := 0 to ChildCount - 1 do
      Chil