jvqwindialogs.pas

East make Tray Icon in delphi

  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;

implementation

uses
  {$IFDEF UNITVERSIONING}
  JclUnitVersioning,
  {$ENDIF UNITVERSIONING}
  JvQResources;

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;



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

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



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

const
  SHFMT_ID_DEFAULT = $FFFF;
  SHFMT_OPT_FULL = $0001;
  SHFMT_OPT_SYSONLY = $0002;
  // Special return values. PLEASE NOTE that these are DWORD values.
  SHFMT_ERROR = $FFFFFFFF; // Error on last format
  // drive may be formatable
  SHFMT_CANCEL = $FFFFFFFE; // Last format wascanceled
  SHFMT_NOFORMAT = $FFFFFFFD; // Drive is not formatable

type
  LPFNORGFAV = function(Wnd: hWnd; Str: LPTSTR): Integer; stdcall;

function ExtractIconFromFile(FileName: string; Index: Integer): HICON;
var
  iNumberOfIcons: Integer;
begin
  Result := 0;
  if FileExists(FileName) then
  begin
    iNumberOfIcons := ExtractIcon(hInstance, PChar(FileName), Cardinal(-1));
    if (Index >= 0) and (Index < iNumberOfIcons) and (iNumberOfIcons > 0) then
      Result := ExtractIcon(hInstance, PChar(FileName), Index);
  end;
end;

//=== { TJvOrganizeFavoritesDialog } =========================================

function TJvOrganizeFavoritesDialog.Execute: Boolean;
var
  SHModule: THandle;
  Path: string;
  lpfnDoOrganizeFavDlg: LPFNORGFAV;
begin
  Result := False;
  //  lpfnDoOrganizeFavDlg := nil;
  SHModule := SafeLoadLibrary('shdocvw.dll');
  try
    if SHModule <= HINSTANCE_ERROR then
      Exit;
    Path := GetSpecialFolderPath('Favorites', True) + #0#0;
    lpfnDoOrganizeFavDlg := LPFNORGFAV(GetProcAddress(SHModule, 'DoOrganizeFavDlg'));
    if not Assigned(lpfnDoOrganizeFavDlg) then
      raise EWinDialogError.CreateRes(@RsEFunctionNotSupported);
    lpfnDoOrganizeFavDlg(GetForegroundWindow, PChar(Path));
  finally
    FreeLibrary(SHModule);
  end;
  Result := True;
end;

//=== { TJvAppletDialog } ====================================================

const
  CPL_INIT = 1;
  CPL_GETCOUNT = 2;
  CPL_INQUIRE = 3;
  CPL_SELECT = 4;
  CPL_DBLCLK = 5;
  CPL_STOP = 6;
  CPL_EXIT = 7;
  CPL_NEWINQUIRE = 8;

type
  PCPLInfo = ^TCplInfo;
  TCplInfo = packed record
    idIcon: Integer;
    idName: Integer;
    idInfo: Integer;
    lData: Longint;
  end;



//=== { TJvComputerNameDialog } ==============================================

constructor TJvComputerNameDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FComputerName := '';
end;

function TJvComputerNameDialog.Execute: Boolean;
var
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList;
  NameBuffer: array [0..MAX_PATH] of Char;
  WindowList: Pointer;
begin
  Result := False;

  if Failed(SHGetSpecialFolderLocation(GetForegroundWindow, CSIDL_NETWORK,
    ItemIDList)) then
    Exit;

  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  BrowseInfo.hwndOwner := GetForegroundWindow;
  BrowseInfo.pidlRoot := ItemIDList;
  BrowseInfo.pszDisplayName := NameBuffer;
  BrowseInfo.lpszTitle := PChar(FCaption);
  BrowseInfo.ulFlags := BIF_BROWSEFORCOMPUTER;
  WindowList := DisableTaskWindows(0);
  try
    Result := SHBrowseForFolder(BrowseInfo) <> nil;
  finally
    EnableTaskWindows(WindowList);
    FreePIDL(BrowseInfo.pidlRoot);
  end;
  if Result then
    FComputerName := NameBuffer;
end;

//=== { TJvBrowseFolderDialog } ==============================================

constructor TJvBrowseFolderDialog.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  FFolderName := '';
end;

function TJvBrowseFolderDialog.Execute: Boolean;
var
  BrowseInfo: TBrowseInfo;
  ItemIDList: PItemIDList;
  ItemSelected: PItemIDList;
  NameBuffer: array [0..MAX_PATH] of Char;
  WindowList: Pointer;
begin
  ItemIDList := nil;
  FillChar(BrowseInfo, SizeOf(BrowseInfo), 0);
  BrowseInfo.hwndOwner := GetForegroundWindow;
  BrowseInfo.pidlRoot := ItemIDList;
  BrowseInfo.pszDisplayName := NameBuffer;
  BrowseInfo.lpszTitle := PChar(FCaption);
  BrowseInfo.ulFlags := BIF_RETURNONLYFSDIRS;
  WindowList := DisableTaskWindows(0);
  try
    ItemSelected := SHBrowseForFolder(BrowseInfo);
    Result := ItemSelected <> nil;
  finally