谁知道 Pstorec.dll。讲一下里面的函数用法，谢谢

Question

unit PSTORECLib_TLB;
{$TYPEDADDRESS OFF} 
{$WRITEABLECONST ON}
interface
uses Windows, ActiveX, Classes, Graphics, OleServer, StdVCL, Variants;
const
  PSTORECLibMajorVersion = 1;
  PSTORECLibMinorVersion = 0;  LIBID_PSTORECLib: TGUID = '{5A6F1EBD-2DB1-11D0-8C39-00C04FD9126B}';  IID_IEnumPStoreProviders: TGUID = '{5A6F1EBF-2DB1-11D0-8C39-00C04FD9126B}';
  IID_IPStore: TGUID = '{5A6F1EC0-2DB1-11D0-8C39-00C04FD9126B}';
  CLASS_CPStore: TGUID = '{5A6F1EC3-2DB1-11D0-8C39-00C04FD9126B}';
  IID_IEnumPStoreTypes: TGUID = '{789C1CBF-31EE-11D0-8C39-00C04FD9126B}';
  IID_IEnumPStoreItems: TGUID = '{5A6F1EC1-2DB1-11D0-8C39-00C04FD9126B}';
  CLASS_CEnumTypes: TGUID = '{09BB61E7-31EC-11D0-8C39-00C04FD9126B}';
  CLASS_CEnumItems: TGUID = '{09BB61E6-31EC-11D0-8C39-00C04FD9126B}';
type
  IEnumPStoreProviders = interface;
  IPStore = interface;
  IEnumPStoreTypes = interface;
  IEnumPStoreItems = interface;
  CPStore = IEnumPStoreProviders;
  CEnumTypes = IEnumPStoreTypes;
  CEnumItems = IEnumPStoreItems;
  PUserType1 = ^_PST_PROVIDERINFO; {*}
  PByte1 = ^Byte; {*}
  PUserType2 = ^TGUID; {*}
  PUserType3 = ^_PST_TYPEINFO; {*}
  PUserType4 = ^_PST_ACCESSRULESET; {*}
  PPUserType1 = ^IEnumPStoreTypes; {*}
  PUserType5 = ^_PST_PROMPTINFO; {*}
  PPUserType2 = ^IEnumPStoreItems; {*}  _PST_PROVIDERINFO = packed record
    cbSize: LongWord;
    ID: TGUID;
    Capabilities: LongWord;
    szProviderName: PWideChar;
  end;  _PST_TYPEINFO = packed record
    cbSize: LongWord;
    szDisplayName: PWideChar;
  end;  _PST_ACCESSCLAUSE = packed record
    cbSize: LongWord;
    ClauseType: LongWord;
    cbClauseData: LongWord;
    pbClauseData: ^Byte;
  end;  _PST_ACCESSRULE = packed record
    cbSize: LongWord;
    AccessModeFlags: LongWord;
    cClauses: LongWord;
    rgClauses: ^_PST_ACCESSCLAUSE;
  end;  _PST_ACCESSRULESET = packed record
    cbSize: LongWord;
    cRules: LongWord;
    rgRules: ^_PST_ACCESSRULE;
  end;  _PST_PROMPTINFO = packed record
    cbSize: LongWord;
    dwPromptFlags: LongWord;
    hwndApp: LongWord;
    szPrompt: PWideChar;
  end;
