stregini.pas

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

function TStRegIni.GetIsIniFile : Boolean;
  {-get whether instance is IniFile or no}
begin
  Result := riType = riIniType;
end;

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

function TStRegIni.GetAttributes : TSecurityAttributes;
  {-Get current security attributes (NT Only) }
begin
  with Result do begin
    nLength := sizeof(TSecurityAttributes);
    lpSecurityDescriptor := FriSecAttr.lpSecurityDescriptor;
    bInheritHandle := FriSecAttr.bInheritHandle;
  end;
end;

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

procedure TStRegIni.SetAttributes(Value : TSecurityAttributes);
  {-set security attributes (NT only) }
begin
  FriSecAttr.nLength := sizeof(TSecurityAttributes);
  FriSecAttr.lpSecurityDescriptor := Value.lpSecurityDescriptor;
  FriSecAttr.bInheritHandle := Value.bInheritHandle;
end;

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

function TStRegIni.GetCurSubKey : string;
  {-retrn name of working Ini file section or registry subkey}
begin
  Result := FCurSubKey;
end;

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

procedure TStRegIni.SetCurSubKey(Value : string);
  {-set name of working Ini file section or registry subkey}
begin
  if (riCurSubKey <> nil) then
    FreeMem(riCurSubKey,StrLen(riCurSubKey)+1);
  FCurSubKey := Value;
  GetMem(riCurSubKey,Length(Value)+1);
  StrPCopy(riCurSubKey,Value);
end;

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

function TStRegIni.OpenRegKey : HKey;
  {-open a registry key}
var
  Disposition   : DWORD;
  ECode         : LongInt;
begin
  Disposition := 0;
  if (riMode = riSet) then begin
    {Keys are created with all key access privilages and as non-volatile}
    ECode := RegCreateKeyEx(riPrimaryKey, riCurSubKey,0,nil,
        REG_OPTION_NON_VOLATILE,KEY_ALL_ACCESS,@FriSecAttr,
        Result,@Disposition);
    if (ECode <> ERROR_SUCCESS) then
      RaiseRegIniErrorFmt(stscCreateKeyFail, [ECode]);
  end else begin
    {Read operations limit key access to read only}
    ECode := RegOpenKeyEx(riPrimaryKey,riCurSubKey, 0, KEY_READ,Result);
    if (ECode <> ERROR_SUCCESS) then
      RaiseRegIniErrorFmt(stscOpenKeyFail, [ECode]);
  end;
end;

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

procedure TStRegIni.CloseRegKey(const Key : HKey);
  {-close registry key}
begin
  RegCloseKey(Key);
end;

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

function TStRegIni.WriteIniData(const ValueName : string;
                                      Data      : String) : Boolean;
  {-write data to the Ini file in the working section}
var
  PData,
  PValueName : PAnsiChar;
  VNLen,
  DLen       : integer;
begin
  if (ValueName = '') then
    RaiseRegIniError(stscNoValueNameSpecified);

  PData := nil;
  PValueName := nil;
  VNLen := Length(ValueName) + 1;
  DLen  := Length(Data) + 1;

  try
    GetMem(PValueName, VNLen);
    GetMem(PData, DLen);

    strPCopy(PValueName, ValueName);
    strPCopy(PData, Data);

    Result := WritePrivateProfileString(riCurSubKey, PValueName,
                                        PData, riRootName)
  finally
    if PValueName <> nil then
      FreeMem(PValueName, VNLen);
    if PData <> nil then
      FreeMem(PData, DLen);
  end;
end;

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

function TStRegIni.ReadIniData(const ValueName : string; var Value : string;
                               Default : string) : Integer;
  {-read a value from the working section of the Ini file}
var
  PValue   : array[0..1024] of char;
  PVName,
  PDefault : PAnsiChar;
begin
  PDefault := nil;
  PVName := nil;

  try
    GetMem(PVName,Length(ValueName)+1);
    GetMem(PDefault,Length(Default)+1);

    StrPCopy(PVName,ValueName);
    StrPCopy(PDefault,Default);

    GetPrivateProfileString(riCurSubKey,PVName,PDefault,
        PValue,SizeOf(PValue)-1,riRootName);

  {$IFOPT H-}
    if strlen(PValue) > 255
      PValue[255] := #0;
  {$ENDIF}
    Value := StrPas(PValue);
    Result := Length(Value);
  finally
    if PVName <> nil then
      FreeMem(PVName,strlen(PVName)+1);
    if PDefault <> nil then
      FreeMem(PDefault,strlen(PDefault)+1);
  end;
end;

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

function TStRegIni.WriteRegData(Key : HKey; const ValueName : string; Data : Pointer;
                                DType : DWORD; Size : Integer) : LongInt;
  {-write a value into the registry}
var
  PVName : PAnsiChar;
begin
   GetMem(PVName, Length(ValueName)+1);
   try
     StrPCopy(PVName, ValueName);
     Result := RegSetValueEx(Key, PVName, 0, DType, Data, Size);
   finally
     FreeMem(PVName, strlen(PVName)+1);
   end;
end;

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

