stregini.pas

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

                REG_BINARY     : begin
                                  if ValType = REG_DWORD then
                                    Str(LongInt(LResult^),TS)
                                  else
                                    TS := BytesToString(PByte(LResult),DSize);
                                  S := S + TS;
                                  SKV.AddObject(S,BmpBinary);
                                end;
              end;
              Inc(valuePos);
            end;
          finally
            FreeMem(ValueName,LongVName);
          end;
        finally
          FreeMem(LResult,MaxSize);
        end;
      finally
        if (riRemoteKey = 0) then
          CloseRegKey(Key);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

procedure TStRegIni.DeleteKey(const KeyName : string; DeleteSubKeys : Boolean);
  {-delete a section from Ini file or subkey from registry}
  {if DeleteSubKeys = True  : specified section (key) and values (subkeys),}
  {                           if any, are deleted                          }
  {                 = False : specified section (key) can not be deleted   }
  {                           if there are any values (subkeys)            }
var
  PSKey      : PAnsiChar;
  NumSubKeys,
  NumValues  : DWORD;
  Key        : HKey;
  ECode      : LongInt;
  TS,
  HldKey     : ShortString;
  ASL        : TStringList;


     procedure ClearKey(StartKey : HKey);
     var
       SL   : TStringList;
       NK   : HKey;
       NSK,
       NV   : DWORD;
       J    : LongInt;
       TS,
       HK   : ShortString;
       PSK  : array[0..255] of char;
     begin
       ECode := RegQueryInfoKey(StartKey, nil, nil, nil, @NSK,
                  nil, nil, @NV, nil, nil, nil, nil);
       if (NV > 0) then begin
         SL := TStringList.Create;
         try
           GetValues(SL);
           for J := 0 to SL.Count-1 do begin
             TS := SL.Names[J];
             if (AnsiCompareText('Default', TS) <> 0) then
               DeleteValue(TS);
           end;
         finally
           SL.Free;
         end;
       end;

       if NSK > 0 then begin
         SL := TStringList.Create;
         try
           GetSubKeys(SL);
           for J := 0 to SL.Count-1 do begin
             HK := GetCurSubKey;
             SetCurSubKey(HK + '\' + SL[J]);
             NK := OpenRegKey;
             ClearKey(NK);
             RegCloseKey(NK);
             SetCurSubKey(HK);
             StrPCopy(PSK, SL[J]);
             RegDeleteKey(StartKey, PSK);
           end;
         finally
           SL.Free;
         end;
       end;
     end;

begin
  riMode := riSet;
  {$IFDEF ThreadSafe}
  EnterCS;
  try
  {$ENDIF}
    GetMem(PSKey,Length(KeyName)+1);
    try
      StrPCopy(PSKey,KeyName);
      if (riType = riIniType) then begin
        ASL := TStringList.Create;
        try
          {check for values in section}
          HldKey := GetCurSubkey;
          SetCurSubKey(KeyName);
          GetSubKeys(ASL);
          SetCurSubKey(HldKey);
          NumSubKeys := ASL.Count;

          {remove section KeyName from INI file}
          if (NumSubKeys > 0) AND (NOT DeleteSubKeys) then
            RaiseRegIniErrorFmt(stscKeyHasSubKeys,[NumSubKeys]);
          if (NOT WritePrivateProfileString(PSKey,nil,nil,riRootName)) then
            RaiseRegIniError(stscIniDeleteFail);
        finally
          ASL.Free;
        end;
      end else begin
        HldKey := GetCurSubkey;
        TS := HldKey + '\' + KeyName;
        if TS[1] = '\' then
          Delete(TS, 1, 1);
        SetCurSubKey(TS);
        Key := OpenRegKey;
        try
          {check for subkeys under key to be deleted}
          ECode := RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys,
                     nil, nil, @NumValues, nil, nil, nil, nil);

          if (ECode <> ERROR_SUCCESS) then
            RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);

          if (NumSubKeys > 0) OR (NumValues > 0) then begin
            if (NOT DeleteSubKeys) then
              RaiseRegIniErrorFmt(stscKeyHasSubKeys,[NumSubKeys])
            else
              if (riWinVer = riWinNT) then
                ClearKey(Key);
          end;
        finally
          RegCloseKey(Key);
          SetCurSubKey(HldKey);
        end;

        Key := OpenRegKey;
        try
          ECode := RegDeleteKey(Key, PSKey);
          if (ECode <> ERROR_SUCCESS) then
            RaiseRegIniErrorFmt(stscDeleteKeyFail,[ECode]);
        finally
          if (riRemoteKey = 0) then
            RegCloseKey(Key);
        end;
      end;
    finally
      FreeMem(PSKey,Length(KeyName)+1);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

