jvwindialogs.pas

East make Tray Icon in delphi

    // Value returned by the function called by Execute.
    // Possible return values:
    // S_OK -  content type succesfully associated with the extnesion
    // S_FALSE - nothing was registered (f ex a one time registration)
    property ReturnValue: HRESULT read FReturnValue;
  published
    // The file (type) to associate with the Protocol
    // NB! FileName *must* contain an extension!
    property FileName: TFileName read FFileName write FFileName;
    // The URL with the protocol to assoiacte with FileName
    // NB! if URL has no protocol (i.e "http://", "mailto:", "home-made:", etc),
    // the function fails even before the dialog is displayed!
    property URL: string read FURL write FURL;
    // DefaultProtocol to prepend to URL if it doesn't have a protocol
    property DefaultProtocol: string read FDefaultProtocol write FDefaultProtocol;
    // Options for the dialog
    property Options: TJvURLAssociationDialogOptions read FOptions write FOptions default [];
  end;

  TJvMIMEAssociationOption = (maRegisterAssoc);
  TJvMIMEAssociationOptions = set of TJvMIMEAssociationOption;

  TJvMIMEAssociationDialog = class(TJvCommonDialogF)
  private
    FContentType: string;
    FAssociatedApp: string;
    FFileName: TFileName;
    FOptions: TJvMIMEAssociationOptions;
    FReturnValue: HRESULT;
    function GetParentHandle: THandle;
  public
    function Execute: Boolean; override;
    // After Execute, contains the path and filename to the associated application (if user didn't cancel)
    property AssociatedApp: string read FAssociatedApp;
    // Value returned by the function called by Execute.
    // Possible return values:
    // S_OK -  content type succesfully associated with the extnesion
    // S_FALSE - nothing was registered
    // E_ABORT - user cancelled
    // E_FLAGS - invalid flag combination
    // E_OUTOFMEMORY - out of memory
    // E_POINTER - one of the input pointers are invalid
    property ReturnValue: HRESULT read FReturnValue;
  published
    // The file (type) to associate with the Protocol
    // NB! FileName *must* contain an extension!
    property FileName: TFileName read FFileName write FFileName;
    // The MIME contentype of FileName
    property ContentType: string read FContentType write FContentType;
    property Options: TJvMIMEAssociationOptions read FOptions write FOptions default [];
  end;

const
  SOFTDIST_FLAG_USAGE_EMAIL = $0001;
  {$EXTERNALSYM SOFTDIST_FLAG_USAGE_EMAIL}
  SOFTDIST_FLAG_USAGE_PRECACHE = $0002;
  {$EXTERNALSYM SOFTDIST_FLAG_USAGE_PRECACHE}
  SOFTDIST_FLAG_USAGE_AUTOINSTALL = $0003;
  {$EXTERNALSYM SOFTDIST_FLAG_USAGE_AUTOINSTALL}
  SOFTDIST_FLAG_DELETE_SUBSCRIPTION = $0004;
  {$EXTERNALSYM SOFTDIST_FLAG_DELETE_SUBSCRIPTION}

