oleregister8.pas

是一个delphi的流程制作软件

//========================= OLE UI UTILITIES ===================================
//
// This CLSID selection utility works by traversing the registry looking for
// insertable object servers.  When found the CLSID, description and default icon
// are extracted and placed in the listview. Also does other searches of the
// registry for such things as readable CLSIDS and associations.
//
// Grahame Marsh
// Freeware for UNDU - you get it for free I make no promises
// [e-mail]
//------------------------------------------------------------------------------

{$I OLE.INC}

unit OleRegister8;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ImgList, StdCtrls, Buttons, ComCtrls, ExtCtrls, Registry, ShellAPI, ToolWin,
  OleStd, OleHelpers, OleConsts;

type
  TBrowseCLSIDForm2 = class(TForm)
    Panel1: TPanel;
    ListView: TListView;
    OkBitBtn: TBitBtn;
    CancelBitBtn: TBitBtn;
    LargeImages: TImageList;
    SmallImages: TImageList;
    ToolBar1: TToolBar;
    ToolButton1: TToolButton;
    IconToolButton: TToolButton;
    ReportToolButton: TToolButton;
    IDImageList: TImageList;
    procedure ListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
    procedure ListViewDblClick(Sender: TObject);
    procedure IconToolButtonClick(Sender: TObject);
  private
    FSelected : TCLSIDStr;
    procedure SetSelected (const Value : TCLSIDStr);
    procedure Stuff;
  public
    procedure InsertMode;
    procedure ConversionMode;
    procedure ExcludeMode;
    procedure SelectIconMode;
    property SelectedCLSID : TCLSIDStr read FSelected write SetSelected;
  end;

var
  BrowseCLSIDForm2: TBrowseCLSIDForm2;

implementation

{$R *.DFM}

procedure TBrowseCLSIDForm2.InsertMode;
var
  SysReg  : TRegIniFile;
  SubKeys : TStringList;
  I : integer;
  Description,
  SubKey  : string;
  Icon : TIcon;
  Metafile : TUIMetafile;
begin
  with Listview.Columns.Add do
  begin
    Caption := 'Server';
    Width := 250
  end;
  with Listview.Columns.Add do
  begin
    Caption := 'CLSID';
    Width := 300
  end;
  Caption := 'Select an Insertable CLSID';

  Metafile := TUIMetafile.Create;
  Screen.Cursor := crHourglass;
  try
    SysReg := TRegIniFile.Create ('');
    try
      SysReg.RootKey := HKEY_CLASSES_ROOT;
      SysReg.OpenKey ('\CLSID', false);
      SubKeys := TStringList.Create;
      try
        SysReg.ReadSections (SubKeys);
        for I := SubKeys.Count - 1 downto 0 do
        begin
          SubKey := SubKeys [I];
          if SysReg.KeyExists (SubKey + '\Insertable') and
// Ole 1.0 ??? SysReg.KeyExists (SubKey + '\Protocol\StdFileEditing\Server')) and
            (not SysReg.KeyExists (SubKey + '\NotInsertable')) then
          begin
            Description := SysReg.ReadString (Subkey, '', '');
            if Description <> '' then
              with ListView.Items, Add do
              begin
                Caption := Description;
                SubItems.Add (SubKey);
                Metafile.IconOfClass (OleStdStringToCLSID(SubKey));
                Icon := Metafile.Icon;
                try
                  ImageIndex := SmallImages.AddIcon (Icon);
                  LargeImages.AddIcon (Icon)
                finally
                  Icon.Free
                end
              end
          end
        end
      finally
        SubKeys.Free
      end
    finally
      SysReg.Free
    end
  finally
    Metafile.Free;
    Screen.Cursor := crDefault
  end
end;

procedure TBrowseCLSIDForm2.ConversionMode;
var
  SysReg  : TRegIniFile;
  SubKeys : TStringList;
  I : integer;
  Description,
  SubKey  : string;
  Icon : TIcon;
  Metafile : TUIMetafile;
  Readable,
  ReadWritable : boolean;
begin
  with Listview.Columns.Add do
  begin
    Caption := 'Server';
    Width := 230
  end;
  with Listview.Columns.Add do
  begin
    Caption := 'CLSID';
    Width := 280
  end;
  with Listview.Columns.Add do
  begin
    Caption := 'Keys';
    Width := 60
  end;
  Caption := 'Select a R- or R/W-able CLSID';

  Metafile := TUIMetafile.Create;
  Screen.Cursor := crHourglass;
  try
    SysReg := TRegIniFile.Create ('');
    try
      SysReg.RootKey := HKEY_CLASSES_ROOT;
      SysReg.OpenKey ('\CLSID', false);
      SubKeys := TStringList.Create;
      try
        SysReg.ReadSections (SubKeys);
        for I := SubKeys.Count - 1 downto 0 do
        begin
          SubKey := SubKeys [I];
          Readable := SysReg.KeyExists (SubKey + '\Conversion\Readable');
          Readwritable := SysReg.KeyExists (SubKey + '\Conversion\ReadWritable');

          if Readable or ReadWritable then
          begin
            Description := SysReg.ReadString (Subkey, '', '');
            if Description <> '' then
              with ListView.Items, Add do
              begin
                Caption := Description;
                SubItems.Add (SubKey);

                if Readable and ReadWritable then
                  SubItems.Add ('R, R/W')
                else
                  if Readable then
                    SubItems.Add ('R')
                  else
                    SubItems.Add ('R/W');

                Metafile.IconOfClass (OleStdStringToCLSID(SubKey));
                Icon := Metafile.Icon;
                try
                  ImageIndex := SmallImages.AddIcon (Icon);
                  LargeImages.AddIcon (Icon)
                finally
                  Icon.Free
                end
              end
          end
        end
      finally
        SubKeys.Free
      end
    finally
      SysReg.Free
    end
  finally
    Metafile.Free;
    Screen.Cursor := crDefault
  end
