regfiles.pas

大家是不是为不知道如何在VB学到绝地程序

End;

{------------Low Level Functions---------}

Function RemoveParams(Value: String): String;
Var
  i: Integer;
Begin
  Value := UpperCase(Value);
  i := Pos('.EXE', Value);
  If ((i < (Length(Value) - 4)) And (i > 0)) Then
    Result := Copy(Value, 1, i + 3)
  Else
    Result := Value;
  If Result[1] = '"' Then Delete(Result, 1, 1);
End;
//  Writen by Dale (stryder) Clarke
// This function sets the default value of the key to a string.

Procedure ChangeRegistryStr(mainKey: LongInt; AKey: String; AValue: String);
Var
  szKey, SzValue: PChar;
Begin
  szKey := StrAlloc(Length(AKey) + 1);
  SzValue := StrAlloc(Length(AValue) + 1);
  StrPCopy(szKey, AKey);
  StrPCopy(SzValue, AValue);
  RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  StrDispose(szKey);
  StrDispose(SzValue);
End;

//  Writen by Dale (stryder) Clarke
// This function sets the default value of the key to a boolean.

Procedure ChangeRegistryBool(mainKey: LongInt; AKey: String; AValue: Boolean);
Var
  szKey, SzValue: PChar;
  BoolStr: String;
Begin
  If AValue = True Then
    BoolStr := 'TRUE'
  Else
    BoolStr := 'FALSE';
  szKey := StrAlloc(Length(AKey) + 1);
  SzValue := StrAlloc(Length(BoolStr) + 1);
  StrPCopy(szKey, AKey);
  StrPCopy(SzValue, BoolStr);
  RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  StrDispose(szKey);
  StrDispose(SzValue);
End;

//  Writen by Dale (stryder) Clarke
// This function sets the default value of the key to a integer.

Procedure ChangeRegistryInt(mainKey: LongInt; AKey: String; AValue: LongInt);
Var
  szKey, SzValue: PChar;
  IntegerStr: String;
Begin
  IntegerStr := IntToStr(AValue);
  szKey := StrAlloc(Length(AKey) + 1);
  SzValue := StrAlloc(Length(IntegerStr) + 1);
  StrPCopy(szKey, AKey);
  StrPCopy(SzValue, IntegerStr);
  RegSetValue(MainKey, szKey, REG_SZ, SzValue, StrLen(SzValue));
  StrDispose(szKey);
  StrDispose(SzValue);
End;

//  Writen by Dale (stryder) Clarke
// This function returns a string value for the given key if the key does not exist
// the key will be created with the default value.

Function GetRegistryStr(MainKey: LongInt; AKey: String; Default: String): String;
Var
  szKey, SzValue: PChar;
  nRet, NSize: LongInt;
Begin
  szKey := StrAlloc(Length(AKey) + 1);
  SzValue := StrAlloc(1000);
  StrPCopy(szKey, AKey);
  StrPCopy(SzValue, '');
  NSize := 1000;
  nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  If (nRet = ERROR_SUCCESS) Then
    Result := StrPas(SzValue)
  Else
    Result := Default;
  StrDispose(szKey);
  StrDispose(SzValue);
End;

//  Writen by Dale (stryder) Clarke
// This function returns a boolean value for the given key if the key does not exist
// the key will be created with the default value.

Function GetRegistryBool(MainKey: LongInt; AKey: String; Default: Boolean): Boolean;
Var
  BoolStr: String;
  szKey, SzValue: PChar;
  nRet, NSize: LongInt;
Begin
  If Default = True Then
    BoolStr := 'TRUE'
  Else
    BoolStr := 'FALSE';
  szKey := StrAlloc(Length(AKey) + 1);
  SzValue := StrAlloc(1000);
  StrPCopy(szKey, AKey);
  StrPCopy(SzValue, BoolStr);
  NSize := 1000;
  nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  If (nRet = ERROR_SUCCESS) Then Begin
    BoolStr := StrPas(SzValue);
    If BoolStr = 'TRUE' Then
      Result := True
    Else
      Result := False;
  End
  Else
    Result := Default;
  StrDispose(szKey);
  StrDispose(SzValue);
End;

//  Writen by Dale (stryder) Clarke
// This function returns a integer value for the given key if the key does not exist
// the key will be created with the default value.

Function GetRegistryInt(MainKey: LongInt; AKey: String; Default: Integer): Integer;
Var
  szKey, SzValue: PChar;
  AString: String;
  nRet, NSize: LongInt;
Begin
  szKey := StrAlloc(Length(AKey) + 1);
  SzValue := StrAlloc(32);
  StrPCopy(szKey, AKey);
  NSize := 32;
  nRet := RegQueryValue(MainKey, szKey, SzValue, NSize);
  AString := StrPas(SzValue);
  StrDispose(szKey);
  StrDispose(SzValue);
  If (nRet = ERROR_SUCCESS) Then
    GetRegistryInt := StrToInt(AString)
  Else
    GetRegistryInt := Default;
End;

//  Writen by Dale (stryder) Clarke
// This function returns a stringlist of names of a valid
// registration key. You can yous this to recursivly look for
// more subkeys. Remember to always pass a initialized stringlist
// and to free it yourself.

Function GetRegSubTree(MainKey: LongInt; AKey, AValue: String;
  Const AList: TStrings): Boolean;
Var
  hRoot: HKey;
  lItem: LongInt;
  hError: LongInt;
  szKey, Pdata: PChar;
  //  aString        : String;

Begin
  GetRegSubTree := False;
  If AList = Nil Then Exit;
  {create pointers for the API}
  szKey := StrAlloc(Length(AKey) + 1);
  try
    StrPCopy(szKey, AKey);
    lItem := 0;
    Pdata := StrAlloc(1024);
    try
      hError := RegOpenKey(MainKey, szKey, hRoot);
      If hError = ERROR_SUCCESS Then Begin
        While (hError = ERROR_SUCCESS) Do Begin
          hError := RegEnumKey(hRoot, lItem, Pdata, 1024);
          If (hError = ERROR_SUCCESS) Then Begin
            GetRegSubTree := True;
            Inc(lItem);
            If (AValue <> '') And (AnsiPos(UpperCase(AValue), UpperCase(Pdata)) = 0) Then
              Continue; //no match, skip, don't add to list.
            AList.Add(StrPas(Pdata));
          End;
        End;
        RegCloseKey(hRoot);
      End;
    finally
      StrDispose(Pdata);
    end;
  finally
    StrDispose(szKey);
  end;

End;

//  Writen by Dale (stryder) Clarke
//  On Win 95 this removes all subkeys but on NT the key is
//  only removed if it has NO subkeys.  So always call NTDeleteRegKey
//  so if this fails it will recursively remove the keys.

Function DeleteRegKey(MainKey: LongInt; AKey: String): Boolean;
Var
  szKey: PChar;
Begin
  {RegDeletKey API wants a pointer}
  szKey := StrAlloc(Length(AKey) + 1);
  StrPCopy(szKey, AKey);
  // Let windows remove the subkey's safely by bypassing VCL
  // This call is exported in the winreg unit to a call to the ADVAPI.DLL
  // I have never encounter a exception here but better safe than sorry.
  // Mickey may change the API (as if they've done that before)
  Try
    Result := (RegDeleteKey(MainKey, szKey) = ERROR_SUCCESS);
  Finally
    StrDispose(szKey); {make sure pointer is free when exit}
  End;
End;

//  Writen by Dale (stryder) Clarke
//  This function is extreemly dangerous. The key specified and all subkeys WILL be removed.
//  Especially DO NOT pass the string SOFTWARE or anyother important registry root folder.
//  On NT RegDeleteKey will not remove a key if it has subkeys.
//  This function will remove all sukeys on NT