type
  _tagSOFTDISTINFO = packed record
    cbSize: ULONG;
    dwFlags: DWORD;
    dwAdState: DWORD;
    lpszTitle: LPWSTR;
    lpszAbstract: LPWSTR;
    lpszHREF: LPWSTR;
    dwInstalledVersionMS: DWORD;
    dwInstalledVersionLS: DWORD;
    dwUpdateVersionMS: DWORD;
    dwUpdateVersionLS: DWORD;
    dwAdvertisedVersionMS: DWORD;
    dwAdvertisedVersionLS: DWORD;
    cbReserved: DWORD;
  end;
  {$EXTERNALSYM _tagSOFTDISTINFO}
  {$EXTERNALSYM SOFTDISTINFO}
  SOFTDISTINFO = _tagSOFTDISTINFO;
  {$EXTERNALSYM SOFTDISTINFO}
  LPSOFTDISTINFO = ^_tagSOFTDISTINFO;
  {$EXTERNALSYM LPSOFTDISTINFO}
  TSoftDistInfo = SOFTDISTINFO;

  TJvSoftwareUpdateAdState = (asNone, asAvailable, asDownloaded, asInstalled);
  TJvSoftwareUpdateFlags = (ufEmail, ufPreCache, ufAutoInstall, ufDeleteSubscription);

  TJvSoftwareUpdateInfo = class(TPersistent)
  private
    FInstalledVersionMS: DWORD;
    FUpdateVersionLS: DWORD;
    FUpdateVersionMS: DWORD;
    FAdvertisedVersionMS: DWORD;
    FAdvertisedVersionLS: DWORD;
    FInstalledVersionLS: DWORD;
    FDescription: string;
    FTitle: string;
    FHREF: string;
    FAdState: TJvSoftwareUpdateAdState;
    FFlags: TJvSoftwareUpdateFlags;
    function GetSoftDistInfo: TSoftDistInfo;
    procedure SetSoftDistInfo(const Value: TSoftDistInfo);
  public
    property SoftDistInfo: TSoftDistInfo read GetSoftDistInfo write SetSoftDistInfo;
  published
    property AdState: TJvSoftwareUpdateAdState read FAdState write FAdState;
    property Flags: TJvSoftwareUpdateFlags read FFlags write FFlags;
    property Title: string read FTitle write FTitle;
    property HREF: string read FHREF write FHREF;
    property Description: string read FDescription write FDescription;
    property InstalledVersionMS: DWORD read FInstalledVersionMS write FInstalledVersionMS;
    property InstalledVersionLS: DWORD read FInstalledVersionLS write FInstalledVersionLS;
    property UpdateVersionMS: DWORD read FUpdateVersionMS write FUpdateVersionMS;
    property UpdateVersionLS: DWORD read FUpdateVersionLS write FUpdateVersionLS;
    property AdvertisedVersionMS: DWORD read FAdvertisedVersionMS write FAdvertisedVersionMS;
    property AdvertisedVersionLS: DWORD read FAdvertisedVersionLS write FAdvertisedVersionLS;
  end;

  // (p3) encapsulation of the SoftwareUpdateMessageBox ( for CDF file updating)
  TJvSoftwareUpdateDialog = class(TJvCommonDialogF)
  private
    FReturnValue: Cardinal;
    FDistributionUnit: string;
    FDistInfo: TJvSoftwareUpdateInfo;
  public
    function Execute: Boolean; override;
    property ReturnValue: Cardinal read FReturnValue;
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
  published
    property DistributionUnit: string read FDistributionUnit write FDistributionUnit;
    property DistInfo: TJvSoftwareUpdateInfo read FDistInfo write FDistInfo;
  end;

// Tools routines
function GetSpecialFolderPath(const FolderName: string; CanCreate: Boolean): string;
procedure AddToRecentDocs(const FileName: string);
procedure ClearRecentDocs;
function ExtractIconFromFile(FileName: string; Index: Integer): HICON;
function CreateShellLink(const AppName, Desc: string; Dest: string): string;
procedure GetShellLinkInfo(const LinkFile: WideString; var SLI: TShellLinkInfo);
procedure SetShellLinkInfo(const LinkFile: WideString; const SLI: TShellLinkInfo);
function RecycleFile(FileToRecycle: string): Boolean;
function CopyFile(FromFile, ToDir: string): Boolean;
function ShellObjectTypeEnumToConst(ShellObjectType: TShellObjectType): UINT;
function ShellObjectTypeConstToEnum(ShellObjectType: UINT): TShellObjectType;
function ShellMessageBox(Instance: THandle; Owner: HWND; Text: PChar;
  Caption: PChar; Style: UINT; Parameters: array of Pointer): Integer; cdecl;

