stregini.pas

条码控件： 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode

              REG_DWORD     : Result := Double(LResult^);
            else
              Result := Default;
            end;
          end;
        finally
          FreeMem(LResult,ValSize);
        end;
      finally
        if (riRemoteKey = 0) then
          CloseRegKey(Key);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

{==========================================================================}

procedure TStRegIni.WriteDateTime(const ValueName : string; const Value : TDateTime);
  {-write a Delphi DateTime to Ini file or registry}
var
  ECode   : LongInt;
  Key     : HKey;
  SValue  : string;

begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    Str(Value,SValue);
    if (riType = riIniType) then begin
      if (NOT WriteIniData(ValueName,SValue)) then
        RaiseRegIniError(stscIniWriteFail);
    end else begin
      Key := OpenRegKey;
      try
        ECode := WriteRegData(Key,ValueName,@Value,REG_BINARY,SizeOf(TDateTime));
        if (ECode <> ERROR_SUCCESS) then
          RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
      finally
        if (riRemoteKey = 0) then
          CloseRegKey(Key);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

{==========================================================================}

function TStRegIni.ReadDateTime(const ValueName : string; const Default : TDateTime) : TDateTime;
  {-read a Delphi DateTime from the Ini file or registry}
var
  SDefault,
  Value      : string;

  ECode,
  Key        : HKey;
  Len        : LongInt;
  ValSize    : LongInt;
  ValType    : DWORD;

  LResult    : Pointer;
  Code       : integer;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      Str(Default,SDefault);
      Len := ReadIniData(ValueName,Value,SDefault);
      if (Len > 0) then begin
        Val(Value,Result,Code);
        if (Code <> 0) then
          Result := Default;
      end else
        Result := Default;
    end else begin
      try
        Key := OpenRegKey;
      except
        Result := Default;
        Exit;
      end;
      try
        ECode := GetDataInfo(Key,ValueName,ValSize,ValType);

        if (ECode <> ERROR_SUCCESS) then begin
          Result := Default;
          Exit;
        end;

        {Size does not include null terminator for strings}
        if (ValType = REG_SZ) OR (ValType = REG_EXPAND_SZ) then
          Inc(ValSize);
        GetMem(LResult,ValSize);
        try
          ECode := ReadRegData(Key,ValueName,LResult,ValSize,ValType);
          if (ECode <> ERROR_SUCCESS) then
            Result := Default
          else begin
            {covert data, if possible, to DateTime value}
            case (ValType) of
              REG_SZ,
              REG_EXPAND_SZ : begin
                                Value := StrPas(PAnsiChar(LResult));
                                Val(Value,Result,Code);
                                if (Code <> 0) then
                                  Result := Default;
                              end;
              REG_BINARY,
              REG_DWORD     : Result := TDateTime(LResult^);
            else
              Result := Default;
            end;
          end;
        finally
          FreeMem(LResult,ValSize);
        end;
      finally
        if (riRemoteKey = 0) then
          CloseRegKey(Key);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

{==========================================================================}

procedure TStRegIni.WriteDate(const ValueName : string; const Value : TStDate);
  {-write a SysTools Date to Ini file or registry}
begin
  WriteInteger(ValueName,DWORD(Value));
end;

{==========================================================================}

function TStRegIni.ReadDate(const ValueName : string; const Default : TStDate) : TStDate;
  {-read a SysTools Date from Ini file or registry}
begin
  Result := TStDate(ReadInteger(ValueName,DWORD(Default)));
end;

{==========================================================================}

procedure TStRegIni.WriteTime(const ValueName : string; const Value : TStTime);
  {-write SysTools Time to Ini file or registry}
begin
  WriteInteger(ValueName,DWORD(Value));
end;

{==========================================================================}

function TStRegIni.ReadTime(const ValueName : string; const Default : TStTime) : TStTime;
  {-read SysTools Time from Ini file or registry}
begin
  Result := TStTime(ReadInteger(ValueName,DWORD(Default)));
end;

{==========================================================================}