IEnumPStoreProviders = interface(IUnknown)
    ['{5A6F1EBF-2DB1-11D0-8C39-00C04FD9126B}']
    function Next(celt: LongWord; out rgelt: PUserType1; var pceltFetched: LongWord): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out ppenum: IEnumPStoreProviders): HResult; stdcall;
  end;
  IPStore = interface(IUnknown)
    ['{5A6F1EC0-2DB1-11D0-8C39-00C04FD9126B}']
    function GetInfo(out ppProperties: PUserType1): HResult; stdcall;
    function GetProvParam(dwParam: LongWord; out pcbData: LongWord; out ppbData: PByte1; 
                          dwFlags: LongWord): HResult; stdcall;
    function SetProvParam(dwParam: LongWord; cbData: LongWord; var pbData: Byte; dwFlags: LongWord): HResult; stdcall;
    function CreateType(Key: LongWord; var pType: TGUID; var pInfo: _PST_TYPEINFO; dwFlags: LongWord): HResult; stdcall;
    function GetTypeInfo(Key: LongWord; var pType: TGUID; out ppInfo: PUserType3; dwFlags: LongWord): HResult; stdcall;
    function DeleteType(Key: LongWord; var pType: TGUID; dwFlags: LongWord): HResult; stdcall;
    function CreateSubtype(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                           var pInfo: _PST_TYPEINFO; var pRules: _PST_ACCESSRULESET; 
                           dwFlags: LongWord): HResult; stdcall;
    function GetSubtypeInfo(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                            out ppInfo: PUserType3; dwFlags: LongWord): HResult; stdcall;
    function DeleteSubtype(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; dwFlags: LongWord): HResult; stdcall;
    function ReadAccessRuleset(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                               out ppRules: PUserType4; dwFlags: LongWord): HResult; stdcall;
    function WriteAccessRuleset(Key: LongWord; var pType: TGUID; var pSubtype: TGUID; 
                                var pRules: _PST_ACCESSRULESET; dwFlags: LongWord): HResult; stdcall;
    function EnumTypes(Key: LongWord; dwFlags: LongWord; var ppenum: IEnumPStoreTypes): HResult; stdcall;
    function EnumSubtypes(Key: LongWord; var pType: TGUID; dwFlags: LongWord; 
                          var ppenum: IEnumPStoreTypes): HResult; stdcall;
    function DeleteItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                        szItemName: PWideChar; var pPromptInfo: _PST_PROMPTINFO; dwFlags: LongWord): HResult; stdcall;
    function ReadItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                      szItemName: PWideChar; out pcbData: LongWord; out ppbData: PByte1; 
                      var pPromptInfo: _PST_PROMPTINFO; dwFlags: LongWord): HResult; stdcall;
    function WriteItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                       szItemName: PWideChar; cbData: LongWord; var pbData: Byte; 
                       var pPromptInfo: _PST_PROMPTINFO; dwDefaultConfirmationStyle: LongWord; 
                       dwFlags: LongWord): HResult; stdcall;
    function OpenItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                      szItemName: PWideChar; ModeFlags: LongWord; var pPromptInfo: _PST_PROMPTINFO; 
                      dwFlags: LongWord): HResult; stdcall;
    function CloseItem(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                       szItemName: PWideChar; dwFlags: LongWord): HResult; stdcall;
    function EnumItems(Key: LongWord; var pItemType: TGUID; var pItemSubtype: TGUID; 
                       dwFlags: LongWord; var ppenum: IEnumPStoreItems): HResult; stdcall;
  end;
  IEnumPStoreTypes = interface(IUnknown)
    ['{789C1CBF-31EE-11D0-8C39-00C04FD9126B}']
    function Next(celt: LongWord; out rgelt: TGUID; var pceltFetched: LongWord): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out ppenum: IEnumPStoreTypes): HResult; stdcall;
  end;
  IEnumPStoreItems = interface(IUnknown)
    ['{5A6F1EC1-2DB1-11D0-8C39-00C04FD9126B}']
    function Next(celt: LongWord; out rgelt: PWideChar; var pceltFetched: LongWord): HResult; stdcall;
    function Skip(celt: LongWord): HResult; stdcall;
    function Reset: HResult; stdcall;
    function Clone(out ppenum: IEnumPStoreItems): HResult; stdcall;
  end;  CoCPStore = class
    class function Create: IEnumPStoreProviders;
    class function CreateRemote(const MachineName: string): IEnumPStoreProviders;
  end;
  CoCEnumTypes = class
    class function Create: IEnumPStoreTypes;
    class function CreateRemote(const MachineName: string): IEnumPStoreTypes;
  end;
  CoCEnumItems = class
    class function Create: IEnumPStoreItems;
    class function CreateRemote(const MachineName: string): IEnumPStoreItems;
  end;implementationuses ComObj;class function CoCPStore.Create: IEnumPStoreProviders;