type
  FreePIDLProc = procedure(PIDL: PItemIDList); stdcall;
  SHChangeIconProc = function(Wnd: HWND; szFileName: PChar; Reserved: Integer;
    var lpIconIndex: Integer): DWORD; stdcall;
  SHChangeIconProcW = function(Wnd: HWND; szFileName: PWideChar;
    Reserved: Integer; var lpIconIndex: Integer): DWORD; stdcall;
  SHFormatDriveProc = function(Wnd: HWND; Drive: UINT; fmtID: UINT;
    Options: UINT): DWORD; stdcall;
  SHShutDownDialogProc = procedure(Wnd: HWND); stdcall;
  SHRunDialogProc = function(Wnd: HWND; Unknown1: Integer; Unknown2: Pointer;
    szTitle: PChar; szPrompt: PChar; uiFlages: Integer): DWORD; stdcall;
  SHFindFilesProc = function(Root: PItemIDList; SavedSearchFile: PItemIDList): LongBool; stdcall;
  SHFindComputerProc = function(Reserved1: PItemIDList; Reserved2: PItemIDList): LongBool; stdcall;
  SHObjectPropertiesProc = function(Owner: HWND; Flags: UINT;
    ObjectName: Pointer; InitialTabName: Pointer): LongBool; stdcall;
  SHNetConnectionDialogProc = function(Owner: HWND; ResourceName: Pointer;
    ResourceType: DWORD): DWORD; stdcall;
  SHStartNetConnectionDialogProc = function(Owner: HWND;
    ResourceName: PWideChar; ResourceType: DWORD): DWORD; stdcall;
  SHOutOfMemoryMessageBoxProc = function(Owner: HWND; Caption: Pointer;
    Style: UINT): Integer; stdcall;
  SHHandleDiskFullProc = procedure(Owner: HWND; uDrive: UINT); stdcall;
  NewLinkHereProc = procedure(HWND: THandle; HInstance: THandle; CmdLine: PChar;
    CmdShow: Integer); stdcall;
  SHOpenWithProc = procedure(HWND: THandle; HInstance: THandle; CmdLine: PChar;
    CmdShow: Integer); stdcall;
  GetOpenFileNameExProc = function(var OpenFile: TOpenFileNameEx): BOOL; stdcall;
  GetSaveFileNameExProc = function(var SaveFile: TOpenFileNameEx): BOOL; stdcall;
  URLAssociationDialogProcA = function(hwndParent: HWND; dwInFlags: DWORD; const pcszFile: PChar; const pcszURL: PChar;
    pszBuff: PChar; ucAppBufLen: UINT): HRESULT; stdcall;
  URLAssociationDialogProcW = function(hwndParent: HWND; dwInFlags: DWORD; const pcszFile: PWideChar; const pcszURL:
    PWideChar; pszBuff: PWideChar; ucAppBufLen: UINT): HRESULT; stdcall;

  MIMEAssociationDialogProcA = function(hwndParent: HWND; dwInFlags: DWORD;
    const pcszFile: PChar; const pcszMIMEContentType: PChar; pszAppBuf: PChar; ucAppBufLen: UINT): HRESULT; stdcall;
  MIMEAssociationDialogProcW = function(hwndParent: HWND; dwInFlags: DWORD;
    const pcszFile: PWideChar; const pcszMIMEContentType: PWideChar; pszAppBuf: PWideChar;
      ucAppBufLen: UINT): HRESULT; stdcall;
  SoftwareUpdateMessageBoxProc = function(hWnd: HWND; szDistUnit: LPCWSTR; dwFlags: DWORD;
    var psdi: TSoftDistInfo): DWORD; stdcall;

