⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 stregini.pas

📁 条码控件: 一维条码控件 二维条码控件 PDF417Barcode MaxiCodeBarcode
💻 PAS
📖 第 1 页 / 共 5 页
字号:
        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 an integer 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 := DWORD(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;

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

function TStRegIni.BytesToString(Value : PByte; Size : Cardinal) : string;
  {-convert byte array to string, no spaces or hex enunciators, e.g., '$'}
var
  I,
  Index  : Cardinal;
  S      : String[3];

begin
  {$IFOPT H+}
  SetLength(Result,2*Size);
  {$ELSE}
  Result[0] := AnsiChar(Size*2);
  {$ENDIF}

  for I := 1 to Size do begin
    Index := I*2;
  {$IFOPT H+}
    S := HexBL(Byte(PAnsiChar(Value)[I-1]));
  {$ELSE}
    S := HexBS(Byte(PAnsiChar(Value)[I-1]);
  {$ENDIF}
    Result[(Index)-1] := S[1];
    Result[Index] := S[2];
  end;
end;

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

function TStRegIni.StringToBytes(const IString : string; var Value; Size : Cardinal) : Boolean;
  {-convert string (by groups of 2 char) to byte values}
var
  Code,
  Index,
  I     : Integer;
  Q     : array[1..MaxByteArraySize] of byte;
  S     : array[1..3] of AnsiChar;
begin
  if ((Length(IString) div 2) <> LongInt(Size)) then begin
    Result := False;
    Exit;
  end;

  Result := True;
  for I := 1 to Size do begin
    Index := (2*(I-1))+1;
    S[1] := '$';
    S[2] := IString[Index];
    S[3] := IString[Index+1];
    Val(S,Q[I],Code);
    if (Code <> 0) then begin
      Result := False;
      Exit;
    end;
 end;
  Move(Q, Value, Size);
end;

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

procedure TStRegIni.WriteBinaryData(const ValueName : string; const Value; Size : Integer);
  {-write binary data of any form to Ini file or registry}
var
  SValue : string;
  ECode  : LongInt;
  Key    : HKey;
begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      if (Size > MaxByteArraySize) then
        RaiseRegIniError(stscByteArrayTooLarge);
      SValue := BytesToString(PByte(@Value),Size);
      if (NOT WriteIniData(ValueName,SValue)) then
        RaiseRegIniError(stscIniWriteFail);
    end else begin
      Key := OpenRegKey;
      try
        ECode := WriteRegData(Key,ValueName,@Value,REG_BINARY,Size);
        if (ECode <> ERROR_SUCCESS) then
          RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
      finally
        if (riRemoteKey = 0) then
          CloseRegKey(Key);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

procedure TStRegIni.ReadBinaryData(const ValueName : string; const Default;
                                     var Value; var Size : Integer);
  {-read binary data of any form from Ini file or regsitry}
var
  ECode     : LongInt;
  Key       : HKey;
  Len       : Cardinal;

  ValSize   : LongInt;
  ValType   : DWORD;

  DefVals,
  Values    : string;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      DefVals := BytesToString(PByte(@Default), Size);
      Len := ReadIniData(ValueName, Values, DefVals);
      if (Len mod 2 = 0) then begin
        {covert string, if possible, to series of bytes}
        if not (StringToBytes(Values, PByte(Value), Size)) then
          Move(Default, PByte(Value), Size);
      end else
        Move(Default, PByte(Value), Size);
    end else begin
      try
        Key := OpenRegKey;
      except
        Move(Default, Value, Size);
        Exit;
      end;
      try
        {get info on requested value}
        ECode := GetDataInfo(Key, ValueName, ValSize, ValType);
        if (ECode <> ERROR_SUCCESS) then begin
          Move(Default, Value, Size);
          Exit;
        end;

        if (ValSize <> Size) then
          RaiseRegIniErrorFmt(stscBufferDataSizesDif, [Size,ValSize])
        else
          Size := ValSize;

        if (ValType <> REG_BINARY) then
          Move(Default, Value, Size)
        else begin
          ECode := ReadRegData(Key, ValueName, PByte(@Value), ValSize, ValType);
          if (ECode <> ERROR_SUCCESS) then
            Move(Default, Value, Size)
        end;
      finally
        if (riRemoteKey = 0) then
          CloseRegKey(Key);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

procedure TStRegIni.WriteString(const ValueName : string; const Value : string);
  {-write a string to the Ini file or registry}
var
  ECode  : LongInt;
  Key    : HKey;
  PValue : PAnsiChar;
begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      if NOT WriteIniData(ValueName, Value) then
        RaiseRegIniError(stscIniWriteFail);
    end else begin
      GetMem(PValue, Length(Value)+1);
      try
  {$IFOPT H+}
        StrCopy(PValue, PAnsiChar(Value));
  {$ELSE}
        StrPCopy(PValue, Value);
  {$ENDIF}
        Key := OpenRegKey;
        try
          {same call for 16/32 since we're using a PChar}
          ECode := WriteRegData(Key,ValueName, PValue,REG_SZ, strlen(PValue)+1);
          if (ECode <> ERROR_SUCCESS) then
            RaiseRegIniErrorFmt(stscRegWriteFail,[ECode]);
        finally
          if (riRemoteKey = 0) then
            CloseRegKey(Key);
        end;
      finally
        FreeMem(PValue,strlen(PValue)+1);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

function TStRegIni.ReadString(const ValueName : string; const Default : string) : string;
  {-read a string from an Ini file or the registry}
var
  ECode     : LongInt;
  Len       : LongInt;
  ValSize   : LongInt;
  Key       : HKey;
  ValType   : DWORD;
  TmpVal    : DWORD;
  LResult   : Pointer;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
      Len := ReadIniData(ValueName,Result,Default);
      if (Len < 1) then
        Result := Default;
    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;

        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) AND (ECode <> ERROR_MORE_DATA) then
            Result := Default
          else begin
            {convert data, if possible, to string}
            case (ValType) of
              REG_SZ,
              REG_EXPAND_SZ : Result := StrPas(PAnsiChar(LResult));
              REG_BINARY   : begin
                               if (ValSize > MaxByteArraySize) then
                                 RaiseRegIniError(stscByteArrayTooLarge);
                               Result := BytesToString(PByte(@LResult),ValSize);
                             end;
              REG_DWORD    : begin
                               TmpVal := DWORD(LResult^);
                               Str(TmpVal,Result);
                             end;
            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.WriteFloat(const ValueName : string; const Value : Double);
  {-write floating point number to Ini file or registry}
var
  ECode   : LongInt;
  Key     : HKey;
  SValue  : string;

begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    Str(Value, SValue);
    while (SValue[1] = ' ') do
      System.Delete(SValue, 1, 1);
    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(Double));
        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.ReadFloat(const ValueName : string; const Default : TStFloat) : TStFloat;
  {-read floating point value from 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
            {convert data, if possible, to floating point number}
            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,

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -