fvmain.pas

《Delphi开发人员指南》配书原码

unit FVMain;

interface

uses Windows, ComObj, ComServ, ActiveX, ShlObj, ViewFrm;

type
  TDDGFileViewer = class(TComObject, IFileViewer, IPersistFile)
  private
    FLastSite: IFileViewerSite;
    FFileName: WideString;
    FLoadCalled: Boolean;
    FFileMode: DWORD;
    FViewForm: TViewForm;
  public
    // IFileViewer methods
    function ShowInitialize(fsi: IFileViewerSite): HResult; stdcall;
    function Show(var pvsi: TFVShowInfo): HResult; stdcall;
    function PrintTo(pszDriver: PAnsiChar; fSuppressUI: BOOL): HResult; stdcall;
    // IPersist method
    function GetClassID(out classID: TCLSID): HResult; stdcall;
    // IPersistFile methods
    function IsDirty: HResult; stdcall;
    function Load(pszFileName: POleStr; dwMode: Longint): HResult; stdcall;
    function Save(pszFileName: POleStr; fRemember: BOOL): HResult; stdcall;
    function SaveCompleted(pszFileName: POleStr): HResult; stdcall;
    function GetCurFile(out pszFileName: POleStr): HResult; stdcall;
  end;

  TFileViewerFactory = class(TComObjectFactory)
  protected
    function GetProgID: string; override;
    procedure ApproveShellExtension(Register: Boolean; const ClsID: string);
      virtual;
  public
    procedure UpdateRegistry(Register: Boolean); override;
  end;

implementation

uses SysUtils, Registry;

{ TDDGFileViewer }

const
  // CLSID for file viewer
  CLSID_SteveFileViewer: TCLSID = '{2A804000-E7A2-11CF-B512-00008606FDA7}';

{ TDDGFileViewer.IFileViewer }

function TDDGFileViewer.ShowInitialize(fsi: IFileViewerSite): HResult;
begin
//  OutputDebugString('In TDDGFileViewer.ShowInitialize');
  Result := S_OK;
  try
    if FLastSite <> fsi then FLastSite := fsi;
    if FViewForm <> nil then FViewForm.Release;
    FViewForm := TViewForm.Create(nil);
    if not FileExists(FFileName) then Result := E_OUTOFMEMORY;
  except
    Result := E_OUTOFMEMORY;
  end;
end;

function TDDGFileViewer.Show(var pvsi: TFVShowInfo): HResult;
begin
//  OutputDebugString('In TDDGFileViewer.Show');
  Result := S_OK;
  try
    // Only continue if ShowInit succeeded
    if pvsi.dwFlags and FVSIF_NEWFAILED = 0 then
    begin
      with FViewForm, pvsi do
      begin
        Memo1.Lines.LoadFromFile(FFileName);
        Update;
        hwndOwner := Handle;
        FFileName := strNewFile;
      end;
      if pvsi.dwFlags and FVSIF_RECT <> 0 then
        with pvsi.Rect do
          FViewForm.SetBounds(Left, Top, Right - Left, Bottom - Top);
      if (pvsi.iShow <> SW_HIDE) then
      begin
        SetForegroundWindow(FViewForm.Handle);
        FViewForm.Show;
      end;
      // If an old window exists, destroy it now.
      if pvsi.dwFlags and FVSIF_PINNED <> 0 then
      begin
        FLastSite.SetPinnedWindow(0);
        FLastSite.SetPinnedWindow(FViewForm.Handle);
      end;
      if pvsi.punkRel <> nil then pvsi.punkRel := nil;
    end;
  except
    Result := E_UNEXPECTED;
  end;
end;

function TDDGFileViewer.PrintTo(pszDriver: LPSTR; fSuppressUI: BOOL): HResult;
begin
  Result := E_NOTIMPL;
end;

{ TDDGFileViewer.IPersist }

function TDDGFileViewer.GetClassID(out classID: TCLSID): HResult;
begin
  classID := CLSID_SteveFileViewer;
  Result := S_OK;
end;

{ TDDGFileViewer.IPersistFile }

function TDDGFileViewer.IsDirty: HResult;
begin
  // File is never dirty, because viewer doesn't modify file
  Result := S_FALSE;
end;

function TDDGFileViewer.Load(pszFileName: POleStr; dwMode: Longint): HResult;
begin
  Result := S_OK;
  try
    FFileName := pszFileName;
    FLoadCalled := True;
    FFileMode := dwMode;
  except
    Result := E_UNEXPECTED;
  end;
end;

function TDDGFileViewer.Save(pszFileName: POleStr; fRemember: BOOL): HResult;
begin
  // Save functionality isn't implemented
  Result := E_NOTIMPL;
end;

function TDDGFileViewer.SaveCompleted(pszFileName: POleStr): HResult;
begin
  // SaveCompleted functionality isn't implemented
  Result := E_NOTIMPL;
end;

function TDDGFileViewer.GetCurFile(out pszFileName: POleStr): HResult;
begin
  if not FLoadCalled then
  begin
    Result := E_UNEXPECTED;
    Exit;
  end;
  pszFileName := POleStr(FFileName);
  Result := S_OK;
end;

{ TFileViewerFactory }

function TFileViewerFactory.GetProgID: string;
begin
  // ProgID not required for shell extensions
  Result := '';
end;

procedure TFileViewerFactory.UpdateRegistry(Register: Boolean);
var
  ClsID: string;
begin
  ClsID := GUIDToString(ClassID);
  inherited UpdateRegistry(Register);
  ApproveShellExtension(Register, ClsID);
  if Register then
  begin
    // must register .slt as a file type
    CreateRegKey('.slt', '', 'SteveFile');
    CreateRegKey('SteveFile', '', 'Steve''s file type');
    // shell extensions require apartment threading model entry
    CreateRegKey('CLSID\' + ClsID + '\InprocServer32', 'ThreadingModel',
      'Apartment');
    // register QuickView handler
    CreateRegKey('QuickView\.slt\' , '', 'SteveFile');
    CreateRegKey('QuickView\.slt\' + ClsID, '', 'Steve''s file viewer');
  end
  else begin
    DeleteRegKey('QuickView\.slt\');
    DeleteRegKey('.slt\');
    DeleteRegKey('SteveFile');
  end;
end;

procedure TFileViewerFactory.ApproveShellExtension(Register: Boolean;
  const ClsID: string);
// This registry entry is required in order for the extension to
// operate correctly under Windows NT.
const
  SApproveKey = 'SOFTWARE\Microsoft\Windows\CurrentVersion\Shell Extensions\Approved';
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_LOCAL_MACHINE;
      if not OpenKey(SApproveKey, True) then Exit;
      if Register then WriteString(ClsID, Description)
      else DeleteValue(ClsID);
    finally
      Free;
    end;
end;

initialization
  TFileViewerFactory.Create(ComServer, TDDGFileViewer, CLSID_SteveFileViewer,
    'D3DG_FileViewer', 'D3DG File Viewer Example', ciMultiInstance);
end.