var
  FreePIDL: FreePIDLProc = nil;
  GetOpenFileNameEx: GetOpenFileNameExProc = nil;
  GetSaveFileNameEx: GetSaveFileNameExProc = nil;
  SHFormatDrive: SHFormatDriveProc = nil;
  SHShutDownDialog: SHShutDownDialogProc = nil;
  SHRunDialog: SHRunDialogProc = nil;
  SHFindFiles: SHFindFilesProc = nil;
  SHFindComputer: SHFindComputerProc = nil;
  SHObjectProperties: SHObjectPropertiesProc = nil;
  SHNetConnectionDialog: SHNetConnectionDialogProc = nil;
  SHStartNetConnectionDialog: SHStartNetConnectionDialogProc = nil;
  SHOutOfMemoryMessageBox: SHOutOfMemoryMessageBoxProc = nil;
  SHHandleDiskFull: SHHandleDiskFullProc = nil;
  NewLinkHere: NewLinkHereProc = nil;
  SHOpenWith: SHOpenWithProc = nil;
  SHChangeIcon: SHChangeIconProc = nil;
  SHChangeIconW: SHChangeIconProcW = nil;
  URLAssociationDialogA: URLAssociationDialogProcA = nil;
  MIMEAssociationDialogA: MIMEAssociationDialogProcA = nil;
//  URLAssociationDialogW: URLAssociationDialogProcW = nil;
//  MIMEAssociationDialogW: MIMEAssociationDialogProcW = nil;
  SoftwareUpdateMessageBox: SoftwareUpdateMessageBoxProc = nil;

{$IFDEF UNITVERSIONING}
const
  UnitVersioning: TUnitVersionInfo = (
    RCSfile: '$RCSfile: JvWinDialogs.pas,v $';
    Revision: '$Revision: 1.32 $';
    Date: '$Date: 2005/02/17 10:21:17 $';
    LogPath: 'JVCL\run'
  );
{$ENDIF UNITVERSIONING}

implementation

uses
  JvResources;

const
  Shell32 = 'shell32.dll';
  URLASSOCDLG_FL_USE_DEFAULT_NAME = $0001;
  URLASSOCDLG_FL_REGISTER_ASSOC = $0002;
  MIMEASSOCDLG_FL_REGISTER_ASSOC = $0001;

var
  ShellHandle: THandle = 0;
  CommHandle: THandle = 0;
  AppWizHandle: THandle = 0;
  URLHandle: THandle = 0;
  SHDocvwHandle: THandle = 0;

{$IFDEF VisualCLX}

function GetForegroundWindow: HWND;
begin
  Result := Windows.GetForegroundWindow;
end;

function GetDesktopWindow: HWND;
begin
  Result := Windows.GetDesktopWindow;
end;

{$ENDIF VisualCLX}

procedure LoadJvDialogs;
begin
  ShellHandle := LoadLibrary(PChar(Shell32));
  if ShellHandle > 0 then
  begin
    if Win32Platform = VER_PLATFORM_WIN32_NT then
      @SHChangeIconW := GetProcAddress(ShellHandle, PChar(62))
    else
      @SHChangeIcon := GetProcAddress(ShellHandle, PChar(62));
    @SHFormatDrive := GetProcAddress(ShellHandle, PChar('SHFormatDrive'));
    @FreePIDL := GetProcAddress(ShellHandle, PChar(155));
    @SHShutDownDialog := GetProcAddress(ShellHandle, PChar(60));
    @SHRunDialog := GetProcAddress(ShellHandle, PChar(61));
    @SHFindFiles := GetProcAddress(ShellHandle, PChar(90));
    @SHFindComputer := GetProcAddress(ShellHandle, PChar(91));
    @SHObjectProperties := GetProcAddress(ShellHandle, PChar(178));
    @SHNetConnectionDialog := GetProcAddress(ShellHandle, PChar(160));
    @SHOutOfMemoryMessageBox := GetProcAddress(ShellHandle, PChar(126));
    @SHHandleDiskFull := GetProcAddress(ShellHandle, PChar(185));
    @SHStartNetConnectionDialog := GetProcAddress(ShellHandle, PChar(215));
    @SHOpenWith := GetProcAddress(ShellHandle, PChar('OpenAs_RunDLLA'));
  end;

  CommHandle := LoadLibrary('comdlg32.dll');
  if CommHandle > 0 then
  begin
    @GetOpenFileNameEx := GetProcAddress(CommHandle, PChar('GetOpenFileNameA'));
    @GetSaveFileNameEx := GetProcAddress(CommHandle, PChar('GetSaveFileNameA'));
  end;

  AppWizHandle := LoadLibrary('appwiz.cpl');
  if AppWizHandle > 0 then
    @NewLinkHere := GetProcAddress(AppWizHandle, PChar('NewLinkHereA'));
  URLHandle := LoadLibrary('url.dll');
  if URLHandle > 0 then
  begin
    @URLAssociationDialogA := GetProcAddress(URLHandle, 'URLAssociationDialogA');
    @MIMEAssociationDialogA := GetProcAddress(URLHandle, 'MIMEAssociationDialogA');
    // the ANSI versions works on NT too, so don't load Unicode alternative