procedure TStRegIni.DeleteValue(const ValueName : string);
  {-delete value from Ini file section or registry subkey}
var
  PVName : PAnsiChar;
  ECode  : LongInt;
  Key    : HKey;
begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    GetMem(PVName,Length(valueName)+1);
    try
      StrPCopy(PVName,valueName);
      if (riType = riIniType) then begin
        if (NOT WritePrivateProfileString(riCurSubKey,PVName,nil,riRootName)) then
          RaiseRegIniError(stscIniDelValueFail);
      end else begin
        Key := OpenRegKey;
        try
          ECode := RegDeleteValue(Key,PVName);
          if (ECode <> ERROR_SUCCESS) then
            RaiseRegIniErrorFmt(stscRegDelValueFail,[ECode]);
        finally
          if (riRemoteKey = 0) then
            CloseRegKey(Key);
        end;
      end;
    finally
      FreeMem(PVName,Length(valueName)+1);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

procedure TStRegIni.QueryKey(var KeyInfo : TQueryKeyInfo);
  {-get informatino about Ini file seciton or registry subkey}
const
  BufSize = 2048;
var
  PVName,
  PCName       : PAnsiChar;

  P,
  step         : integer;

  CNSize       : DWORD;
  Key          : HKey;
  ECode        : LongInt;
  SL           : TStringList;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (riType = riIniType) then begin
    {data for the specified section in the INI file}
      SL := TStringList.Create;
      try
        FillChar(KeyInfo,sizeof(KeyInfo),#0);
        {get value names/values}
        GetValues(SL);
        with KeyInfo do begin
          QIMaxVNLen   := 0;
          QIMaxDataLen := 0;
          QINumValues := SL.Count;
          if (SL.Count > 0) then begin
            for step := 0 to SL.Count-1 do begin
              {find maximum length of value names and values}
              P := pos('=',SL[step])-1;
              if (P > LongInt(QIMaxVNLen)) then
                QIMaxVNLen := P;

              P := Length(SL[step]) - P;
              if (P > LongInt(QIMaxDataLen)) then
                QIMaxDataLen := P;
            end;
          end;
        end;
      finally
        SL.Free;
      end;
    end else begin
      PVName := nil;
      PCName := nil;
      try
        GetMem(PVName,BufSize);
        GetMem(PCName,BufSize);

        Key := OpenRegKey;
        try
          PCName[0] := #0;
          CNSize := BufSize;
          with KeyInfo do begin
            ECode := RegQueryInfoKey(Key,PCName,@CNSize,
                       nil,@QINumSubKeys,@QIMaxSKNLen,
                       @QIMaxCNLen, @QINumValues,
                       @QIMaxVNLen, @QIMaxDataLen,
                       @QISDescLen, @QIFileTime);
            if (ECode <> ERROR_SUCCESS) then
              RaiseRegIniErrorFmt(stscQueryKeyFail,[ECode]);
            QIKey := Key;
            QIClassName := StrPas(PCName);
          end;
        finally
          if (riRemoteKey = 0) then
            CloseRegKey(Key);
        end;
      finally
        if (PVName <> nil) then
          FreeMem(PVName,BufSize);
        if (PCName <> nil) then
          FreeMem(PCName,BufSize);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

function TStRegIni.KeyExists(KeyName : string) : Boolean;
  {-checks if exists in INI file/Registry}
var
  KN : PAnsiChar;
  PV : array[0..9] of char;
  HK : HKey;
begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    GetMem(KN, Length(KeyName)+1);
    try
      StrPCopy(KN, KeyName);
      if (riType = riIniType) then begin
        GetPrivateProfileString(KN, nil, '$KDNE1234', PV, 10, riRootName);
        Result := StrIComp(PV, '$KDNE1234') <> 0;
      end else begin
         Result := RegOpenKeyEx(riPrimaryKey,KN,0,KEY_READ,HK) = ERROR_SUCCESS;
         if Result then
           RegCloseKey(HK);
      end;
    finally
      FreeMem(KN, Length(KeyName)+1);
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

function TStRegIni.IsKeyEmpty(Primary, SubKey : string) : Boolean;
var
  FindPos    : Integer;
  Key        : HKey;
  NumSubKeys,
  NumValues  : DWORD;
  ECode      : LongInt;
  HPrime,
  HSubKy     : ShortString;
  ASL        : TStringList;

begin
  riMode := riGet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    HPrime := GetPrimary;
    HSubKy := CurSubKey;

    SetPrimary(Primary);
    CurSubKey := SubKey;
    Result := True;

    if (riType = riIniType) then begin
        {check for values in section}
      ASL := TStringList.Create;
      try
        ParseIniFile(ASL);
        if not (ASL.Find( '[' + SubKey + ']', FindPos)) then
          Result := False;
      finally
        ASL.Free;
      end;
    end else begin
      try
        Key := OpenRegKey;
        try
          ECode := RegQueryInfoKey(Key, nil, nil, nil, @NumSubKeys,
                     nil, nil, @NumValues, nil, nil, nil, nil);
          if (ECode <> ERROR_SUCCESS) or
             (NumSubKeys > 0) or (NumValues > 0) then
            Result := False;
        except
          Result := False;
        end;
        RegCloseKey(Key);
      finally
        SetPrimary(HPrime);
        SetCurSubKey(HSubKy);
      end;
    end;
{$IFDEF ThreadSafe}
  finally
    LeaveCS;
  end;
{$ENDIF}
end;

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

procedure TStRegIni.SaveKey(const SubKey : string; FileName : string);
  {-save contents of registry key to a file}
var
  SKey    : string;
  I,
  DotPos  : Cardinal;
  TSL     : TStringList;
  F       : TextFile;
begin
  riMode := riSet;
{$IFDEF ThreadSafe}
  EnterCS;
  try
{$ENDIF}
    if (SubKey <> FCurSubKey) then begin
      SKey := FCurSubKey;
      SetCurSubKey(SubKey);
    end;

    if (riType = riIniType) then begin
      if (FileExists(FileName)) then
        RaiseRegIniError(stscOutputFileExists);
      TSL := TStringList.Create;
      try
        {get valuenames and values from specified section}
        GetValues(TSL);
        if (TSL.Count < 1) then
          RaiseRegIniError(stscKeyIsEmptyNotExists);
        AssignFile(F,FileName);
        ReWrite(F);
        try
          writeln(F,'[' + SubKey + ']');
          for I := 0 to TSL.Count-1 do
            writeln(F,TSL[I]);
        finally
          CloseFile(F);
        end;
      finally
        TSL.Free;
      end;
    end else begin
      if (FileExists(FileName)) then
        RaiseRegIniError(stscOutputFileExists);
  {$IFOPT H+}
      if (HasExtensionL(FileName,DotPos)) then
        RaiseRegIniError(stscFileHasExtension);
  {$ELSE}
      if (HasExtensionS(FileName,DotPos)) then