begin
  Result := CreateComObject(CLASS_CPStore) as IEnumPStoreProviders;
end;class function CoCPStore.CreateRemote(const MachineName: string): IEnumPStoreProviders;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_CPStore) as IEnumPStoreProviders;
end;class function CoCEnumTypes.Create: IEnumPStoreTypes;
begin
  Result := CreateComObject(CLASS_CEnumTypes) as IEnumPStoreTypes;
end;class function CoCEnumTypes.CreateRemote(const MachineName: string): IEnumPStoreTypes;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_CEnumTypes) as IEnumPStoreTypes;
end;class function CoCEnumItems.Create: IEnumPStoreItems;
begin
  Result := CreateComObject(CLASS_CEnumItems) as IEnumPStoreItems;
end;class function CoCEnumItems.CreateRemote(const MachineName: string): IEnumPStoreItems;
begin
  Result := CreateRemoteComObject(MachineName, CLASS_CEnumItems) as IEnumPStoreItems;
end;end.

Answer 1

//*****************************************//
// Carlo Pasolini                          //
// http://pasotech.altervista.org          //
// email: [email protected]               //
//*****************************************//
unit Pstoreclib;interface
uses
  Windows, PSTORECLib_TLB;function PStoreCreateInstance(
                             var ppProvider: IPStore;
                             pProviderID: PGUID;
                             pReserved: Pointer;
                             dwFlags: DWORD): HRESULT; stdcall;procedure CoTaskMemFree(
                        pv: Pointer); stdcall;var
  DLLHandle: THandle;implementationconst
  pstorec = 'pstorec.dll';
  ole32 = 'ole32.dll';{$IFDEF DYNAMIC_LINK}
var
  _PStoreCreateInstance: Pointer;function PStoreCreateInstance;
begin
  GetProcedureAddress(_PStoreCreateInstance, pstorec, 'PStoreCreateInstance');
  asm
    mov esp, ebp
    pop ebp
    jmp [_PStoreCreateInstance]
  end;
end;
{$ELSE}
function PStoreCreateInstance; external pstorec name 'PStoreCreateInstance';
{$ENDIF DYNAMIC_LINK}{$IFDEF DYNAMIC_LINK}
var
  _CoTaskMemFree;function CoTaskMemFree;
begin
  GetProcedureAddress(_CoTaskMemFree, ole32, 'CoTaskMemFree');
  asm
    mov esp, ebp
    pop ebp
    jmp [_CoTaskMemFree]
  end;
end;
{$ELSE}
procedure CoTaskMemFree; external ole32 name 'CoTaskMemFree';
{$ENDIF DYNAMIC_LINK}
end.

Answer 2

unit PStorage;
interface
uses
  Windows, PStorageIntfs, Classes, ActiveX;
type
  TPStoreCreateInstance = function(var ppProvider: IPStore; pProviderID: PGUID; pReserved: Pointer; dwFlags: DWORD): HRESULT; stdcall;
PProviderInfo = ^TProviderInfo;
  TProviderInfo = record
    GUID: TGUID;
    Capabilities: LongWord;
    ProviderName: ShortString;
  end;
TIDList = class;
  TProviderList = class;
  TItemList = class;
TPStorage = class(TObject)
  private
    FKey: Integer;
    FConnected: Boolean;
    FProvider: IPStore;
    function GetInitialized: Boolean;
    function GetProviderInfo: TProviderInfo;
  public
    constructor Create;
    destructor Destroy; override;
    function Connect(ProviderID: PGUID): Boolean;
    procedure Disconnect;
    property Initialized: Boolean read GetInitialized;
    property Connected: Boolean read FConnected;
    property ProviderInfo: TProviderInfo read GetProviderInfo;
