?
Solved

Show only ExtentionLESS files in TOpenDialog in Delphi

Posted on 2009-04-28
7
Medium Priority
?
707 Views
Last Modified: 2013-11-23
How do I create a file filter rule to use with TOpenDialog in Delphi that will only dispaly files that have no extention?
0
Comment
Question by:manney_mcvicker
7 Comments
 
LVL 21

Expert Comment

by:developmentguru
ID: 24251469
 It looks like this will require creating a custom File Open Dialog.  The only two filters I got to show the extensionless file were *.* and * but they included all other files.

  If you create your own dialog you can use the Delphi functions to find the extensionless files and populate the control yourself.

  From what I can see there is no easy way to do this.
0
 
LVL 8

Expert Comment

by:BdLm
ID: 24254475
use  http://delphi.about.com/od/vclwriteenhance/a/tfindfile.html
for a own filedialog

uses FindFile;
...
procedure TfrMain.Button2Click(Sender:  TObject) ;
var FFile : TFindFile;
begin
  FFile :=  TFindFile.Create(nil) ;
  try
   FFile.FileAttr :=  [ffaAnyFile];
   FFile.InSubFolders := True;
   FFile.Path :=  ExtractFilePath(ParamStr(0)) ;
   FFIle.FileMask := '*.pas';

    Memo1.Lines := FFile.SearchForFiles;
  finally
   FFile.Free;
   end;
end;
0
 
LVL 8

Expert Comment

by:BdLm
ID: 24255065
not completly functiinal code, hope you can fix ...
unit findfile;
 
interface
 
uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs, FileCtrl;
 
type
  TFileAttrKind = (ffaReadOnly, ffaHidden, ffaSysFile, ffaVolumeID, ffaDirectory, ffaArchive, ffaAnyFile);
  TFileAttr = set of TFileAttrKind;
 
  TFindFile = class(TComponent)
  private
    s : TStringList;
 
    fSubFolder : boolean;
    fAttr: TFileAttr;
    fPath : string;
    fFileMask : string;
 
    fnoExt   :  Boolean;
 
    procedure SetPath(Value: string);
    procedure FileSearch(const inPath : string);
    procedure DeleteFilesfromList;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
 
    function SearchForFiles: TStringList;
  published
    property FileAttr: TFileAttr read fAttr write fAttr;
    property InSubFolders : boolean read fSubFolder write fSubFolder;
    property Path : string read fPath write SetPath;
    property FileMask : string read fFileMask write fFileMask ;
  end;
 
procedure Register;
 
implementation
 
procedure Register;
begin
  RegisterComponents('About.com ', [TFindFile]);
end;
 
constructor TFindFile.Create(AOwner: TComponent);
begin
  inherited Create(AOwner);
  Path := IncludeTrailingBackslash(GetCurrentDir); 
  FileMask := '*.*';
  FileAttr := [ffaAnyFile];
  s := TStringList.Create;
end;
 
destructor TFindFile.Destroy;
begin
  s.Free;
  inherited Destroy;
end;
 
procedure TFindFile.SetPath(Value: string);
begin
  if fPath <> Value then
  begin
    if Value <> '' then
      if DirectoryExists(Value) then
        fPath := IncludeTrailingBackslash(Value);
  end;
end;
 
procedure TFindFile.DeleteFilesfromList ;
var  i,j  :  Integer;
begin
  //  case of empty filemask delete all string with Pos('.',...) > 0
 
 if fNoExt then
  begin
 
  for i := 0 to s.Count-1 do
      if (( Pos('.', s[i])> 0) or ( Pos(':', s[i])> 0)) then s[i] :='';
 
 
  repeat
      j := s.IndexOf('');
 
      if j>0 then s.Delete(j);
 
  until  j= -1;
  end;
 
end;
 
 
function TFindFile.SearchForFiles: TStringList;
begin
  s.Clear;
  try
    FileSearch(Path);
  finally
    deleteFilesfromList;
    Result := s;
  end;
end;
 
procedure TFindFile.FileSearch(const InPath : string);
var Rec  : TSearchRec;
    Attr : integer;
    i,j  : integer;
begin
 
// case of empty file ext. look for all files ...
if (FileMask='') then begin
                      FileMask := '*.*';
                      fNoExt := true;
                      end
                      else
                      fNoExt := false;
 
Attr := 0;
if ffaReadOnly in FileAttr then Attr := Attr + faReadOnly;
if ffaHidden in FileAttr then Attr := Attr + faHidden;
if ffaSysFile in FileAttr then Attr := Attr + faSysFile;
if ffaVolumeID in FileAttr then Attr := Attr + faVolumeID;
if ffaDirectory in FileAttr then Attr := Attr + faDirectory;
if ffaArchive in FileAttr then Attr := Attr + faArchive;
if ffaAnyFile in FileAttr then Attr := Attr + faAnyFile;
 
if SysUtils.FindFirst(inPath + FileMask, Attr, Rec) = 0 then
 try
   repeat
     s.Add(inPath + Rec.Name);
   until SysUtils.FindNext(Rec) <> 0;
 finally
   SysUtils.FindClose(Rec);
 end;
 
If not InSubFolders then Exit;
 
if SysUtils.FindFirst(inPath + '*.*', faDirectory, Rec) = 0 then
 try
   repeat
   if ((Rec.Attr and faDirectory) <> 0)  and (Rec.Name<>'.') and (Rec.Name<>'..') then
     begin
       FileSearch(IncludeTrailingBackslash(inPath + Rec.Name));
     end;
   until SysUtils.FindNext(Rec) <> 0;
 finally
   SysUtils.FindClose(Rec);
 end;
 
 
 
 
 
 
 
end;
 
 
 
end.
 