procedure TStRegIni.CreateKey(const KeyName : string);
  {-create a new section in Ini file or subkey in registry}
const
  TempValueName = '$ABC123098FED';
var
  Disposition   : DWORD;
  ECode         : LongInt;
  newKey        : HKey;
  PCSKey,
  PSKey         : PAnsiChar;
  HoldKey       : HKey;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (Length(KeyName) = 0) then
      RaiseRegIniError(stscNoKeyName);

    if (riType = riIniType) then begin
      GetMem(PSKey,Length(KeyName)+1);
      try
        StrPCopy(PSKey,KeyName);
        {Create Section with temporary value}
        if (NOT WritePrivateProfileString(PSKey,TempValueName,' ',riRootName)) then
          RaiseRegIniError(stscCreateKeyFail);
        {Delete temporary value but leave section intact}
        if (NOT WritePrivateProfileString(PSKey,TempValueName,nil,riRootName)) then
          RaiseRegIniError(stscIniWriteFail);
      finally
        FreeMem(PSKey,Length(KeyName)+1);
      end;
    end else begin
      HoldKey := 0;
      GetMem(PCSKey, Length(KeyName)+1 + LongInt(strlen(riCurSubkey))+2);
      GetMem(PSKey, Length(KeyName)+1);
      try
        PCSKey[0] := #0;
        StrPCopy(PSKey,KeyName);
        if riCurSubKey[0] <> #0 then
          strcat(Strcopy(PCSKey, riCurSubKey), '\');
        strcat(PCSKey, PSKey);
        if (riRemoteKey <> 0) then begin
          HoldKey := riPrimaryKey;
          riPrimaryKey := riRemoteKey;
        end;
        Disposition := 0;
        {creates a new key or opens an existing key}
        ECode := RegCreateKeyEx(riPrimaryKey,PCSKey,0,nil,
                 REG_OPTION_NON_VOLATILE,KEY_ALL_ACCESS,@FriSecAttr,
                 newKey,@Disposition);
        if (ECode <> ERROR_SUCCESS) then
          RaiseRegIniErrorFmt(stscCreateKeyFail,[ECode]);

        {don't leave a key open longer than it's needed}
        RegCloseKey(newKey);
      finally
        if (HoldKey <> 0) then
          riPrimaryKey := HoldKey;
        FreeMem(PSKey,Length(KeyName)+1);
        FreeMem(PCSKey, Length(KeyName)+1 + LongInt(strlen(riCurSubkey))+2);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

{==========================================================================}

procedure TStRegIni.ParseIniFile(SList : TStrings);
{-procedure to read through an INI text file}
var
   F : TextFile;
   L : string;
begin
  AssignFile(F, riRootName);
  Reset(F);
  try
    Readln(F,L);
    while NOT EOF(F) do begin
      if (L[1] = '[') AND (L[Length(L)] = ']') then begin
        Delete(L, Length(L), 1);
        Delete(L, 1, 1);
        SList.Add(L);
      end;
      Readln(F,L);
    end;
  finally
    CloseFile(F);
  end;
end;

{==========================================================================}

procedure TStRegIni.GetSubKeys(SK : TStrings);
  {-get list of section names (or values) from Ini file or subkeys in registry}
  {For Ini files only: if riCurSubKey =  '', list is of section names}
  {                    if riCurSubKey <> '', list is of value names in section}
var
  ValueName     : PAnsiChar;

  Sections,
  valuePos,
  NumSubKeys,
  LongSKName,
  LongVName,
  NumVals,
  MaxSize,
  VSize         : DWORD;
  Buffer        : array[0..MaxBufSize] of AnsiChar;
  S             : string;
  ECode         : LongInt;
  Key           : HKey;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    SK.Clear;

    if (riType = riIniType) then begin
      Buffer[0] := #0;
      if (riCurSubKey[0] = #0) then begin
        {Get section names in ini file}
        Sections := GetPrivateProfileSectionNames(Buffer,MaxBufSize,riRootName);
      end else
        {get value names in specified section}
        Sections := GetPrivateProfileString(riCurSubKey,nil,#0,
                    Buffer,MaxBufSize,riRootName);

      {parse Section Names from Buffer string}
      if (Sections > 0) then begin
        valuePos := 0;
        repeat
          S := StrPas(Buffer+valuePos);
          if (Length(S) > 0) then begin
            SK.Add(S);
            Inc(valuePos,StrEnd(Buffer+valuePos)-(Buffer+valuePos)+1);
          end else
            break;
        until Length(S) = 0;
      end;
    end else begin
      Key := OpenRegKey;
      try
        ECode := RegQueryInfoKey(Key,nil,nil,nil,@NumSubKeys,
                   @LongSKName,nil,@NumVals,@LongVName,@MaxSize,nil,nil);
        if (ECode <> ERROR_SUCCESS) then
          RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);
        Inc(LongSKName);
        valuePos := 0;
        GetMem(ValueName,LongSKName);
        try
          while valuePos < NumSubKeys do begin
            ValueName[0] := #0;
            VSize := LongSKName;
            ECode := RegEnumKeyEx(Key,valuePos,ValueName,VSize,
                       nil,nil,nil,nil);
            if (ECode <> ERROR_SUCCESS) AND
               (ECode <> ERROR_MORE_DATA) then
              RaiseRegIniErrorFmt(stscEnumKeyFail,[ECode]);
            SK.Add(StrPas(ValueName));
            Inc(valuePos);
          end;
        finally
          FreeMem(ValueName,LongSKName);
        end;
      finally
        if (riRemoteKey = 0) then
          CloseRegKey(Key);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

{==========================================================================}

procedure TStRegIni.GetValues(SKV : TStrings);
  {-return value names and string representation of data in}
  {Ini file section or registry subkey}
var
  ValueName    : PAnsiChar;

  valuePos,
  NumSubKeys,
  LongSKName,
  LongVName,
  NumVals,
  MaxSize,
  VSize,
  DSize        : DWORD;

  S, TS        : string;
  KeyList      : TStringList;
  ECode        : LongInt;
  Key          : HKey;

  ValType      : DWORD;
  LResult      : Pointer;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    SKV.Clear;

    if (riType = riIniType) then begin
      KeyList := TStringList.Create;
      try
        {get list of value names in section}
        GetSubKeys(KeyList);
        if (KeyList.Count > 0) then begin
          for valuePos := 0 to KeyList.Count-1 do begin
            S := KeyList[valuePos] + '='
               + ReadString(KeyList[valuePos],'');
            SKV.AddObject(S,BmpText);
          end;
        end;
      finally
        KeyList.Free;
      end;
    end else begin
      Key := OpenRegKey;
      try
        {get data on specified keys}
        ECode := RegQueryInfoKey(Key,nil,nil,nil,
                   @NumSubKeys,@LongSKName,nil,@NumVals,
                   @LongVName,@MaxSize,nil,nil);
        if (ECode <> ERROR_SUCCESS) then
          RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);
        Inc(MaxSize);
        Inc(LongVName);
        GetMem(LResult,MaxSize);
        try
          valuePos := 0;
          GetMem(ValueName,LongVName);
          try
            {step through values in subkey and get data from each}
            while valuePos < NumVals do begin
              ValueName[0] := #0;
              VSize := LongVName;
              DSize := MaxSize;
              ECode := RegEnumValue(Key,valuePos,ValueName,
                         VSize,nil,@ValType,LResult,@DSize);
              if (ECode <> ERROR_SUCCESS) AND
                 (ECode <> ERROR_MORE_DATA) then
                RaiseRegIniErrorFmt(stscEnumValueFail,[ECode]);
              if (Length(ValueName) > 0) then
                S := StrPas(ValueName) + '='
              else
                S := 'Default=';
              case ValType of
                {convert data to string representation}
                REG_SZ,
                REG_EXPAND_SZ : begin
                                  TS := StrPas(PAnsiChar(LResult));
                                  S := S + TS;
                                  SKV.AddObject(S,BmpText);
                                end;

                REG_DWORD,