function GetTypes: TIDList;
    function GetSubtypes(pType: TGUID): TIDList;
    function GetItems(pType, pSubtype: TGUID): TItemList;
    function GetTypeName(pGUID: TGUID): String;
    function GetSubtypeName(pType, pSubtype: TGUID): String;
    function GetProviders: TProviderList;
function DeleteType(pType: TGUID): Boolean;
    function DeleteSubtype(pType, pSubtype: TGUID): Boolean;
function ReadItemData(pType, pSubtype: TGUID; pItem: ShortString; var Data: Pointer; var DataLen: LongWord): Boolean;
    function DeleteItem(pType, pSubtype: TGUID; pItem: ShortString): Boolean;
    function WriteItemData(pType, pSubtype: TGUID; pItem: ShortString; Data: Pointer; DataLen: LongWord; Prompt: Boolean; PromptInfo: String): Boolean;
function CreateType(pType: TGUID; const DisplayName: String): Boolean;
    function CreateSubtype(pType, pSubtype: TGUID; const DisplayName: String): Boolean;
  end;
TEnumList = class(TObject)
  private
    FList: TList;
    function GetCount: Integer;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Remove(Index: Integer);
    property Count: Integer read GetCount;
  end;
TIDList = class(TEnumList)
  public
    procedure Add(GUID: TGUID);
    function Get(Index: Integer): TGUID;
  end;
TProviderList = class(TEnumList)
  public
    procedure Add(ProvInfo: TProviderInfo);
    function Get(Index: Integer): TProviderInfo;
  end;
TItemList = class(TEnumList)
  public
    procedure Add(ItemName: ShortString);
    function Get(Index: Integer): ShortString;
  end;
function FillPromptInfoStruct: _PST_PROMPTINFO;
const
  pstorec = 'pstorec.dll';
  PST_KEY_CURRENT_USER = 0;     
  PST_KEY_LOCAL_MACHINE = 1;    
  PST_PF_ALWAYS_SHOW = 1;       
  PST_PF_NEVER_SHOW = 2;        
  PST_PF_SHOW_ON_REQUEST = 4;
var
  PStoreCreateInstance: TPStoreCreateInstance;
  FInitialized: Boolean;
  FLibrary: THandle;
implementation
constructor TPStorage.Create;
begin
  FKey := PST_KEY_CURRENT_USER;
  FConnected := False;
end;
destructor TPStorage.Destroy;
begin
  Disconnect;
  inherited;
end;
function TPStorage.GetInitialized: Boolean;
begin
  Result := FInitialized;
end;
function TPStorage.GetProviderInfo: TProviderInfo;
var
  ppInfo: PUserType1;
begin
  if not FConnected then Exit;
  if FProvider.GetInfo(ppInfo) = S_OK then begin
    Result.GUID := ppInfo.ID;
    Result.Capabilities := ppInfo.Capabilities;
    Result.ProviderName := String(ppInfo.szProviderName);
  end;
end;
function TPStorage.Connect(ProviderID: PGUID): Boolean;
begin
  Result := False;
  if not FInitialized then Exit;
  if FConnected then Disconnect;
  if (PStoreCreateInstance(FProvider, ProviderID, nil, 0) <> S_OK) or (FProvider = nil) then begin
    FProvider := nil;
    Exit;
  end else begin
    FConnected := True;
    Result := True;
  end;
end;
procedure TPStorage.Disconnect;
begin
  if FConnected then begin
    FProvider := nil;
    FConnected := False;
  end;
end;
function TPStorage.GetTypes: TIDList;
var
  ppEnum: IEnumPStoreTypes;
  GUIDBuf: array[0..15] of TGUID;
  ItemsRead, i: Cardinal;
