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

Let's GO GO GO 2011-07-14 02:29:25
比如:PStoreCreateInstance 用DELPHI 或者C#的使用方法。谢谢了。不要用什么C++之类的。太难看明白了
...全文
85 3 打赏 收藏 转发到动态 举报
写回复
用AI写文章
3 条回复
切换为时间正序
请发表友善的回复…
发表回复
xuchuantao17 2011-10-17
  • 打赏
  • 举报
回复
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;

xuchuantao17 2011-10-17
  • 打赏
  • 举报
回复
//*****************************************//
// Carlo Pasolini //
// http://pasotech.altervista.org //
// email: cdpasop@hotmail.it //
//*****************************************//
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;

implementation

const
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.





xuchuantao17 2011-10-17
  • 打赏
  • 举报
回复
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;

implementation

uses 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.

62,041

社区成员

发帖
与我相关
我的任务
社区描述
.NET技术交流专区
javascript云原生 企业社区
社区管理员
  • ASP.NET
  • .Net开发者社区
  • R小R
加入社区
  • 近7日
  • 近30日
  • 至今
社区公告

.NET 社区是一个围绕开源 .NET 的开放、热情、创新、包容的技术社区。社区致力于为广大 .NET 爱好者提供一个良好的知识共享、协同互助的 .NET 技术交流环境。我们尊重不同意见,支持健康理性的辩论和互动,反对歧视和攻击。

希望和大家一起共同营造一个活跃、友好的社区氛围。

试试用AI创作助手写篇文章吧