function TStRegIni.GetDataInfo(Key : HKey; const ValueName : string;
                               var Size : LongInt; var DType : DWORD) : LongInt;
  {-get the size and type of a specific value in the registry}
var
  PVName : PAnsiChar;
  Opened : Boolean;
  TS     : string;
begin
  Opened := False;
  riMode := riGet;
  if (riType = riIniType) then begin
    TS := ReadString(ValueName,'');
    Size := Length(TS);
    DType := REG_SZ;
    Result := ERROR_SUCCESS;
    Exit;
  end;

  GetMem(PVName,Length(ValueName)+1);
  try
    StrPCopy(PVName,ValueName);
    if Key = 0 then begin
      Key := OpenRegKey;
      Opened := True;
    end;
    Result := RegQueryValueEx(Key,PVName,nil,@DType,nil,LPDWORD(@Size));
  finally
    FreeMem(PVName,strlen(PVName)+1);
  end;
  if Opened then
    RegCloseKey(Key);
end;

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

function TStRegIni.ReadRegData(Key : HKey; const ValueName : string; Data : Pointer;
                               Size : LongInt; DType : DWORD) : LongInt;
  {-read a value from the registry}
var
  PVName : PAnsiChar;
begin
  GetMem(PVName,Length(ValueName)+1);
  try
    StrPCopy(PVName,ValueName);
    DType := REG_NONE;
    Result := RegQueryValueEx(Key, PVName, nil,@DType,PByte(Data),LPDWORD(@Size));
  finally
    FreeMem(PVName,strlen(PVName)+1);
  end;
end;

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

function TStRegIni.GetFullKeyPath : string;
begin
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      Result := StrPas(riRootName) + '\' + StrPas(riCurSubKey);
    end else begin
      case riPrimaryKey of

        HKEY_LOCAL_MACHINE : Result := 'HKEY_LOCAL_MACHINE\';
        HKEY_USERS         : Result := 'HKEY_USERS\';
        HKEY_CLASSES_ROOT  : Result := 'HKEY_CLASSES_ROOT\';
        HKEY_CURRENT_USER  : Result := 'HKEY_CURRENT_USER\';
      end;
      Result := Result + StrPas(riCurSubKey);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

procedure TStRegIni.WriteBoolean(const ValueName : string; Value : Boolean);
  {-write Boolean value to the Ini file or registry}
var
  ECode    : LongInt;
  IValue   : DWORD;
  Key      : HKey;
  wResult  : Boolean;

begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      if (Value) then
        wResult := WriteIniData(ValueName, StrPas(riTrueString))
      else
        wResult := WriteIniData(ValueName, StrPas(riFalseString));
      if (NOT wResult) then
        RaiseRegIniError(stscIniWriteFail);
    end else begin
      Key := OpenRegKey;
      try
        IValue := Ord(Value);
        ECode := WriteRegData(Key,ValueName,@IValue,REG_DWORD,SizeOf(DWORD));
        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.ReadBoolean(const ValueName : string; Default : Boolean) : Boolean;
  {-read a Boolean value from the Ini file or registry}
var
  Value      : string;
  IVal       : Double;
  Key        : HKey;
  ECode,

  ValSize    : LongInt;
  ValType    : DWORD;
  LResult    : Pointer;
  Code       : Integer;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      if Default then
        ReadIniData(ValueName,Value,StrPas(riTrueString))
      else
        ReadIniData(ValueName,Value,StrPas(riFalseString));

      if (CompareText(Value,StrPas(riFalseString)) = 0) then
        Result := False
      else begin
        if (CompareText(Value,StrPas(riTrueString)) = 0) then
          Result := True
        else begin
          Val(Value,IVal,Code);
          if (Code = 0) then
            Result := IVal <> 0
          else
            Result := Default;
        end;
      end;

    end else begin
      try
        Key := OpenRegKey;
      except
        Result := Default;
        Exit;
      end;
      try
        {get info on requested value}
        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
            {convert data, if possible, to Boolean}
            case (ValType) of
              REG_SZ,
              REG_EXPAND_SZ : Result := StrIComp(PAnsiChar(LResult),riFalseString) <> 0;
              REG_BINARY,
              REG_DWORD     : Result := (LongInt(LResult^) <> 0);
            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.WriteInteger(const ValueName : string; Value : DWORD);
  {-write an integer to the Ini file or the registry}
var
  ECode   : LongInt;
  Key     : HKey;

begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      if (NOT WriteIniData(ValueName,IntToStr(Value))) then
        RaiseRegIniError(stscIniWriteFail);
    end else begin
      Key := OpenRegKey;
      try
        ECode := WriteRegData(Key,ValueName,@Value,REG_DWORD,SizeOf(DWORD));
        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.ReadInteger(const ValueName : string; Default : DWORD) : DWORD;
  {-read an integer from the Ini file or registry}
var
  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
      Len := ReadIniData(ValueName,Value,IntToStr(Default));
      if (Len > 0) then begin
        Val(Value,Result,Code);
        if (Code <> 0) then
          Result := Default;
      end else
        Result := Default;
    end else begin
      try