begin
  Result := TIDList.Create;
  if not FConnected then Exit;
  ppEnum := nil;
  if (FProvider.EnumTypes(FKey, 0, ppEnum) <> S_OK) or (ppEnum = nil) then begin
    Exit;
    ppEnum := nil;
  end;
  ItemsRead := 0;
  repeat
    ppEnum.Next(SizeOf(GUIDBuf) div SizeOf(GUIDBuf[0]), GUIDBuf[0], ItemsRead);
    if ItemsRead > 0 then
      for i := 0 to ItemsRead-1 do
        Result.Add(GUIDBuf[i]);
  until ItemsRead = 0;
  ppEnum := nil;
end;
function TPStorage.GetSubtypes(pType: TGUID): TIDList;
var
  ppEnum: IEnumPStoreTypes;
  GUIDBuf: array[0..15] of TGUID;
  ItemsRead, i: Cardinal;
begin
  Result := TIDList.Create;
  ppEnum := nil;
  if (FProvider.EnumSubTypes(FKey, pType, 0, ppEnum) <> S_OK) or (ppEnum = nil) then begin
    Exit;
    ppEnum := nil;
  end;
  ItemsRead := 0;
  repeat
    ppEnum.Next(SizeOf(GUIDBuf) div SizeOf(GUIDBuf[0]), GUIDBuf[0], ItemsRead);
    if ItemsRead > 0 then
      for i := 0 to ItemsRead-1 do
        Result.Add(GUIDBuf[i]);
  until ItemsRead = 0;
  ppEnum := nil;
end;
function TPStorage.GetItems(pType, pSubtype: TGUID): TItemList;
var
  ppEnum: IEnumPStoreItems;
  ItemBuf: array[0..15] of PWideChar;
  ItemsRead, i: Cardinal;
begin
  Result := TItemList.Create;
  ppEnum := nil;
  if (FProvider.EnumItems(FKey, pType, pSubType, 0, ppEnum) <> S_OK) or (ppEnum = nil) then begin
    Exit;
    ppEnum := nil;
  end;
  ItemsRead := 0;
  repeat
    ppEnum.Next(SizeOf(ItemBuf) div SizeOf(ItemBuf[0]), ItemBuf[0], ItemsRead);
    if ItemsRead > 0 then
      for i := 0 to ItemsRead-1 do begin
        Result.Add(String(ItemBuf[i]));
        CoTaskMemFree(ItemBuf[i]);
      end;
  until ItemsRead = 0;
  ppEnum := nil;
end;
function TPStorage.GetTypeName(pGUID: TGUID): String;
var
  pst: PUserType3;
begin
  if not FConnected then Exit;
  pst := nil;
  if (FProvider.GetTypeInfo(FKey, pGUID, pst, 0) = S_OK) and (pst <> nil) then begin
    Result := String(pst^.szDisplayName);
    CoTaskMemFree(pst);
  end;
end;
function TPStorage.GetSubtypeName(pType, pSubtype: TGUID): String;
var
  pst: PUserType3;
begin
  if not FConnected then Exit;
  pst := nil;
  if (FProvider.GetSubtypeInfo(FKey, pType, pSubType, pst, 0) = S_OK) and (pst <> nil) then begin
    Result := String(pst^.szDisplayName);
    CoTaskMemFree(pst);
  end;
end;
function TPStorage.GetProviders: TProviderList;
var
  ppEnum: IEnumPStoreProviders;
  ProvBuf: array[0..15] of PUserType1; 
  ItemsRead, i: Cardinal;
  tpi: TProviderInfo;
begin
  Result := TProviderList.Create;
  if not FConnected then Exit;
  if FProvider.QueryInterface(IID_IEnumPStoreProviders, ppEnum) <> S_OK then Exit;
ItemsRead := 0;
  repeat
    ppEnum.Next(SizeOf(ProvBuf) div SizeOf(ProvBuf[0]), ProvBuf[0], ItemsRead);
    if ItemsRead > 0 then
      for i := 0 to ItemsRead - 1 do begin
        tpi.GUID := ProvBuf[i].ID;
        tpi.Capabilities := ProvBuf[i].Capabilities;
        tpi.ProviderName := String(ProvBuf[i].szProviderName);
        Result.Add(tpi);
        CoTaskMemFree(ProvBuf[i]);
      end;
  until ItemsRead = 0;