end;

procedure TBrowseCLSIDForm2.ExcludeMode;
begin
  Caption := 'Select a CLSID to exclude';
  Stuff
end;

procedure TBrowseCLSIDForm2.SelectIconMode;
begin
  Caption := 'Select a default icon CLSID';
  Stuff
end;

procedure TBrowseCLSIDForm2.Stuff;
var
  SysReg  : TRegIniFile;
  SubKeys : TStringList;
  I : integer;
  Description,
  Name,
  TempDir,
  CLSID,
  Str,
  SubKey  : string;
  SFI: TSHFileInfo;
  Temp : File;
begin
  with Listview.Columns.Add do
  begin
    Caption := 'Ext';
    Width := 50
  end;
  with Listview.Columns.Add do
  begin
    Caption := 'CLSID';
    Width := 300
  end;
  with Listview.Columns.Add do
  begin
    Caption := 'Association';
    Width := 250
  end;

  Screen.Cursor := crHourglass;
  try
// get temp file path
  SetLength (TempDir, MAX_PATH);
  GetTempPath (MAX_PATH, PChar(TempDir));
  SetLength (TempDir, StrLen(PChar(TempDir)));

// Get system imagelist (don't free them later - bad idea (tm)
  SmallImages.ShareImages := true;
  SmallImages.Handle := SHGetFileInfo ('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_SMALLICON);
  LargeImages.ShareImages := true;
  LargeImages.Handle := SHGetFileInfo ('', 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX or SHGFI_LARGEICON);

// Scan registry for file extensions and associated CLSIDS and associations
  SysReg := TRegIniFile.Create ('');
  try
    SysReg.RootKey := HKEY_CLASSES_ROOT;
    SysReg.OpenKey ('', false);
    SubKeys := TStringList.Create;
    try
      SysReg.ReadSections (SubKeys);
      for I := SubKeys.Count - 1 downto 0 do
      begin
        SubKey := SubKeys [I];
        if SubKey [1] = '.' then
        begin
          Str := SysReg.ReadString (SubKey, '', '');
          if Str <> '' then
          begin
            Description := SysReg.ReadString (Str, '', '');
            if Description <> '' then
            begin
              CLSID := SysReg.ReadString (Str + '\clsid', '', '');
              if CLSID <> '' then
                with ListView.Items, Add do
                begin
                  Caption := UpperCase(SubKey);
                  SubItems.Add (CLSID);
                  SubItems.Add (Description);
                  Name := TempDir + '$_temp_$' + SubKey;
                  AssignFile (Temp, Name);
                  Rewrite (Temp);
                  CloseFile (Temp);
                  try
                    SHGetFileInfo (PChar(Name), 0, SFI, SizeOf(SFI), SHGFI_SYSICONINDEX);
                    ImageIndex := SFI.iIcon
                  finally
                    DeleteFile (Name)
                  end
                end
            end
          end
        end
      end
    finally
      SubKeys.Free
    end
  finally
    SysReg.Free
  end
  finally
    Screen.Cursor := crDefault
  end
end;

procedure TBrowseCLSIDForm2.SetSelected (const Value : TCLSIDStr);
var
  Loop : integer;
begin
  with ListView do
    for Loop := 0 to Items.Count - 1 do
      if CompareText (Value, Items[Loop].SubItems [0]) = 0 then
      begin
        FSelected := Value;
        Selected := Items[Loop];
        Selected.MakeVisible (false);
        exit
      end
end;

procedure TBrowseCLSIDForm2.ListViewSelectItem(Sender: TObject; Item: TListItem; Selected: Boolean);
begin
  if Selected then
    FSelected := Item.SubItems[0]
end;

procedure TBrowseCLSIDForm2.ListViewDblClick(Sender: TObject);
begin
  OkBitBtn.Click
end;

procedure TBrowseCLSIDForm2.IconToolButtonClick(Sender: TObject);
begin
  if ReportToolButton.Down then
    ListView.ViewStyle := vsReport
  else
    ListView.ViewStyle := vsIcon
end;

end.