How we can check if a directory is readOnly or Not?
you can use the FileGetAttr function and check if the faReadOnly flag is set.
try this code
function DirIsReadOnly(Path:string):Boolean;
var
attrs : Integer;
begin
attrs := FileGetAttr(Path);
Result := (attrs and faReadOnly) > 0;
end;
Testing if the directory's attribute is R/O is only part of the answer. You can easily have a R/W directory that you still can't write to - because of Access Rights.
The best way to check if you can write to a directory or not is - to try it:
FUNCTION WritableDir(CONST Dir : STRING) : BOOLEAN;
VAR
FIL : FILE;
N : STRING;
I : Cardinal;
BEGIN
REPEAT
N:=IncludeTrailingPathDelimiter(Dir);
FOR I:=1 TO 250-LENGTH(N) DO N:=N+CHAR(RANDOM(26)+65)
UNTIL NOT FileExists(N);
Result:=TRUE;
TRY
AssignFile(FIL,N);
REWRITE(FIL,1);
Result:=FileExists(N); // Not sure if this is needed, but AlainD says so :-)
EXCEPT
Result:=FALSE
END;
IF Result THEN BEGIN
CloseFile(FIL);
ERASE(FIL)
END
END;
The version HeartWare has given is nice but contains two bugs. This modified versions works more reliably and has comments to explain what is going on:
function IsPathWriteable(const cszPath: String) : Boolean;
var
fileTest: file;
szFile: String;
nChar: Cardinal;
begin
// Generate a random filename that does NOT exist in the directory
Result := True;
repeat
szFile := IncludeTrailingPathDelimiter(cszPath);
for nChar:=1 to (250 - Length(szFile)) do
szFile := (szFile + char(Random(26) + 65));
until (not FileExists(szFile));
// Attempt to write the file to the directory. This will fail on something like a CD drive or
// if the user does not have permission, but otherwise should work.
try
AssignFile(fileTest, szFile);
Rewrite(fileTest, 1);
// Note: Actually check for the existence of the file. Windows may appear to have created
// the file, but this fails (without an exception) if advanced security attibutes for the
// folder have denied "Create Files / Write Data" access to the logged in user.
if (not FileExists(szFile)) then
Result := False;
except
Result := False;
end;
// If the file was written to the path, delete it
if (Result) then
begin
CloseFile(fileTest);
Erase(fileTest);
end;
end;
In Windows API way, it is:
fa := GetFileAttributes(PChar(FileName))
if (fa and FILE_ATTRIBUTE_DIRECTORY <> 0) and (fa and FILE_ATTRIBUTE_READONLY <> 0) then
ShowMessage('Directory is read-only');
One possible way is to try list the files in that directory and check for the status. This way we can check whether it is readable. this answer is applicable to 2009 or lower. Remember we have to check whether the folder exists and then whether the folder is readable. you can find the implementation here http://simplebasics.net/delphi-how-to-check-if-you-have-read-permission-on-a-directory/
Related
I'm trying to create a simple example of using IFileOperation to delete the files in a
given directory, to include in the answer to another q for comparison with other methods.
Below is the code of my MRE. It
successfully creates 1000 files in a subdirectory off C:\Temp and then attempts to delete
them in the DeleteFiles method. This supposedly "easy" task fails but I'm not sure
exactly where it comes off the rails. The comments in the code show what I'm expecting
and the actual results. On one occasion, instead of the exception noted, I got a pop-up
asking for confirmation to delete an item with an odd name which was evidently an array of
numbers referring to a shell item, but my attempt to capture it using Ctrl-C failed;
I'm fairly sure I'm either missing a step or two, misusing the interfaces involved
or both. My q is, could anybody please show the necessary corrections to the code to get IFileOperation.DeleteItems() to delete the files in question, as I am completely out of my depth with this stuff? I am not interested in alternative methods of deleting these files, using the shell interfaces or otherwise.
procedure TForm2.DeleteFiles;
var
iFileOp: IFileOperation;
iIDList : ItemIDList;
iItemArray : IShellItemArray;
iArray : Array[0..1] of ItemIDList;
Count : DWord;
begin
iFileOp := CreateComObject(CLSID_FileOperation) as IFileOperation;
iIDList := ILCreateFromPath(sPath)^;
// IFileOperation.DeleteItems seems to require am IShellItemArray, so the following attempts
// to create one
// The definition of SHCreateShellItemArrayFromIDLists
// seems to require a a zero-terminated array of ItemIDLists so the next steps
// attempt to create one
ZeroMemory(#iArray, SizeOf(iArray));
iArray[0] := iIDList;
OleCheck(SHCreateShellItemArrayFromIDLists(1, #iArray, iItemArray));
// Next test the number of items in iItemArray, which I'm expecting to be 1000
// seeing as the CreateFiles routine creats that many
OleCheck(iItemArray.GetCount(Count));
Caption := IntToStr(Count); // Duh, this shows Count to be 1, not the expected 1000
OleCheck(iFileOp.DeleteItems(iItemArray));
OleCheck( iFileOp.PerformOperations );
// Returns Exception 'No object for moniker'
end;
procedure TForm2.Button1Click(Sender: TObject);
begin
DeleteFiles;
end;
procedure CreateFiles;
var
i : Integer;
SL : TStringList;
FileName,
FileContent : String;
begin
SL := TStringList.Create;
try
if not (DirectoryExists(sPath)) then
MkDir(sPath);
SL.BeginUpdate;
for i := 0 to 999 do begin
FileName := Format('File%d.Txt', [i]);
FileContent := Format('content of file %s', [FileName]);
SL.Text := FileContent;
SL.SaveToFile(sPath + '\' + FileName);
end;
SL.EndUpdate;
finally
SL.Free;
end;
end;
procedure TForm2.FormCreate(Sender: TObject);
begin
CreateFiles;
end;
You are leaking the memory returned by ILCreateFromPath(), you need to call ILFree() when you are done using the returned PItemIDList.
Also, you should not be dereferencing the PItemIDList. SHCreateShellItemArrayFromIDLists() expects an array of PItemIDList pointers, but you are giving it an array of ItemIDList instances.
Try this instead:
procedure TForm2.DeleteFiles;
var
iFileOp: IFileOperation;
iIDList : PItemIDList;
iItemArray : IShellItemArray;
Count : DWord;
begin
iFileOp := CreateComObject(CLSID_FileOperation) as IFileOperation;
iIDList := ILCreateFromPath(sPath);
try
OleCheck(SHCreateShellItemArrayFromIDLists(1, #iIDList, iItemArray));
finally
ILFree(iIDList);
end;
// Next test the number of items in iItemArray, which I'm expecting to be 1000
// seeing as the CreateFiles routine creates that many
OleCheck(iItemArray.GetCount(Count));
Caption := IntToStr(Count); // Duh, this shows Count to be 1, not the expected 1000
OleCheck(iFileOp.DeleteItems(iItemArray));
OleCheck( iFileOp.PerformOperations );
// Returns Exception 'No object for moniker'
end;
That being said, even if this were working correctly, you are not creating an IShellItemArray containing 1000 IShellItems for the individual files. You are creating an IShellItemArray containing 1 IShellItem for the C:\Temp subdirectory itself.
Which is fine if your goal is to delete the whole folder. But in that case, I would suggest using SHCreateItemFromIDList() or SHCreateItemFromParsingName() instead, and then pass that IShellItem to IFileOperation.DeleteItem().
But, if your goal is to delete the individual files without deleting the subdirectory as well, then you will have to either:
get the IShellFolder interface for the subdirectory, then enumerate the relative PIDLs of its files using IShellFolder.EnumObjects(), and then pass the PIDLs in an array to SHCreateShellItemArray().
get the IShellFolder interface of the subdirectory, then query it for an IDataObject interface using IShellFolder.GetUIObjectOf(), and then use SHCreateShellItemArrayFromDataObject(), or just give the IDataObject directly to IFileOperation.DeleteItems().
get an IShellItem interface for the subdirectory, then query its IEnumShellItems interface using IShellItem.BindToHandler(), and then pass that directly to IFileOperation.DeleteItems().
I developed an application and I want to deploy it on one machine of my client network.
this machine turns under win7 64 bits and needs an admin authorization (they use active directory, GPO,...) so far no problem.
i am using the roaming folder to store some files.
the problem is when I launch the application it seems that it doesn't find the correct current user roaming folder path, I think that's redirected to the admin roaming folder.
my code is as follow
Function GetRoamingFolderPath():String;
var
OsVersion: integer;
Path: String;
begin
OsVersion:=(TOSVersion.Major);
if OsVersion < 6 then
Path:= GetSpecialFolderPath(CSIDL_COMMON_APPDATA)
else
path:= GetSpecialFolderPath(CSIDL_APPDATA);
end;
where GetSpecialFolderPath is defined as :
function GetSpecialFolderPath(folder : integer) : string;
const SHGFP_TYPE_CURRENT = 0;
var path: array [0..MAX_PATH] of char;
begin
if SUCCEEDED(SHGetFolderPath(0,folder,0,SHGFP_TYPE_CURRENT,#path[0]))
then Result := path
else
Result := '';
end;
also I need to register some values on registry under HKEY_CURRENT_USER , it's done but my application can't access them !
any idea on how to resolve this 2 issues.
thanks.
Function GetRoamingFolderPath():String;
var
OsVersion: integer;
Path: String;
begin
OsVersion:=(TOSVersion.Major);
if OsVersion < 6 then
Path:= GetSpecialFolderPath(CSIDL_COMMON_APPDATA)
else
path:= GetSpecialFolderPath(CSIDL_APPDATA);
end;
This function assigns to the local variable path, but not the return value. Hence its return value is undefined. Remove the variable path and assign to Result instead.
function GetRoamingFolderPath: string;
begin
if TOSVersion.Major < 6 then
Result := GetSpecialFolderPath(CSIDL_COMMON_APPDATA)
else
Result := GetSpecialFolderPath(CSIDL_APPDATA);
end;
This would have been obvious had you stepped through the code under the debugger and inspected the intermediate values. You would have observed that GetSpecialFolderPath returned the desired value, but that it got lost in GetRoamingFolderPath. Once you had made that observation, it would have become obvious what the fault was. I urge you to debug like this in future when you encounter such problems.
In my program, the user completes a form and then presses Submit. Then, a textfile or a random extension file is created, in which all the user's information is written. So, whenever the user runs the application form, it will check if the file, which has all the information, exists, then it copies the information and pastes it to the form. However, it is not working for some reason (no syntax errors):
procedure TForm1.FormCreate(Sender: TObject);
var
filedest: string;
f: TextFile;
info: array[1..12] of string;
begin
filedest := ExtractFilePath(ParamStr(0)) + 'User\Identity\IdentityofMyself.txt';
if FileExists(filedest) then
begin
AssignFile(f,filedest);
Reset(f);
ReadLn(info[1], info[2], info[3], info[4], info[5], info[6], info[7],
info[8], info[9], info[10], info[11], info[12]);
Edit1.Text := info[1];
Edit2.Text := info[2];
ComboBox1.Text := info[3];
ComboBox5.Text := info[4];
ComboBox8.Text := info[4];
ComboBox6.Text := info[5];
ComboBox7.Text := info[6];
Edit3.Text := info[7];
Edit4.Text := info[8];
Edit5.Text := info[11];
Edit6.Text := info[12];
ComboBox9.Text := info[9];
ComboBox10.Text := info[10];
CloseFile(f);
end
else
begin
ShowMessage('File not found');
end;
end;
The file exists, but it shows the message File not found. I don't understand.
I took the liberty of formatting the code for you. Do you see the difference (before, after)? Also, if I were you, I would name the controls better. Instead of Edit1, Edit2, Edit3 etc. you could use eFirstName, eLastName, eEmailAddr, etc. Otherwise it will become a PITA to maintain the code, and you will be likely to confuse e.g. ComboBox7 with ComboBox4.
One concrete problem with your code is this line:
readln(info[1], info[2], info[3], info[4], info[5], info[6], info[7],
info[8], info[9], info[10], info[11], info[12]);
You forgot to specify the file f!
Also, before I formatted your code, the final end of the procedure was missing. Maybe your blocks are incorrect in your actual code, so that ShowMessage will be displayed even if the file exists? (Yet another reason to format your code properly...)
If I encountered this problem and wanted to do some quick debugging, I'd insert
ShowMessage(BoolToStr(FileExists(filedest), true));
Exit;
just after the line
filedest := ...
just to see what the returned value of FileExists(filedest) is. (Of course, you could also set a breakpoint and use the debugger.)
If you get false, you probably wonder what in the world filedest actually contains: Well, replace the 'debugging code' above with this one:
ShowMessage(filedest);
Exit;
Then use Windows Explorer (or better yet: the command prompt) to see if the file really is there or not.
I'd like to mention an another possibility to output a debug message (assuming we do not know how to operate real debugger yet):
{ ... }
filedest := ExtractFilePath(ParamStr(0)) + 'User\Identity\IdentityofMyself.txt';
AllocConsole; // create console window (uses Windows module) - required(!)
WriteLn('"' + filedest + '"'); // and output the value to verify
if FileExists(filedest) then
{ ... }
I feel like this should be easy, but google is totally failing me at the moment. I want to open a file, or create it if it doesn't exist, and write to it.
The following
AssignFile(logFile, 'Test.txt');
Append(logFile);
throws an error on the second line when the file doesn't exist yet, which I assume is expected. But I'm really failing at finding out how to a) test if the file exists and b) create it when needed.
FYI, working in Delphi XE.
You can use the FileExists function and then use Append if exist or Rewrite if not.
AssignFile(logFile, 'Test.txt');
if FileExists('test.txt') then
Append(logFile)
else
Rewrite(logFile);
//do your stuff
CloseFile(logFile);
Any solution that uses FileExists to choose how to open the file has a race condition. If the file's existence changes between the time you test it and the time you attempt to open the file, your program will fail. Delphi doesn't provide any way to solve that problem with its native file I/O routines.
If your Delphi version is new enough to offer it, you can use the TFile.Open with the fmOpenOrCreate open mode, which does exactly what you want; it returns a TFileStream.
Otherwise, you can use the Windows API function CreateFile to open your file instead. Set the dwCreationDisposition parameter to OPEN_ALWAYS, which tells it to create the file if it doesn't already exist.
You should be using TFileStream instead. Here's a sample that will create a file if it doesn't exist, or write to it if it does:
var
FS: TFileStream;
sOut: string;
i: Integer;
Flags: Word;
begin
Flags := fmOpenReadWrite;
if not FileExists('D:\Temp\Junkfile.txt') then
Flags := Flags or fmCreate;
FS := TFileStream.Create('D:\Temp\Junkfile.txt', Flags);
try
FS.Position := FS.Size; // Will be 0 if file created, end of text if not
sOut := 'This is test line %d'#13#10;
for i := 1 to 10 do
begin
sOut := Format(sOut, [i]);
FS.Write(sOut[1], Length(sOut) * SizeOf(Char));
end;
finally
FS.Free;
end;
end;
If you are just doing something simple, the IOUtils Unit is a lot easier. It has a lot of utilities for writing to files.
e.g.
procedure WriteAllText(const Path: string; const Contents: string);
overload; static;
Creates a new file, writes the specified string to the file, and then
closes the file. If the target file already exists, it is overwritten.
You can also use the load/save feature in a TStringList to solve your problem.
This might be a bad solution, because the whole file will be loaded into memory, modified in memory and then saved to back to disk. (As opposed to your solution where you just write directly to the file). It's obviously a bad solution for multiuser situations.
But this approach is OK for smaller files, and it is easy to work with and easy understand.
const
FileName = 'test.txt';
var
strList: TStringList;
begin
strList := TStringList.Create;
try
if FileExists(FileName) then
strList.LoadFromFile(FileName);
strList.Add('My new line');
strList.SaveToFile(FileName);
finally
strList.Free;
end;
end;
I am working with delphi, I want a list of all files of a directory when I execute openpicturedialog.
i.e., When open dialog is executed and
i select one file from it, I want the
list of all files from the directory
of selected file.
You can even suggest me for getting directory name from FileName property of TOpenDialog
Thank You.
if you use delphi 2010 then you can use tdirectory.getfiles
first add ioutils.pas to uses clause then write the following line of code in the event handler(in addition to code you already have in that event handler)
uses IOUtils;
var
path : string;
begin
for Path in TDirectory.GetFiles(OpenPictureDialog1.filename) do
Listbox1.Items.Add(Path);{assuming OpenPictureDialog1 is the name you gave to your OpenPictureDialog control}
end;
#Himadri, the primary objective of the OpenPictureDialog is not select an directory, anyway if you are using this dialog with another purpose you can try this code.
Var
Path : String;
SR : TSearchRec;
DirList : TStrings;
begin
if OpenPictureDialog1.Execute then
begin
Path:=ExtractFileDir(OpenPictureDialog1.FileName); //Get the path of the selected file
DirList:=TStringList.Create;
try
if FindFirst(Path + '*.*', faArchive, SR) = 0 then
begin
repeat
DirList.Add(SR.Name); //Fill the list
until FindNext(SR) <> 0;
FindClose(SR);
end;
//do your stuff
finally
DirList.Free;
end;
end;
end;
Change the filter property in your OpenPictureDialog to include all files:
All (*.*)
Edit: I don't think you can select a directory in a Open(Picture)Dialog, it surely isn't the purpose of an OpenPictureDialog anyway.
Then use FindFirst and FindNext to get the files in this dir.
You can use extractFilePath function to get the directory name:
myPath := extractFilePath(FileName);
where FileName is name of file you choose by OpenDialog.
if OpenPictureDialog1.Execute then
FileListBox1.Directory := extractFilePath(OpenPictureDialog1.FileName);
You can also use a FilterComboBox linked to FileListBox to filter the file type.
TFileListBox and TFilterComboBox are in the tool palette under "Win 3.1". From Delphi 4 there are these objects.
Uses System.IOUtils;
var List : TStringlist;
var File : String := '';enter code here
var Path : string := IncludeTrailingPathDelimiter(Edit1.Text);
Lista := TStringList.Create;
try
for File in TDirectory.GetFiles(Path) do
List.Add(File); // Add all file names to list
finally
FreeAndNil(Lista);
end;