📄 stregini.pas
字号:
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 + -