毕业论文开发语言企业开发JAVA技术.NET技术WEB开发Linux/Unix数据库技术Windows平台移动平台嵌入式论文范文英语论文
您现在的位置: 毕业论文 >> 开发语言 >> 正文

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

更新时间:2014-1-3:  来源:毕业论文

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

String再转换回来呗!

设为首页 | 联系站长 | 友情链接 | 网站地图 |

copyright©youerw.com 优尔论文网 严禁转载
如果本毕业论文网损害了您的利益或者侵犯了您的权利,请及时联系,我们一定会及时改正。