2Pascal-新时代的Pascal

 找回密码
 立即注册
搜索
热搜: fastreport
查看: 1386|回复: 3
打印 上一主题 下一主题

XE8 安卓下如何保存程序的参数?

[复制链接]

1

主题

5

帖子

51

积分

注册会员

Rank: 2

积分
51
楼主
发表于 2015-6-8 13:58:01 | 显示全部楼层
京东购书支持本站
动状态读取
IniRec4Rtti.pas
[mw_shl_code=delphi,true]unit IniRec4Rtti;

interface
uses SysUtils,Classes, Rtti,TypInfo;

type
  IniValueAttribute = class(TCustomAttribute)
  private
    FName: string;
    FDefaultValue: string;
    FSection: string;
  published
     constructor Create(const aSection : String;const aName : string;const aDefaultValue : String = '');
     property Section : string read FSection write FSection;
     property Name : string read FName write FName;
     property DefaultValue : string read FDefaultValue write FDefaultValue;
  end;

  EIniRec4Rtti = class(Exception);

  TIniRec4Rtti = class (TObject)
  private
    class procedure SetValue(aData : String;var aValue : TValue);
    class function GetValue(var aValue : TValue) : String;
    class function GetIniAttribute(Obj : TRttiObject) : IniValueAttribute;
  public
    class procedure Load(FileName : String;RecPtr,TypPtr : Pointer);
    class procedure Save(FileName : String;RecPtr,TypPtr : Pointer);
  end;
implementation
uses IniFiles;

{ IniValueAttribute }

constructor IniValueAttribute.Create(const aSection, aName,
  aDefaultValue: String);
begin
  FSection := aSection;
  FName := aName;
  FDefaultValue := aDefaultValue;
end;

{ TIniRec4Rtti }

class function TIniRec4Rtti.GetIniAttribute(
  Obj: TRttiObject): IniValueAttribute;
var
Attr: TCustomAttribute;
begin
for Attr in Obj.GetAttributes do
begin
    if Attr is IniValueAttribute then
    begin
      exit(IniValueAttribute(Attr));
    end;
end;
result := nil;
end;

class function TIniRec4Rtti.GetValue(var aValue: TValue): String;
begin
   if aValue.Kind in [tkWChar, tkLString, tkWString, tkString, tkChar,
                    tkUString, tkInteger, tkInt64, tkFloat, tkEnumeration,
                    tkSet]  then
   result := aValue.ToString
   else raise EIniRec4Rtti.Create('Type not Supported');
end;

class procedure TIniRec4Rtti.Load(FileName: String;RecPtr, TypPtr: Pointer);
var
ctx : TRttiContext;
RT : TRttiType;
RF  : TRttiField;
Value : TValue;
IniValue : IniValueAttribute;
Ini : TIniFile;
Data : String;
begin
   ctx := TRttiContext.Create;
   try
     Ini := TIniFile.Create(FileName);
     try
       RT := ctx.GetType( TypPtr );
       if not  Assigned(RT) or
         (Assigned(RT) and not RT.IsRecord ) then
         Exit;

       for RF in RT.AsRecord.GetFields do
       begin
         IniValue := GetIniAttribute(RF);
         if Assigned(IniValue) then
         begin
            Data := Ini.ReadString(IniValue.Section,IniValue.Name,IniValue.DefaultValue);
            Value := RF.GetValue(RecPtr);
            SetValue(Data,Value);
            RF.SetValue(RecPtr,Value);
         end;
       end;
     finally
       Ini.Free;
     end;
   finally
     ctx.Free;
   end;
end;


class procedure TIniRec4Rtti.Save(FileName : String;RecPtr,TypPtr : Pointer);
var
ctx : TRttiContext;
RT : TRttiType;
RF : TRttiField;
Value : TValue;
IniValue : IniValueAttribute;
Ini : TIniFile;
Data : String;
begin
ctx := TRttiContext.Create;
try
   Ini := TIniFile.Create(FileName);
   try
     RT := ctx.GetType(TypPtr);
     if not  Assigned(RT) or
         (Assigned(RT) and not RT.IsRecord ) then
         Exit;

     for RF in RT.AsRecord.GetFields do
     begin
       IniValue := GetIniAttribute(RF);
       if Assigned(IniValue) then
       begin
          Value := RF.GetValue(RecPtr);
          Data := GetValue(Value);
          Ini.WriteString(IniValue.Section,IniValue.Name,Data);
       end;
     end;
   finally
     Ini.Free;
   end;
finally
   ctx.Free;
end;
end;

class procedure TIniRec4Rtti.SetValue(aData: String; var aValue: TValue);
var
I : Integer;
begin
case aValue.Kind of
   tkWChar,
   tkLString,
   tkWString,
   tkString,
   tkChar,
   tkUString : aValue := aData;
   tkInteger,
   tkInt64  : aValue := StrToInt64Def(aData,0);
   tkFloat  : aValue := StrToFloatDef(aData,0.00);
   tkEnumeration:  aValue := TValue.FromOrdinal(aValue.TypeInfo,GetEnumValue(aValue.TypeInfo,aData));
   tkSet: begin
             i :=  StringToSet(aValue.TypeInfo,aData);
             TValue.Make(@i, aValue.TypeInfo, aValue);
          end;
   else raise EIniRec4Rtti.Create('Type not Supported');
end;
end;

end.[/mw_shl_code]

参数文件
[mw_shl_code=delphi,true]unit uConfigClass;

interface
uses
   IniRec4Rtti, SysUtils,Classes,System.Variants,System.IOUtils, System.IniFiles;
type

  TSetupInfo = record
    [IniValue('User','Username','')]
    Username:string;
    [IniValue('User','Password','')]
    Password:string;

   procedure Load;
   procedure Save;
  end;

implementation

{ TRemoteInfo }

procedure TSetupInfo.Load;
var
  IniFile:TIniFile;
  FilePath:string;
begin
  FilePath:=IncludeTrailingPathDelimiter(TPath.GetDocumentsPath)+'Config.ini';

  if not FileExists(FilePath) then
  begin
    try
      IniFile := TIniFile.Create(FilePath);
    finally
      IniFile.Free;
    end;
  end;

  TIniRec4Rtti.Load(IncludeTrailingPathDelimiter(TPath.GetDocumentsPath)+'Config.ini',@Self,TypeInfo(TSetupInfo));
end;

procedure TSetupInfo.Save;
begin
  TIniRec4Rtti.Save(IncludeTrailingPathDelimiter(TPath.GetDocumentsPath)+'Config.ini',@Self,TypeInfo(TSetupInfo));
end;

end.[/mw_shl_code]

然后可以这么调用
SetupInfo: TSetupInfo;

读SetupInfo.UserName
写时赋值给SetupInfo.UserName,然后SetupInfo.Save;
回复 支持 反对

使用道具 举报

您需要登录后才可以回帖 登录 | 立即注册

本版积分规则

QQ|Archiver|手机版|小黑屋|新时代Pascal论坛

GMT+8, 2024-5-21 01:27 , Processed in 0.058481 second(s), 22 queries .

Powered by Discuz! X3

© 2001-2013 Comsenz Inc.

快速回复 返回顶部 返回列表