//    @URLAssociationDialogW  := GetProcAddress(URLHandle,'URLAssociationDialogW');
//    @MIMEAssociationDialogW := GetProcAddress(URLHandle,'MIMEAssociationDialogW');
  end;
  SHDocvwHandle := LoadLibrary('shdocvw.dll');
  if SHDocvwHandle > 0 then
    @SoftwareUpdateMessageBox := GetProcAddress(SHDocvwHandle, 'SoftwareUpdateMessageBox');
end;

procedure UnloadJvDialogs;
begin
  if ShellHandle > 0 then
    FreeLibrary(ShellHandle);
  if CommHandle > 0 then
    FreeLibrary(CommHandle);
  if AppWizHandle > 0 then
    FreeLibrary(AppWizHandle);
  if URLHandle > 0 then
    FreeLibrary(URLHandle);
  if SHDocvwHandle > 0 then
    FreeLibrary(SHDocvwHandle);
  ShellHandle := 0;
  CommHandle := 0;
  AppWizHandle := 0;
  URLHandle := 0;
  SHDocvwHandle := 0;
end;

{  Although most Win32 applications do not need to be able
   to format disks, some do. Windows 95 and Windows NT provide
   an API function called SHFormatDrive, which presents the
   same dialog box as the Windows 95 and Windows NT shells,
   formats the specified diskette.

   The SHFormatDrive API provides access to the Shell's format
   dialog box. This allows applications that want to format disks to bring
   up the same dialog box that the Shell uses for disk formatting.

   PARAMETERS
      hwnd    = The window handle of the window that will own the
                dialog. NOTE that hwnd == NULL does not cause this
                dialog to come up as a "top level application"
                window. This parameter should always be non-null,
                this dialog box is only designed to be the child of
                another window, not a stand-alone application.

      Drive   = The 0 based (A: == 0) Drive number of the Drive
                to format.

      fmtID   = Currently must be set to SHFMT_ID_DEFAULT.

      Options = There are currently only two option bits defined.

                   SHFMT_OPT_FULL
                   SHFMT_OPT_SYSONLY

                SHFMT_OPT_FULL specifies that the "Quick Format"
                setting should be cleared by default. If the user
                leaves the "Quick Format" setting cleared, then a
                full format will be applied (this is useful for
                users that detect "unformatted" disks and want
                to bring up the format dialog box).

                If Options is set to zero (0), then the "Quick Format"
                setting is set by default. In addition, if the user leaves
                it set, a quick format is performed. Under Windows NT 4.0,
                this flag is ignored and the "Quick Format" box is always
                checked when the dialog box first appears. The user can
                still change it. This is by design.

                The SHFMT_OPT_SYSONLY initializes the dialog to
                default to just sys the disk.

                All other bits are Reserved for future expansion
                and must be 0.

                Please note that this is a bit field and not a
                value, treat it accordingly.

      RETURN
         The return is either one of the SHFMT_* values, or if
         the returned DWORD value is not == to one of these
         values, then the return is the physical format ID of the
         last successful format. The LOWORD of this value can be
         passed on subsequent calls as the fmtID parameter to
         "format the same type you did last time".