I want to copy only pdf files. I am using this method, if i know file name:
CopyFile(PChar(obPath.CaseTmpPath + '\' + currentCase.patientCase + '\Info_' + currentCase.patientCase + '.cxt'), PChar(obPath.ServerData + currentCase.patientCase + '\Info_' + currentCase.patientCase + '.cxt'), true);
this time, i dont know filenames. There are some files in directory like pdfs, jpegs. I just want to copy pdf files but how ?
If you work with Windows only and you're not interested in code portability you can revert to win api:
uses
ShellApi;
function MultiFileCopy(const ASource, ADest: string): Boolean;
var
FO: TSHFileOpStruct;
begin
FillChar(FO, SizeOf(FO), #0);
FO.Wnd := 0;
FO.wFunc := FO_COPY;
FO.pFrom := PChar(ASource + #0);
FO.pTo := PChar(ADest + #0);
FO.fFlags := FOF_FILESONLY or FOF_NOERRORUI or FOF_NOCONFIRMATION or FOF_SILENT;
Result := (SHFileOperation(FO) = 0)and(not FO.fAnyOperationsAborted);
end;
procedure TForm1.Button1Click(Sender: TObject);
begin
ShowMessage(BoolToStr(MultiFileCopy('C:\*.pdf', 'X:\'), True));
end;
The code above contains some trick to make method totally silent, please read documentation about SHFileOperation for flags and about SetErrorMode (as David noted SetErrorMode(SEM_FAILCRITICALERRORS) should be called only once during application initialization)
As Remy said in comment #0 are there because double null terminated strings are required.
Related
Using Delphi 10.4 Community Edition, VCL, Windows 10 64bit, although the compiled .exe application is 32bit.
The VCL's TMediaPlayer seems to have a file path/name length limit of 128 characters. Is this really an internal limitation? Is there any way to access longer file paths/names?
I was coding a small soundPad player by using the TMediaPlayer component.
The installer I am using installs the .exe program in the user's home directory, and at the same time a few sample audio files in the program's root directory.
In this case, the path to the audio file may be quite long. For example:
C:\Users\user\AppData\Local\Programs\MySoundPlayer\ThisIsMySoundWithAVeryLongFileNameThereIsSomeCopyrightInfoAndSomeOther.wav
When trying to play such a file, TMediaPlayer will give an error message:
Exception class name = 'EMCIDeviceError'
Exception message = 'Invalid filename. Make sure the filename has 8 characters, a period, and an extension.'
I tried different lengths in the file name, and it looks like 127 is the maximum length.
So, the VCL TMediaPlayer component does not recognize file paths / names longer than 127 characters?
I tried the same code with a Delphi FMX app, and FMX's TMediaPlayer worked ok. It seems that the maximum file path and name length of the FMX TMediaPlayer is 259, which is quite sufficient.
The length 259 seem to be the limit of the File Explorer overall...
It is said that the VCL's TMediaPlayer component is starting to become obsolete, and is only involved in backward compatibility reasons. But what can replace it in the future?
So, I guess I have to move on to FMX and learn its secrets. Is VCL a receding component system?
procedure TForm1.PlayButtonClick(Sender: TObject);
var
pathstring, playerfilename, playstring : string;
begin
try
pathstring := ExtractFilePath(Application.ExeName);
playerfilename := 'ThisIsMySoundWithAVeryLongFileNameThereIsSomeCopyrightInfoAndSomeOther.wav';
playstring := pathstring + playerfilename;
MediaPlayer1.FileName := playstring;
MediaPlayer1.Open;
MediaPlayer1.Play;
except
on E : Exception do
begin
ShowMessage('Exception class name = ' + E.ClassName);
ShowMessage('Exception message = ' + E.Message);
end;
end;
end;
Per this answer to mciSendString() won't play an audio file if path is too long:
Here, mmioOpen is called with MMIO_PARSE flag to convert file path to fully qualified file path. According to MSDN, this has a limitation:
The buffer must be large enough to hold at least 128 characters.
That is, buffer is always assumed to be 128 bytes long. For long filenames, the buffer turns out to be insufficient and mmioOpen returns error, causing mciSendCommand to think that sound file is missing and return MCIERR_FILENAME_REQUIRED.
The Invalid filename error message you are seeing is the system text for the MCIERR_FILENAME_REQUIRED error code.
The VCL's TMediaPlayer is based on MCI and internally uses mciSendCommand(), which is just the binary version of mciSendString(). They both suffer from the same problem.
The preferred fix is to either use shorter paths, or use a more modern audio API.
However, since mmioInstallIOProc() can be used to let TMediaPlayer play media files from memory instead of files, I think a similar solution could be used to play files with long file paths, since you could take over the responsibility of opening/reading/seeking a file, bypassing the path limitation of the troublesome mmioOpen(). Just replace the TResourceStream in that code with a TFileStream, and update the MMIOM_READ and MMIOM_SEEK handlers accordingly to read/seek that TFileStream.
For example (untested, might need some tweaking):
uses
Winapi.MMSystem;
var
ccRES: FOURCC;
playstring: string;
function MAKEFOURCC(ch0, ch1, ch2, ch3: BYTE): FOURCC;
begin
Result := DWORD(ch0) or (DWORD(ch1) shl 8) or (DWORD(ch2) shl 16) or (DWORD(ch3) shl 24);
end;
function MyLongFileIOProc(lpMMIOInfo: PMMIOInfo; uMessage: UINT; lParam1, lParam2: LPARAM): LRESULT; stdcall;
var
FStrm: TFileStream;
NumRead: Integer;
function GetFileStream: TFileStream;
begin
Move(lpMMIOInfo.adwInfo, Result, SizeOf(TFileStream));
end;
procedure SetFileStream(Stream: TFileStream);
begin
Move(Stream, lpMMIOInfo.adwInfo, SizeOf(TFileStream));
end;
begin
if uMessage = MMIOM_OPEN then
begin
try
FStrm := TFileStream.Create(playstring, fmOpenRead or fmShareDenyWrite);
except
SetFileStream(nil);
Exit(MMIOM_CANNOTOPEN);
end;
SetFileStream(FStrm);
lpMMIOInfo.lDiskOffset := 0;
end else
begin
FStrm := GetFileStream;
case uMessage of
MMIOM_CLOSE: begin
SetFileStream(nil);
FStrm.Free;
end;
MMIOM_READ: begin
NumRead := FStrm.Read(Pointer(lParam1)^, lParam2);
Inc(lpMMIOInfo.lDiskOffset, NumRead);
Exit(NumRead);
end;
MMIOM_SEEK: begin
FStrm.Seek(Int64(lParam1), TSeekOrigin(lParam2));
lpMMIOInfo.lDiskOffset := FStrm.Position;
Exit(lpMMIOInfo.lDiskOffset);
end;
end;
Exit(MMSYSERR_NOERROR);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
ccRES := MAKEFOURCC(Ord('L'), Ord('F'), Ord('N'), Ord(' '));
mmioInstallIOProc(ccRES, TFNMMIOProc(MyLongFileIOProc), MMIO_INSTALLPROC);
end;
procedure TForm1.FormDestroy(Sender: TObject);
begin
mmioInstallIOProc(ccRES, nil, MMIO_REMOVEPROC);
end;
procedure TForm1.PlayButtonClick(Sender: TObject);
var
pathstring, playerfilename : string;
begin
try
pathstring := ExtractFilePath(Application.ExeName);
playerfilename := 'ThisIsMySoundWithAVeryLongFileNameThereIsSomeCopyrightInfoAndSomeOther.wav';
playstring := pathstring + playerfilename;
MediaPlayer1.DeviceType := dtWaveAudio;
MediaPlayer1.FileName := 'playstring.LFN+';
MediaPlayer1.Open;
MediaPlayer1.Play;
except
on E : Exception do
begin
ShowMessage('Exception class name = ' + E.ClassName);
ShowMessage('Exception message = ' + E.Message);
end;
end;
end;
I am seeking to convert some Delphi code to extract file properties from the operating system from a time-honoured implementation for the Windows platform to a new implementation for the Android platform.
I have found that whereas the implementation for the Delphi platform uses the functions FindFirst() and FindNext() without problem and allows the file properties to be obtained from the TSearchRec parameter, this approach doesn’t appear to work for the Android platform.
So I need to find cross-platform functions to obtain file and directory properties. Several properties may be obtained using methods of the System.IOUtils record types TDirectory and TFile. But for some reason, these does not appear to include a method to obtain the size in bytes of a file.
Therefore, I have tried to obtain the file size by creating a TFileStream object for the file given its pathname, and then getting the size from the TFileStream.Size property. This method works when the file is not already open. However if the file is open, then an exception is thrown.
The next question, then, is how to find out whether a file is open before calling TFileStream.Create(). This ought to be straightforward, but I cannot remember how to do it. So I have tried the following global procedure:
procedure FXGetFileSize(FilePathname: string; var FileInUse: Boolean;
var Size: int64);
var
FileStream: TFileStream;
begin
try
FileStream:= TFileStream.Create(FilePathname, fmOpenRead);
try
FileInUse:= False;
Size:= FileStream.Size;
finally
FileStream.Free;
end;
except
on E: Exception do
begin
FileInUse:= True;
Size:= 0;
FileStream.Free;
end;
end;
end;
I call this procedure from within the following method:
procedure TFolder.ReadFX (Pathname: string; Recurse: Boolean);
{Reads details of folder file components in a folder into a TFolder data structure – cross-platform version}
var
Separator: char;
FolderPaths: TStringDynArray;
FilePathNames: TStringDynArray;
i: integer;
FolderPathI: string;
FilePathnameI: string;
SubFolder: TFolder;
SubFileCpt: TFileCpt;
SubFileCptIndex: integer;
FolderCptName: string;
Datetime: TDatetime;
FileInUse: Boolean;
FileSize: int64;
begin
Separator:= TPath.DirectorySeparatorChar;
FCount:= 0;
FCumSize:= 0;
FCumFileCount:= 0;
FCumFolderCount:= 1;
{Extract list of subfolders in directory:}
FolderPaths:= TDirectory.GetDirectories(Pathname);
{Create a TFolder object for each subfolder:}
for i:= 0 to High(FolderPaths) do
begin
FolderPathI:= FolderPaths[i];
if TDirectory.Exists(FolderPathI) then
begin
try
{Create TFolder object for subfolder i:}
SubFolder:= TFolder.Create;
AddFolderCpt(SubFolder, SubFileCptIndex);
{Assign TFolder properties:}
FolderCptName:= StringReplace(FolderPathI, (Pathname + Separator), '', [rfIgnoreCase]);
Subfolder.Name:= FolderCptName;
{Subfolder.Name:= Path; }
Subfolder.FDateTime:= TDirectory.GetLastWriteTime(FolderPathI);
{Recursively process subfolder:}
if Recurse then
Subfolder.Read(FolderPathI, Recurse);
{Compute aggregate properties:}
FCumSize:= FCumSize + SubFolder.FCumSize;
FCumFileCount:= FCumFileCount + SubFolder.FCumFileCount;
FCumFolderCount:= FCumFolderCount + SubFolder.FCumFolderCount;
except
on E: Exception do
begin
E.Message:= 'Error in TFolder.ReadFX processing folder "'
+ FolderPathI + '"' + #13#10
+ '(' + E.Message + ')';
end;
end;
end;
end;
{Get list of files in directory:}
FilePathNames:= TDirectory.GetFiles(Pathname);
{Create TFileCpt objects for each child file:}
for i:= 0 to High(FilePathnames) do
begin
FilePathnameI:= FilePathnames[i];
if (FilePathnameI<> '.') and (FilePathnameI<>'..') then
begin
try
{$ifdef MSWINDOWS}
if not ([TFileAttribute.faHidden, TFileAttribute.faSystem] <=
TFile.GetAttributes(FilePathnameI)) then
{$endif}
begin
FXGetFileSize(FilePathnameI, FileInUse, FileSize); {***}
{Create a TFileCpt object corresponding to FilePathnameI:}
SubFileCpt:= TFileCpt.Create;
AddFolderCpt(SubFileCpt, SubFileCptIndex);
{Assign TFileCpt properties:}
SubFileCpt.FName:= TPath.GetFileName(FilePathnameI);
SubFileCpt.FSize:= FileSize;
SubFileCpt.FDateTime:= TFile.GetLastWriteTime(FilePathnameI);
FCumSize:= FCumSize + FileSize;
FCumFileCount:= FCumFileCount + 1;
end;
except
on E: Exception do
begin
E.Message:= 'Error in TFolder.ReadFX processing file "'
+ FilePathnameI + '"' + #13#10
+ '(' + E.Message + ')';
end;
end;
end;
end;
end;
Unfortunately, when I call TFolder.ReadFX() for Pathanme= ‘C:\\Users\User XXX' on Windows 7, a runtime exception is always thrown when an open file presumably opened by the Windows OS is encountered.
In conclusion, can any one help with the following questions:
How to obtain the size of a file without having to open the file stream
How to determine whether or not the file is already/in use
In the case of a folder, how to extract the name of lowest level folder from the folder path, without manually parsing the path.
I am very new to the iOS platform. I am trying to save an INI file for my application. The problem is that I can't get a path with write permission.
Here is my code:
ini := TIniFile.Create(GetHomePath + '/user.dat');
try
ini.WriteString('data','user',edtuser.Text);
ini.WriteString('data','descr',edt1.Text);
finally
ini.Free;
end;
I get an exception that the file can't be created. How can I get a writable path using Firemonkey?
Use TPath.GetDocumentsPath (and use TPath.Combine instead of concatenation, to remove the hard-coded /):
uses
System.IOUtils;
ini := TIniFile.Create(TPath.Combine(TPath.GetDocumentsPath, 'user.dat'));
Using TPath.GetDocumentsPath works across all supported platforms (Win32, Win64, OSX, iOS, and Android) transparently, and using TPath.Combine will automatically add the TPath.DirectorySeparatorChar, so you don't have to manually concatenate them.
If you prefer to do it yourself, though:
var
IniName: string;
begin
IniName := TPath.GetDocumentsPath + TPath.DirectorySeparatorChar + 'user.dat';
Ini := TIniFile.Create(IniName);
try
// Rest of code
finally
Ini.Free;
end;
end;
May be this or this can help you
uses INIFiles;
function TForm6.MyINIFilePath: string;
begin
// Result := GetHomePath + PathDelim + 'Library' + PathDelim+'My.ini';
Result := GetHomePath + PathDelim + 'Documents' + PathDelim+'MyD.ini';
end;
I have an INI file in UTF-8 format.
I am using Delphi 2010 to read the INI file and populate a TStringGrid with the values in the INI file.
var
ctr : Integer;
AppIni : TIniFile;
begin
AppIni := TIniFile.Create(ExtractFilePath(Application.ExeName) + 'test.ini');
for ctr := 1 to StringGrid1.RowCount do begin
StringGrid1.Cells[0,ctr] := AppIni.ReadString('Column1','Row'+IntToStr(ctr),'');
StringGrid1.Cells[1,ctr] := AppIni.ReadString('Column2','Row'+IntToStr(ctr),'');
end;
AppIni.Free;
The problem is that the unicode characters are appearing in the TStringGrid displaying 2 characters, rather than the 1 unicode character.
How do I resolve this?
The TIniFile class is a wrapper of the Windows API for INI files. This does support Unicode INI files, but only if those files are encoded as UTF-16. Michael Kaplan has more details here: Unicode INI function; Unicode INI file?
So, you are out of luck with TIniFile. Instead you could use TMemIniFile which allows you to specify an encoding in its constructor. The TMemIniFile class is a native Delphi implementation of INI file support. There are various pros and cons between the two classes. In your situation, only TMemIniFile can serve your needs, so it's looking like its pros are going to outweigh its cons.
Uses IniFiles;
const
SZ_APP_NAME = 'demo_test';
Procedure TForm1.GetSettings;
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
begin
try
_SettingsPath := GetHomePath + PathDelim + SZ_APP_NAME + PathDelim;
if ForceDirectories(_SettingsPath) then
begin
_MemIniU := TMemIniFile.Create(ChangeFileExt(_SettingsPath,
'Settings.ini'), TEncoding.UTF8);
try
if _MemIniU.ReadInteger(SZ_APP_NAME, 'WindowLeft', -1) = -1 then
Form1.Position := poScreenCenter
else
begin
Form1.Left := _MemIniU.ReadInteger(SZ_APP_NAME, 'WindowLeft', 10);
Form1.Top := _MemIniU.ReadInteger(SZ_APP_NAME, 'WindowTop', 10);
Form1.Width := _MemIniU.ReadInteger(SZ_APP_NAME, 'WindowWidth', 594);
Form1.Height := _MemIniU.ReadInteger(SZ_APP_NAME,
'WindowHeight', 342);
end;
Edit1.Text := _MemIniU.ReadString(SZ_APP_NAME, 'UnicodeText', 'ąčę');
finally
_MemIniU.Free;
end;
end;
except
on E: Exception do
MessageDlg(PWideChar(E.Message), TMsgDlgType.mtError,
[TMsgDlgBtn.mbOK], 0);
end;
end;
Procedure TForm1.SaveSettings;
var
_MemIniU: TMemIniFile;
_SettingsPath: string;
begin
try
_SettingsPath := GetHomePath + PathDelim + SZ_APP_NAME + PathDelim;
_MemIniU := TMemIniFile.Create(ChangeFileExt(_SettingsPath, 'Settings.ini'),
TEncoding.UTF8);
try
if Form1.WindowState <> TWindowState.wsMaximized then
begin
_MemIniU.WriteInteger(SZ_APP_NAME, 'WindowLeft', Form1.Left);
_MemIniU.WriteInteger(SZ_APP_NAME, 'WindowTop', Form1.Top);
_MemIniU.WriteInteger(SZ_APP_NAME, 'WindowWidth', Form1.Width);
_MemIniU.WriteInteger(SZ_APP_NAME, 'WindowHeight', Form1.Height);
_MemIniU.WriteString(SZ_APP_NAME, 'UnicodeText', Edit1.Text);
end;
_MemIniU.UpdateFile;
finally
_MemIniU.Free;
end;
except
on E: Exception do
MessageDlg(PWideChar(E.Message), TMsgDlgType.mtError,
[TMsgDlgBtn.mbOK], 0);
end;
end;
In an application were I was using TIniFile i had the need to start storing Unicode chars.
To do this i simply changed the variable type from TIniFile to TMemIniFile and in the constructor, after the filename i added the second parameter TEncoding.UTF8.
Then before freeing the object i called UpdateFile. If Ini File is opened for reading, call to UpdateFile is not needed.
// ANSI version
var myIniFile: TIniFile;
begin
myIniFIle := TIniFile.Create('c:\Temp\MyFile.ini');
myIniFile.WriteString(par1,par2,par3);
// [...]
myIniFile.Free;
end
// Unicode version
//1) "Mem" added here
var myIniFile: TMemIniFile;
begin
// 2) Enconding added
myIniFIle := TIniFile.Create('c:\Temp\MyFile.ini', TEncoding.UTF8);
myIniFile.WriteString(par1,par2,par3);
// [...]
// 3) call to UpdateFile to save to disc the changes
myIniFile.UpdateFile;
myIniFile.Free;
end
The good news is that UpdateFile causes the ini file to be saved with the proper encoding, this means that if a ini file encoded in ANSI already exists it is overwriten so it becomes UTF-8, so the transaction between ANSI and UTF-8 is smooth and not painful at all.
In my application I need to copy over 1000 small files
Here is the code I am using but it is VERY SLOW
Is there a better way of doing this ?
procedure Tdatafeeds.RestotreTodaysFiles;
var
SearchRec: TSearchRec;
FromFn, ToFn: string;
Begin
if DirectoryExists(BackupPath1) then
begin
try
if FindFirst(BackupPath1 + '\*.*', (faAnyFile AND NOT(faDirectory)), SearchRec) = 0 then
begin
repeat
FromFn := BackupPath1 + '\' + SearchRec.name;
ToFn := DatafeedsPath1 + '\' + SearchRec.name;
CopyFile(Pchar(FromFn), Pchar(ToFn), false);
until FindNext(SearchRec) <> 0;
end;
finally
FindClose(SearchRec);
end;
end;
End;
Definitely go with SHFileOperation() as suggested above, CopyFile is way too slow for that many files. It looks like you are basically restoring an entire folder so the search function may be unnecessary and slow things down further. Something like this may be of help:
uses ShellApi;
function CopyDir(const fromDir, toDir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(#fos, SizeOf(fos));
with fos do
begin
wFunc := FO_COPY;
fFlags := FOF_FILESONLY;
pFrom := PChar(fromDir + #0);
pTo := PChar(toDir)
end;
Result := (0 = ShFileOperation(fos));
end;
This function will raise a prompt to overwrite existing files though (maybe it can be tweaked to skip that) but the user can select "All" so it's a one-click procedure, much faster, has a progress bar and can be canceled if desired.
You can use the SHFileOperation() API call and use a wildcard in the file name of the struct. That way one call would be used to copy all of the files in one go. There's even the possibility to show the progress (via a callback function) and allow the user to cancel the operation.
I can't test your code right now, but check out this corrected version
// (!) faAnyFile-faDirectory <--- this is wrong
// we don't subtract flag values because the value will be meaningless
if FindFirst(BackupPath1 + '\*.*', faAnyFile, SearchRec) = 0 then
begin
repeat
if not (SearchRec.Attr and faDirectory)
And SearchRec.Name <> "."
And SearchRec.Name <> ".." Then
Begin
FromFn := BackupPath1 + '\' + SearchRec.name;
ToFn := DatafeedsPath1 + '\' + SearchRec.name;
CopyFile(Pchar(FromFn), Pchar(ToFn), false);
End;
until FindNext(SearchRec) <> 0;
FindClose(SearchRec);
end;
Perhaps you might experiment with reading a bunch of files into memory and then writing them all to disk at once (like XCOPY). That might be nicer on the filesystem.