首页 诗词 字典 板报 句子 名言 友答 励志 学校 网站地图
当前位置: 首页 > 教程频道 > .NET > .NET >

照抄网上的代码疏失,请帮看看

2014-01-05 
照抄网上的代码出错,请帮看看?unit UnitPropertySetinterfaceuses Windows, SysUtils, ComObj, ActiveXt

照抄网上的代码出错,请帮看看?
unit UnitPropertySet;

interface

uses Windows, SysUtils, ComObj, ActiveX;

type
  TPropertySet = class
  private
    FFileName: WideString;
    FActive: Boolean;
    FPropertySetStorage: IPropertySetStorage;
    FPropertyStorage: IPropertyStorage;
    FStorage: IStorage;
    FStreamGUID: TGUID;

    procedure SetActive(const Value: Boolean);
    procedure SetFileName(const Value: WideString);
    procedure SetStreamGUID(const Value: TGUID);
  protected
    procedure InternalOpen; dynamic;
    procedure InternalClose; dynamic;
  public
    constructor Create;
    destructor Destroy; override;
    procedure Open;
    procedure Close;
    function GetPropertyByName(APropertyName: WideString): TPropVariant;
    function GetPropertyByID(APropertyID: Integer): TPropVariant;
 
    property Active: Boolean read FActive write SetActive;
    property FileName: WideString read FFileName write SetFileName;
    property StreamGUID: TGUID read FStreamGUID write SetStreamGUID;
  end;

const
  FMTID_SummaryInformation: TGUID = '{F29F85E0-4FF9-1068-AB91-08002B27B3D9}';
  FMTID_DocumentSummaryInformation: TGUID = '{D5CDD502-2E9C-101B-9397-08002B2CF9AE}';
  FMTID_UserDefinedProperties: TGUID = '{D5CDD505-2E9C-101B-9397-08002B2CF9AE}';
  IID_IPropertySetStorage : TGUID = '{0000013A-0000-0000-C000-000000000046}';

implementation
type
  TPropSpecArray = array [0..1000] of TPropSpec;
  PPropSpecArray = ^TPropSpecArray;
  TPropVariantArray = array [0..1000] of TPropVariant;
  PPropVariantArray = ^TPropVariantArray;
 
  tagSTGOPTIONS = record
    usVersion: ShortInt;
    reserved: Short;
    ulSectorSize: LongInt;
    pwcsTemplateFile: PWideChar;
  end;
 
  STGOPTIONS = ^tagSTGOPTIONS;
 
const
  STGFMT_STORAGE = 0;
  STGFMT_FILE = 3;
  STGFMT_ANY = 4;
  STGFMT_DOCFILE = 5;
 
function StgOpenStorageEx(const pwcsName: POleStr; grfMode: Longint;
  stgfmt: DWORD; grfAttrs: DWORD; pStgOptions: STGOPTIONS; reserved2: Pointer;
  riid: PGUID; out ppObjectOpen: IStorage): HResult; stdcall;
  external 'ole32.dll';

constructor TPropertySet.Create;
begin
  inherited;
  FStreamGUID := FMTID_SummaryInformation;
end;
 
destructor TPropertySet.Destroy;
begin
  Close;
end;
 
procedure TPropertySet.Open;
begin
  Active := True;
end;
 
procedure TPropertySet.Close;
begin
  Active := False;
end;
 
function TPropertySet.GetPropertyByName(APropertyName: WideString): TPropVariant;
var
  ps: PPropSpecArray;
  pv: PPropVariantArray;
begin
  ps := nil;
  pv := nil;
  try
    GetMem(ps, sizeof(TPropSpec));
    GetMem(pv, sizeof(TPropVariant));
    ps[0].ulKind := PRSPEC_LPWSTR;
    ps[0].lpwstr := PWideChar(APropertyName);
    OleCheck(FPropertyStorage.ReadMultiple(1, @ps[0], @pv[0]));
    Result := pv[0];
  finally
    if ps <> nil then
      FreeMem(ps);
    if pv <> nil then
      FreeMem(pv);
  end;

end;
 
function TPropertySet.GetPropertyByID(APropertyID: Integer): TPropVariant;
var
  ps: PPropSpecArray;
  pv: PPropVariantArray;
begin
  ps := nil;
  pv := nil;
  try
    GetMem(ps, sizeof(TPropSpec));
    GetMem(pv, sizeof(TPropVariant));
    ps[0].ulKind := PRSPEC_PROPID;
    ps[0].propid := APropertyID;
    OleCheck(FPropertyStorage.ReadMultiple(1, @ps[0], @pv[0]));
    Result := pv[0];
  finally
    if ps <> nil then


      FreeMem(ps);
    if pv <> nil then
      FreeMem(pv);
  end;
end;
 
procedure TPropertySet.InternalOpen;
begin
  if FFileName = '' then
    raise Exception.Create('文件名必须设置!');
  OleCheck(StgOpenStorageEx(PWChar(FFileName), STGM_READ or STGM_SHARE_DENY_WRITE,
    STGFMT_ANY, 0, nil, nil, @IID_IPropertySetStorage, FStorage));
  FPropertySetStorage := FStorage as IPropertySetStorage;
  OleCheck(FPropertySetStorage.Open(FStreamGUID, STGM_READ or STGM_SHARE_EXCLUSIVE,
    FPropertyStorage));
end;
 
procedure TPropertySet.InternalClose;
begin
  FPropertyStorage := nil;
  FPropertySetStorage := nil;
  FStorage := nil;
end;
 
procedure TPropertySet.SetActive(const Value: Boolean);
begin
  if FActive <> Value then
  begin
    if Value then
      InternalOpen
    else
      InternalClose;
    FActive := Value;
  end;
end;
 
procedure TPropertySet.SetFileName(const Value: WideString);
begin
  if FFileName <> Value then
  begin
    if FActive then
    begin
      InternalClose;
      FFileName := Value;
      InternalOpen;
    end
    else
      FFileName := Value;
  end;
end;
 
procedure TPropertySet.SetStreamGUID(const Value: TGUID);
begin
  if (FStreamGUID<>Value) then
  begin
    if FActive then
    begin
      InternalClose;
      FStreamGUID := Value;
      InternalOpen;
    end
    else
      FStreamGUID := Value;
  end;
end;

end.
-------------------------------------

if (FStreamGUID<>Value) then 报错:Incompatible types

代码是抄网上某杂志中的文章的:
http://www.comprg.com.cn/post_show.asp?id=8704

全文:
http://www.comprg.com.cn/post_show.asp?id=8700
http://www.comprg.com.cn/post_show.asp?id=8701
http://www.comprg.com.cn/post_show.asp?id=8702
http://www.comprg.com.cn/post_show.asp?id=8703

热点排行