Function NTDeleteRegKey(MainKey: LongInt; Const AKey: String): Boolean;
Var
  AList: TStringList;
  s: String;
  i: Integer;
Begin
  AList := TStringList.Create;
  Result := False;
  Try
    s := AKey;
    If GetRegSubTree(MainKey, AKey, '', AList) Then {check for subkeys}  Begin
      For i := 0 To AList.Count - 1 Do Begin
        NTDeleteRegKey(MainKey, s + '\' + AList[i]); {recurse to look for more subkeys}
        Result := DeleteRegKey(MainKey, s); {no subkeys so delete}
      End;
    End Else Result := DeleteRegKey(MainKey, s); {no subkeys so delete}
  Finally
    AList.Free;
  End;
End;

//  Writen by Dale (stryder) Clarke
// This function saves a string to a registry key.

Function SaveIntToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Boolean;
Var
  RegVar: TRegistry;
Begin
  Result := False;
  RegVar := TRegistry.Create;
  RegVar.RootKey := MainKey;
  Try
    If RegVar.OpenKey(RegistryKey, True) Then Begin
      RegVar.WriteInteger(AItem, AValue);
      Result := True;
    End;
  Finally
    RegVar.Free;
  End;
End;

//  Writen by Dale (stryder) Clarke
// This function returns a integer from a registry key.

Function LoadIntFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Integer): Integer;
Var
  RegVar: TRegistry;

Begin
  Result := AValue;
  RegVar := TRegistry.Create;
  RegVar.RootKey := MainKey;
  Try
    If RegVar.OpenKey(RegistryKey, True) Then Begin
      If RegVar.ValueExists(AItem) Then Begin
        Result := RegVar.ReadInteger(AItem);
      End;
    End;
  Finally
    RegVar.Free;
  End;
End;

//  Writen by Dale (stryder) Clarke
// This function saves a string to a registry key.

Function SaveStrToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): Boolean;
Var
  RegVar: TRegistry;
Begin
  Result := False;
  RegVar := TRegistry.Create;
  RegVar.RootKey := MainKey;
  Try
    If RegVar.OpenKey(RegistryKey, True) Then Begin
      RegVar.WriteString(AItem, AValue);
      Result := True;
    End;
  Finally
    RegVar.Free;
  End;
End;

//  Writen by Dale (stryder) Clarke
// This function returs a string from a registry key.

Function LoadStrFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: String): String;
Var
  RegVar: TRegistry;
Begin
  Result := AValue;
  RegVar := TRegistry.Create;
  RegVar.RootKey := MainKey;
  Try
    If RegVar.OpenKey(RegistryKey, True) Then Begin
      If RegVar.ValueExists(AItem) Then Begin
        Result := RegVar.ReadString(AItem);
      End;
    End;
  Finally
    RegVar.Free;
  End;
End;

//  Writen by Dale (stryder) Clarke
// This function saves a boolean to a registry key.

Function SaveBoolToRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
Var
  RegVar: TRegistry;
Begin
  Result := False;
  RegVar := TRegistry.Create;
  RegVar.RootKey := MainKey;
  Try
    If RegVar.OpenKey(RegistryKey, True) Then Begin
      RegVar.WriteBool(AItem, AValue);
      Result := True;
    End;
  Finally
    RegVar.Free;
  End;
End;

//  Writen by Dale (stryder) Clarke
// This function returns a boolean from a registry key.

Function LoadBoolFromRegistry(MainKey: LongInt; RegistryKey, AItem: String; AValue: Boolean): Boolean;
Var
  RegVar: TRegistry;
Begin
  Result := AValue;
  RegVar := TRegistry.Create;
  RegVar.RootKey := MainKey;
  Try
    If RegVar.OpenKey(RegistryKey, True) Then Begin
      If RegVar.ValueExists(AItem) Then Begin
        Result := RegVar.ReadBool(AItem);
      End;
    End;
  Finally
    RegVar.Free;
  End;
End;

Initialization

Finalization

End.