{
********************************************
Zarko Gajic
About.com Guide to Delphi Programming
http://delphi.about.com
email: delphi.guide@about.com
free newsletter: http://delphi.about.com/library/blnewsletter.htm
forum: http://forums.about.com/ab-delphi/start/
********************************************
}

Open in new window

0
What does it mean to be "Always On"?

Is your cloud always on? With an Always On cloud you won't have to worry about downtime for maintenance or software application code updates, ensuring that your bottom line isn't affected.

 
LVL 26

Assisted Solution

by:Eddie Shipman
Eddie Shipman earned 60 total points
ID: 24263774
There really is no way to do that.
Do this instead:
procedure TForm1.OpenDialog1CanClose(Sender: TObject;
  var CanClose: Boolean);
var
  Ext: String;
begin  
  Ext := ExtractFileExt(OpenDialog1.FileName);
  CanClose := (Length(Trim(Ext)) = 0);
  if not CanClose then
    MessageBox(0, 'Please choose only files that have no extensions', 'Invalid File', MB_ICONWARNING or MB_OK);
end;  

Open in new window

0
 
LVL 26

Expert Comment

by:Eddie Shipman
ID: 24263785
One other way would be to get the handle to the ListView in the OpenDialog and removing the items that have an extension, yourself, but that is much harder work.
0
 

Author Comment

by:manney_mcvicker
ID: 24268081
Thanks for all your posts.

I was going to create my own custom open dialog originally, but was hoping someone had a clever solution that derived from the base dialog class TOpenDialog
0
 
LVL 8

Accepted Solution

by:
BdLm earned 90 total points
ID: 24268109
what about a TExtOpenDialog = class (TObenDialog)
in case of empty ext search for *.*  and in a second step delete again as in My proposed solution

TOpenDialog = class(TCommonDialog)
  private
    FHistoryList: TStrings;
    FOptions: TOpenOptions;
    FFilter: string;
    FFilterIndex: Integer;
    FCurrentFilterIndex: Integer;
    FInitialDir: string;
    FTitle: string;
    FDefaultExt: string;
    FFileName: TFileName;
    FFiles: TStrings;
    FFileEditStyle: TFileEditStyle;
    FOnSelectionChange: TNotifyEvent;
    FOnFolderChange: TNotifyEvent;
    FOnTypeChange: TNotifyEvent;
    FOnCanClose: TCloseQueryEvent;
    FOnIncludeItem: TIncludeItemEvent;
    FOptionsEx: TOpenOptionsEx;
    function GetFileName: TFileName;
    function GetFilterIndex: Integer;
    procedure ReadFileEditStyle(Reader: TReader);
    procedure SetHistoryList(Value: TStrings);
    procedure SetInitialDir(const Value: string);
  protected
    function CanClose(var OpenFileName: TOpenFileName): Boolean;
    function DoCanClose: Boolean; dynamic;
    function DoExecute(Func: Pointer): Bool;
    procedure DoSelectionChange; dynamic;
    procedure DoFolderChange; dynamic;
    procedure DoTypeChange; dynamic;
    procedure DoIncludeItem(const OFN: TOFNotifyEx; var Include: Boolean); dynamic;
    procedure DefineProperties(Filer: TFiler); override;
    procedure GetFileNames(var OpenFileName: TOpenFileName);
    function GetStaticRect: TRect; virtual;
    procedure WndProc(var Message: TMessage); override;
  public
    constructor Create(AOwner: TComponent); override;
    destructor Destroy; override;
    function Execute: Boolean; override;
    property FileEditStyle: TFileEditStyle read FFileEditStyle write FFileEditStyle;
    property Files: TStrings read FFiles;
    property HistoryList: TStrings read FHistoryList write SetHistoryList;
  published
    property DefaultExt: string read FDefaultExt write FDefaultExt;
    property FileName: TFileName read GetFileName write FFileName;
    property Filter: string read FFilter write FFilter;
    property FilterIndex: Integer read GetFilterIndex write FFilterIndex default 1;
    property InitialDir: string read FInitialDir write SetInitialDir;
    property Options: TOpenOptions read FOptions write FOptions default [ofHideReadOnly, ofEnableSizing];
    property OptionsEx: TOpenOptionsEx read FOptionsEx write FOptionsEx default [];
    property Title: string read FTitle write FTitle;
    property OnCanClose: TCloseQueryEvent read FOnCanClose write FOnCanClose;
    property OnFolderChange: TNotifyEvent read FOnFolderChange write FOnFolderChange;
    property OnSelectionChange: TNotifyEvent read FOnSelectionChange write FOnSelectionChange;
    property OnTypeChange: TNotifyEvent read FOnTypeChange write FOnTypeChange;
    property OnIncludeItem: TIncludeItemEvent read FOnIncludeItem write FOnIncludeItem;
  end;

Open in new window

0

Featured Post

Concerto Cloud for Software Providers & ISVs

Can Concerto Cloud Services help you focus on evolving your application offerings, while delivering the best cloud experience to your customers? From DevOps to revenue models and customer support, the answer is yes!

Learn how Concerto can help you.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Introduction Raise your hands if you were as upset with FireMonkey as I was when I discovered that there was no TListview.  I use TListView in almost all of my applications I've written, and I was not going to compromise by resorting to TStringGrid…
We’ve all felt that sense of false security before—locking down external access to a database or component and feeling like we’ve done all we need to do to secure company data. But that feeling is fleeting. Attacks these days can happen in many w…
Is your data getting by on basic protection measures? In today’s climate of debilitating malware and ransomware—like WannaCry—that may not be enough. You need to establish more than basics, like a recovery plan that protects both data and endpoints.…
Suggested Courses
Course of the Month13 days, 16 hours left to enroll

807 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question