ppEnum := nil;
end;
function TPStorage.DeleteType(pType: TGUID): Boolean;
begin
  Result := False;
  if not FConnected then Exit;
  Result := FProvider.DeleteType(FKey, pType, 0) = S_OK;  
end;
function TPStorage.DeleteSubtype(pType, pSubtype: TGUID): Boolean;
begin
  Result := False;
  if not FConnected then Exit;
  Result := FProvider.DeleteSubtype(FKey, pType, pSubType, 0) = S_OK;
end;
function TPStorage.ReadItemData(pType, pSubtype: TGUID; pItem: ShortString; var Data: Pointer; var DataLen: LongWord): Boolean;
var
  pspi: _PST_PROMPTINFO;
begin
  Result := False;
  if not FConnected then Exit;
  pspi := FillPromptInfoStruct;
  DataLen := 0;
  Data := nil;
  Result := FProvider.ReadItem(FKey, pType, pSubtype, StringToOleStr(pItem), DataLen, Data, pspi, 0) = S_OK;
end;
function TPStorage.DeleteItem(pType, pSubtype: TGUID; pItem: ShortString): Boolean;
var
  pspi: _PST_PROMPTINFO;
begin
  Result := False;
  if not FConnected then Exit;
  pspi := FillPromptInfoStruct;
  Result := FProvider.DeleteItem(FKey, pType, pSubtype, StringToOleStr(pItem), pspi, 0) = S_OK;
end;
function TPStorage.WriteItemData(pType, pSubtype: TGUID; pItem: ShortString; Data: Pointer; DataLen: LongWord; Prompt: Boolean; PromptInfo: String): Boolean;
var
  pspi: _PST_PROMPTINFO;
begin
  Result := False;
  if not FConnected then Exit;
  pspi := FillPromptInfoStruct;
  pspi.dwPromptFlags := PST_PF_SHOW_ON_REQUEST;
  pspi.szPrompt := StringToOleStr(PromptInfo);
  if Prompt then
    Result := FProvider.WriteItem(FKey, pType, pSubtype, StringToOleStr(pItem), DataLen, PByte(Data)^, pspi, 0, 0) = S_OK
  else
    Result := FProvider.WriteItem(FKey, pType, pSubtype, StringToOleStr(pItem), DataLen, PByte(Data)^, pspi, 1, 0) = S_OK;  
end;
function TPStorage.CreateType(pType: TGUID; const DisplayName: String): Boolean;
var
  pInfo: _PST_TYPEINFO;
begin
  pInfo.cbSize := SizeOf(_PST_TYPEINFO);
  pInfo.szDisplayName := StringToOleStr(DisplayName);
  Result := FProvider.CreateType(FKey, pType, pInfo, 0) = S_OK;
end;
function TPStorage.CreateSubtype(pType, pSubtype: TGUID; const DisplayName: String): Boolean;
var
  pRules: _PST_ACCESSRULESET;
  pInfo: _PST_TYPEINFO;
begin
  pRules.cbSize := SizeOf(_PST_ACCESSRULESET);
  pRules.cRules := 0;
  pRules.rgRules := nil;
  pInfo.cbSize := SizeOf(_PST_TYPEINFO);
  pInfo.szDisplayName := StringToOleStr(DisplayName);
  Result := FProvider.CreateSubtype(FKey, pType, pSubtype, pInfo, pRules, 0) = S_OK;
end;
constructor TEnumList.Create;
begin
  FList := TList.Create;
end;
destructor TEnumList.Destroy;
var
  i: Integer;
begin
  for i := 0 to FList.Count - 1 do
    Dispose(FList.Items[i]);
  FList.Free;
  inherited;
end;