fileextassociate.pas

Delphi VCL Component Pack

   Result := S_OK;
   CreateShortcut(cExeName, CShellDir, '', '', '', cTitle);
   if Assigned(FOnShortcut) then
      FOnShortcut('Desktop', 'Add', Result);
end;

function TFileExtAssociate.CreateShortcutOtherFolder(cExeName, cSubDir, cWorkDir, cParam, cTitle: string; CShellDir: TShortcutItems): HResult;
begin
   Result := S_OK;
   CreateShortcut(cExeName, CShellDir, cSubDir, '', '', cTitle);
   if Assigned(FOnShortcut) then
      FOnShortcut('ProgramsSubDir', 'Add', Result);
end;

function TFileExtAssociate.CreateShortcutQuickLaunch(cExeName, cSubDir, cWorkDir, cParam, cTitle: string; CShellDir: TShortcutItems): HResult;
begin
   Result := S_OK;
   CreateShortcut(cExeName, CShellDir, '', '', '', cTitle);
   if Assigned(FOnShortcut) then
      FOnShortcut('QuickLaunch', 'Add', Result);
end;

function TFileExtAssociate.RemoveShortcuts(rmExeName: string): HResult;
var
   FolderPath: WideString;
   Reg: TRegIniFile;
   FName, IName: string;
begin
   if rmExeName = '' then
      begin
         rmExeName := Application.ExeName;
         FApplicationDetails.FAppExeName := rmExeName;
         if not FileExists(rmExeName) then
            if Assigned(FOnError) then
               FOnError('Error occured while removing shortcuts. (nil Exe file)');
         Result := S_FALSE;
         Exit;
      end
   else
      begin
         Reg := TRegIniFile.Create(SHELL_FOLDERS_ROOT);
         IName := ExtractFileName(rmExeName);
         FName := ChangeFileExt(IName, '.lnk');
         try
            FolderPath := Reg.ReadString('Shell Folders', 'Programs', '') + '\' + FAppShortcuts.FMenuSubDir;
            if FileExists(FolderPath + '\' + FName) and
               DeleteFile(FolderPath + '\' + FName) then
               begin
                  Result := S_OK;
                  RemoveDir(FolderPath);
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end
            else
               begin
                  Result := S_FALSE;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end;

            FolderPath := Reg.ReadString('Shell Folders', 'Desktop', '');
            if FileExists(FolderPath + '\' + FName) and
               DeleteFile(FolderPath + '\' + FName) then
               begin
                  Result := S_OK;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('Desktop', 'Remove', Result);
               end
            else
               begin
                  Result := S_FALSE;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end;
            FolderPath := Reg.ReadString('Shell Folders', 'Startup', '');
            if FileExists(FolderPath + '\' + FName) and
               DeleteFile(FolderPath + '\' + FName) then
               begin
                  Result := S_OK;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('Startup', 'Remove', Result);
               end
            else
               begin
                  Result := S_FALSE;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end;
            FolderPath := Reg.ReadString('Shell Folders', 'Start Menu', '');
            if FileExists(FolderPath + '\' + FName) and
               DeleteFile(FolderPath + '\' + FName) then
               begin
                  Result := S_OK;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('Start Menu', 'Remove', Result);
               end
            else
               begin
                  Result := S_FALSE;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end;
            FolderPath := Reg.ReadString('Shell Folders', 'SendTo', '');
            if FileExists(FolderPath + '\' + FName) and
               DeleteFile(FolderPath + '\' + FName) then
               begin
                  Result := S_OK;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('SendTo', 'Remove', Result);
               end
            else
               begin
                  Result := S_FALSE;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end;
            FolderPath := Reg.ReadString('Shell Folders', 'Programs', '');
            if FileExists(FolderPath + '\' + FName) and
               DeleteFile(FolderPath + '\' + FName) then
               begin
                  Result := S_OK;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('Programs', 'Remove', Result);
               end
            else
               begin
                  Result := S_FALSE;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end;
            FolderPath := Reg.ReadString('Shell Folders', 'AppData', '') +
               '\Microsoft\Internet Explorer\Quick Launch';
            if FileExists(FolderPath + '\' + FName) and
               DeleteFile(FolderPath + '\' + FName) then
               begin
                  Result := S_OK;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('Quick Launch', 'Remove', Result);
               end
            else
               begin
                  Result := S_FALSE;
                  if Assigned(FOnShortcut) then
                     FOnShortcut('ProgramsSubDir', 'Remove', Result);
               end;
         finally
            Reg.Free;
         end;
      end;
end;

function TFileExtAssociate.UpdateShortcutItemValue: LongInt;
const
   AcardShortcutItemValues: array[TShortcutItems] of Cardinal =
   ($01, $02, $03, $04, $05, $06, $07, $08);
var
   i: TShortcutItems;
   j: Longint;
begin
   j := 0;
   if (FAppShortcuts.FOptions <> []) then
      for i := Low(TShortcutItems) to High(TShortcutItems)
         do
         if (i in FAppShortcuts.FOptions) then
            Inc(j, AcardShortcutItemValues[i]);
   Result := j;
end;

//==============================================================================

function FormatSize(Byte: Double): string;
begin
   if (Byte < 1024) then
      Result := Format('%.2n b', [Byte])
   else
      begin
         Byte := (Byte / 1024);
         if (Byte < 1024) then
            Result := Format('%.2n Kb', [Byte])
         else
            begin
               Byte := (Byte / 1024);
               Result := Format('%.2n Mb', [Byte]);
            end;
      end;
end;

procedure GetFileInfo(Path: string; var Info: TFileInfo);
var
   SHFileInfo: TSHFileInfo;
   SearchRec: TSearchRec;
   intFileAge: Integer;
begin
   if Trim(Path) = '' then
      Exit;
   ShGetFileInfo(PChar(Path), 0, SHFileInfo, SizeOf(TSHFileInfo),
      SHGFI_TYPENAME or SHGFI_DISPLAYNAME or SHGFI_SYSICONINDEX or SHGFI_ICON);
   with Info do
      begin
         Icon := SHFileInfo.hIcon;
         Image := SHFileInfo.iIcon;
         DisplayName := SHFileInfo.szDisplayName;
         TypeName := SHFileInfo.szTypeName;
{$IFDEF DELPHI_6_UP}{$WARN SYMBOL_DEPRECATED OFF}{$ENDIF}
         intFileAge := FileAge(Path);
         if intFileAge > -1 then
            DateTime := FileDateToDateTime(intFileAge);
{$IFDEF DELPHI_6_UP}{$WARN SYMBOL_DEPRECATED ON}{$ENDIF}
         FindFirst(Path, 0, SearchRec);
         Size := SearchRec.Size;
         SizeAsString := FormatSize(Size);
         FindClose(searchRec);
      end;

end;

function TFileExtAssociate.GetExeByExtension(sExt: string): string;
var
   sExtDesc: string;
begin
   with TRegistry.Create do
      begin
         try
            if sExt = '' then
               begin
                  if Assigned(FOnError) then
                     FOnError('Can not locate a null extension');
                  Result := '';
                  Exit;
               end;
            if AnsiPos('.', sExt) = 0 then
               sExt := '.' + sExt;
            RootKey := HKEY_CLASSES_ROOT;
            if OpenKeyReadOnly(sExt) then
               begin
                  sExtDesc := ReadString('');
                  CloseKey;
               end;
            if sExtDesc <> '' then
               begin
                  if OpenKeyReadOnly(sExtDesc + '\Shell\Open\Command') then
                     Result := ReadString('');
               end;
         finally
            Free;
         end;
      end;

   if Result <> '' then
      begin
         if Result[1] = '"' then
            begin
               Result := Copy(Result, 2, -1 + Pos('"', Copy(Result, 2, MaxINt)));
            end
      end;
end;

function TFileExtAssociate.GetIconByExtension(Extension: string; Small: Boolean): HIcon;
var
   Info: TSHFileInfo;
   Flags: Cardinal;
begin
   if Small then
      Flags := SHGFI_ICON or SHGFI_SMALLICON or SHGFI_USEFILEATTRIBUTES
   else
      Flags := SHGFI_ICON or SHGFI_LARGEICON or SHGFI_USEFILEATTRIBUTES;
   if AnsiPos('.', Extension) = 0 then
      Extension := '.' + Extension;
   SHGetFileInfo(PChar(Extension), FILE_ATTRIBUTE_NORMAL, Info, SizeOf(TSHFileInfo), Flags);
   Result := Info.hIcon;
end;

function TFileExtAssociate.GetFileDisplayName(const Path: string): string;
var
   Info: TFileInfo;
begin
   GetFileInfo(Path, Info);
   Result := Info.DisplayName;
end;

function TFileExtAssociate.GetFileSize(const Path: string): string;
var
   Info: TFileInfo;
begin
   GetFileInfo(Path, Info);
   Result := Info.SizeAsString;
end;

function TFileExtAssociate.GetFileTypeName(const Path: string): string;
var
   Info: TFileInfo;
begin
   GetFileInfo(Path, Info);
   Result := Info.TypeName;
end;

function TFileExtAssociate.GetFileImage(const Path: string): Integer;
var
   Info: TFileInfo;
begin
   GetFileInfo(Path, Info);
   Result := Info.Image;
end;

function TFileExtAssociate.GetFileIcon(const Path: string): HIcon;
var
   Info: TFileInfo;
begin
   GetFileInfo(Path, Info);
   Result := Info.Icon;
end;

function TFileExtAssociate.GetFileDateTime(const Path: string): TDateTime;
var
   Info: TFileInfo;
begin
   GetFileInfo(Path, Info);
   Result := Info.DateTime;
end;

end.