For an iPhone Firemonkey application I am storing files (images) in the 'tmp' folder and using them in my application. I want to be able flush the cache by deleting say all of the '.jpg' files on demand, but I cannot seem to programatically match them in a FindFirst() call.
I am using a simple FindFirst() / FindNext() / FindClose() loop to list (and delete) the contents of a folder.
Under windows the code works perfectly. The same application under iOS (iPhone) is always returning a value of -1 (error) for the FindFirst() call, and SearchRec.Name is blank. I have tried using various file patterns including '.' with no success.
I know the files exist because I can read and write to them (under both iOS and windows) without error, and their contents is correct. A FileExists() check also returns True.
Also, if I specify a file pattern with no wildcard, to check for a known file (which really isn't the point of a FindFirst() call), the call never returns (again this is fine under windows)!
Has anyone had any success with this under iOS and can offer any thoughts?
Thanks,
EDIT: Code snippet as requested which demonstrates the problem.
Note: _sFolderName contains the cache folder name which I have confirmed is definitely correct.
function GetCacheFileList : string;
var
iResult: integer;
sr: TSearchRec;
sPath,
sTemp: string;
sFilename : TFilename;
begin
sTemp := '';
sFilename := _sFolderName + '*.jpg';
//
iResult := FindFirst(sFilename, faAnyFile, sr); // ALWAYS RETURNS -1 under iOS
while (iResult = 0) do
begin
sTemp := sTemp + sr.Name + sLineBreak;
iResult := FindNext(sr)
end; { while }
//
FindClose(sr);
Result := sTemp
end;
I don't know how well FindFirst, etc are supported on non-Windows platforms, but I do recall someone from the Delphi team saying once that the routines in the IOUtils unit are specifically designed to make file I/O work right for cross-platform coding. Have you tried using the file search methods on TDirectory?
I don't know if Delphi XE 2 is shipped with headers from iOS SDK, but you can generate them for FreePascal(read here). And then use this method via standard API:
{$modeswitch objectivec1}
uses
iPhoneAll, CFBase, CFString;
type
TFileList = record
Count : Integer;
Items : array of String;
end;
procedure file_Find( const Directory : String; var List : TFileList; FindDir : Boolean = FALSE );
var
i : Integer;
fileManager : NSFileManager;
dirContent : NSArray;
path : NSString;
fileName : array[ 0..255 ] of Char;
error : NSErrorPointer;
isDirectory : Boolean;
begin
fileManager := NSFileManager.alloc().init();
path := NSString( CFStr( PChar( Directory ) ) );
dirContent := fileManager.contentsOfDirectoryAtPath_error( path, error );
List.Count := 0;
fileManager.changeCurrentDirectoryPath( path );
for i := 0 to dirContent.count() - 1 do
begin
if FindDir Then
begin
if ( fileManager.fileExistsAtPath_isDirectory( dirContent.objectAtIndex( i ), #isDirectory ) ) and ( not isDirectory ) Then continue;
end else
if ( fileManager.fileExistsAtPath_isDirectory( dirContent.objectAtIndex( i ), #isDirectory ) ) and ( isDirectory ) Then continue;
SetLength( List.Items, List.Count + 1 );
FillChar( fileName[ 0 ], 256, 0 );
CFStringGetCString( CFStringRef( dirContent.objectAtIndex( i ) ), #fileName[ 0 ], 255, kCFStringEncodingUTF8 );
List.Items[ List.Count ] := PChar( #fileName[ 0 ] );
INC( List.Count );
end;
fileManager.dealloc();
end;
This function returns record TFileList with array of all found files(or directories). Then you can just pars names of files and do something with jpg-files.
This has been fixed under XE2 update 3
Related
I have one installation that behaves VERY oddly... Every time we try to copy something on a network drive we check accessibility with code like this:
procedure TForm1.TestAccess;
var fn : string;
hdl : THandle;
res : boolean;
dir : string;
flags : Cardinal;
begin
dir := edDir.Text;
flags := FILE_FLAG_DELETE_ON_CLOSE or FILE_FLAG_NO_BUFFERING or FILE_ATTRIBUTE_HIDDEN;
fn := FindUnusedFileName( IncludeTrailingPathDelimiter( dir ) + IntToStr( Random(10000) ) + '.tst' );
memLog.Lines.Add('Try to create file: ' + fn);
hdl := CreateFile( PChar(fN), GENERIC_READ or GENERIC_WRITE, FILE_SHARE_DELETE, nil, CREATE_NEW,
flags, 0 );
res := hdl <> INVALID_HANDLE_VALUE;
if not res then
begin
memLog.Lines.Add('Error: ' + SysErrorMessage(GetLastError));
end
else
memLog.Lines.Add('Success');
if res then
CloseHandle(hdl);
end;
where memLog is a TMemo and edDir is simply an edit field.
Now here is the strange part... I get an access denied on that system meaning uploading will fail most of the time (most of the time is the strange part here).
Another thing is that in a first attempt I used the JvDirectoryEdit control. In that case the result is twofold... If I enter the directory (UNC Path) there without a backslash I get the access denied too. If I enter a final backslash and the combo box window pops up showing the content (aka directories) in that folder it finally works!!!
So... First: has anyone a clue what the problem might be and do I something wrong here?
I have used this procedure in the past to check if a directory is read-only, maybe it can be useful:
FUNCTION DirRO(NomeCartella : String) : Boolean;
VAR VarFile : TextFile;
NomCart : String;
BEGIN
Result := False;
If NomeCartella[Length(NomeCartella)]='\'
Then NomCart := NomeCartella
Else NomCart := NomeCartella+'\';
Try AssignFile(VarFile,NomCart+'^ghi.kol');
{$I-}
Rewrite(VarFile);
{$I-}
If IOResult<>0 Then
Begin
Result := True;
Exit;
End;
CloseFile(VarFile);
Erase(VarFile);
Except Result := True;
End;
END;
So i have a 'downloads' folder where i put everything i download in my day by day work. You know we always automate everything, so I'm trying to build a simply app to run everyday to delete files older than 30 days, as i have to do this manually from time to time to avoid the folder become too big.
Here is my code :
function TForm1.deleteOldDownloads: boolean;
var
f: string;
i, d: Integer;
var
sl: tstringlist;
begin
try
FileListBox1.Directory := '\\psf\home\downloads';
FileListBox1.refresh;
sl := tstringlist.create;
for i := 0 to FileListBox1.items.count - 1 do
begin
f := FileListBox1.Directory + '\' + FileListBox1.items[i];
if fileexists(f) then
d := daysbetween(FileAge(f), now)
else
d := 0;
if d > 30 then // problem is here, d is always a big number, not the actually age of file
sl.Add(f);
end;
if sl.count > 0 then
begin
for i := 0 to sl.count do
begin
f := sl[i];
deletefile(f);
end;
end;
sl.Free;
except
on e: Exception do
begin
end;
end;
Problem is "d" variable is returning very big numbers like 1397401677, even if the file has only 1 day.
The only detail here is i run Windows in a Parallels virtual machine and the "\psf\home\downloads" folder is on Mac, but i can access this folderl normally using Windows Explorer, so for Delphi is like a regular local folder.
What am i missing ?
Did you read the documentation for FileAge? The first day in programming school, you are taught "When you start using a new function or API, you begin by reading its documentation." In this case, the function's documentation says
The [one-argument] overloaded version of FileAge is deprecated.
So you are using a function you shouldn't be using.
Still, this function should probably still work.
But what do you expect it to return? Well, obviously the thing that the docs say it should return:
The first overload returns an integer that represents the OS time stamp of the file. The result can be later converted to a TDateTime using the FileDateToDateTime function.
But when you use this in DaysBetween, you assume it already is a TDateTime!
Why is FileAge returning unexpected values?
It isn't. It is probably returning exactly the thing its documentation says it should return.
You are using the older version of FileAge() that returns a timestamp in DOS numeric format, but you are treating it as a TDateTime, which it is not. As the FileAge documentation says:
The first overload returns an integer that represents the OS time stamp of the file. The result can be later converted to a TDateTime using the FileDateToDateTime() function.
So, do what the documentation says to do, eg:
var
age: Integer;
age := FileAge(f);
if age <> -1 then
d := DaysBetween(FileDateToDateTime(age), Now)
Otherwise, use the newer version of FileAge() that outputs a TDateTime to begin with, eg:
var
dt: TDateTime;
if FileAge(f, dt) then
d := DaysBetween(dt, Now)
This is NOT a direct answer to your question, but I cannot post it as a comment.
So, the thing is, you should never delete user files directly. What if you make a mistake? What if the user of your program makes a mistake?
Always delete files to Recycle Bin:
{--------------------------------------------------------------------------------------------------
DELETE FILE
Deletes a file/folder to RecycleBin.
Old name: Trashafile
Note related to UNC: The function won't move a file to the RecycleBin if the file is UNC. MAYBE it was moved to the remote's computer RecycleBin
--------------------------------------------------------------------------------------------------}
function RecycleItem(CONST ItemName: string; CONST DeleteToRecycle: Boolean= TRUE; CONST ShowConfirm: Boolean= TRUE; CONST TotalSilence: Boolean= FALSE): Boolean;
VAR
SHFileOpStruct: TSHFileOpStruct;
begin
FillChar(SHFileOpStruct, SizeOf(SHFileOpStruct), #0);
SHFileOpStruct.wnd := Application.MainForm.Handle; { Others are using 0. But Application.MainForm.Handle is better because otherwise, the 'Are you sure you want to delete' will be hidden under program's window }
SHFileOpStruct.wFunc := FO_DELETE;
SHFileOpStruct.pFrom := PChar(ItemName+ #0); { ATENTION! This last #0 is MANDATORY. See this for details: http://stackoverflow.com/questions/6332259/i-cannot-delete-files-to-recycle-bin - Although this member is declared as a single null-terminated string, it is actually a buffer that can hold multiple null-delimited file names. Each file name is terminated by a single NULL character. The last file name is terminated with a double NULL character ("\0\0") to indicate the end of the buffer }
SHFileOpStruct.pTo := NIL;
SHFileOpStruct.hNameMappings := NIL;
if DeleteToRecycle
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_ALLOWUNDO;
if TotalSilence
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NO_UI
else
if NOT ShowConfirm
then SHFileOpStruct.fFlags:= SHFileOpStruct.fFlags OR FOF_NOCONFIRMATION;
Result:= SHFileOperation(SHFileOpStruct)= 0;
//DEBUG ONLY if Result<> 0 then Mesaj('last error: ' + IntToStr(Result)+ CRLF+ 'last error message: '+ SysErrorMessage(Result));
//if fos.fAnyOperationsAborted = True then Result:= -1;
end;
Also, you don't need that obsolete control to get the files in a folder. You can use this:
{ FIND FILES }
function ListFilesOf(CONST aFolder, FileType: string; CONST ReturnFullPath, DigSubdirectories: Boolean): TStringList;
{ If DigSubdirectories is false, it will return only the top level files,
else it will return also the files in subdirectories of subdirectories.
If FullPath is true the returned files will have full path.
FileType can be something like '*.*' or '*.exe;*.bin'
Will show also the Hidden/System files.
Source Marco Cantu Delphi 2010 HandBook
// Works with UNC paths}
VAR
i: Integer;
s: string;
SubFolders, filesList: TStringDynArray;
MaskArray: TStringDynArray;
Predicate: TDirectory.TFilterPredicate;
procedure ListFiles(CONST aFolder: string);
VAR strFile: string;
begin
Predicate:=
function(const Path: string; const SearchRec: TSearchRec): Boolean
VAR Mask: string;
begin
for Mask in MaskArray DO
if System.Masks.MatchesMask(SearchRec.Name, Mask)
then EXIT(TRUE);
EXIT(FALSE);
end;
// Long paths will raise an EPathTooLongexception exception, so we simply don't process those folders
if Length(aFolder) > MAXPATH
then exit;
filesList:= TDirectory.GetFiles (aFolder, Predicate);
for strFile in filesList DO
if strFile<> '' { Bug somewhere here: it returns two empty entries ('') here. Maybe the root folder? }
then Result.Add(strFile);
end;
begin
{ I need this in order to prevent the EPathTooLongexception (reported by some users) }
if aFolder.Length >= MAXPATH then
begin
MesajError('Path is longer than '+ IntToStr(MAXPATH)+ ' characters!');
EXIT(NIL);
end;
if NOT System.IOUtils.TDirectory.Exists (aFolder)
then RAISE exception.Create('Folder does not exist! '+ CRLF+ aFolder);
Result:= TStringList.Create;
{ Split FileType in subcomponents }
MaskArray:= System.StrUtils.SplitString(FileType, ';');
{ Search the parent folder }
ListFiles(aFolder);
{ Search in all subfolders }
if DigSubdirectories then
begin
SubFolders:= TDirectory.GetDirectories(aFolder, TSearchOption.soAllDirectories, NIL);
for s in SubFolders DO
begin
if ccIO.DirectoryExists(s) { This solves the problem caused by broken 'Symbolic Link' folders }
then ListFiles(s);
end;
end;
{ Remove full path }
if NOT ReturnFullPath then
for i:= 0 to Result.Count-1 DO
Result[i]:= TPath.GetFileName(Result[i]);
end;
The code above is from: https://github.com/GodModeUser/Delphi-LightSaber
I am trying to make a application which is based around backing up data. I would like to add a option to copy a folder with its contents while ignoring the subfolders only.
I use TDirectory.Copy('C:\folder','C:\folder2'); to copy folders but that has no additional data requested other than the directory to copy and where to copy.
So, Is there a simple way to achieve this?
A function that can be called would work too.
It's not perfect, but you could make your own routine based on this :
procedure TForm2.Button1Click(Sender: TObject);
var
aSourceDir : String;
aDestDir : String;
aFileList : TStringDynArray;
iFile : Integer;
aSourceFileName : String;
aDestFileName : String;
begin
aSourceDir := 'C:\DEV\GitRepositories\TestProjects\WithStatementSample\';
aDestDir := 'C:\DEV\GitRepositories\TestProjects\WithStatementSample2\';
aFileList := TDirectory.GetFiles( aSourceDir );
if not ( TDirectory.Exists( aDestDir ) ) and
( Length( aFileList ) > 0 ) then
begin
TDirectory.CreateDirectory( aDestDir );
end;
for iFile := 0 to Pred( Length( aFileList ) ) do
begin
aSourceFileName := aFileList[ iFile ];
aDestFileName := IncludeTrailingPathDelimiter( aDestDir ) +
ExtractFileName( aFileList[ iFile ] );
TFile.Copy( aSourceFileName, aDestFileName );
end;
end;
This will simply loop over every file found in the Source directory and copy it to the destination directory. It will not copy folders, nor copy contents of the folders.
Again, it's not 100% fool/bullet proof though, so you will have to adapt it to your needs if necessary.
Dec.26,2022 Update... The example code I submitted used literal values which
actually worked but not for my application. so...the problem with vars was
PAnsiChar not managing strings, so... (rather verbose code)... sSCBHostPath :=
gsAppPath + 'SCBHosts\'; sDirName := 'SCBHost' +
Trim(absqMyGuests.FieldByName('Guest_Name').AsString); sNewHostAppPath :=
sSCBHostPath + sDirName; sPCharString := 'XCopy ' + sAppDeploymentPath + ' ' +
sNewHostAppPath + ' /E /H /C /I'; cPChar {PAnsiChar type} :=
StringToPAnsiChar(sPCharString); //to reader, function code follows TRY
WinExec(cPChar,SW_SHOWNORMAL); EXCEPT ON E:EXCEPTION DO messagedlg('Exception:
' + e.Message,mterror,[mbok],0); END; // This function converts a string to a
PAnsiChar // If the output is not the same, an exception is raised // Author:
nogabel#hotmail.com function
TfInternetServersAndClients.StringToPAnsiChar(stringVar : string) : PAnsiChar;
Var AnsString : AnsiString; InternalError : Boolean; begin InternalError :=
false; Result := ''; try if stringVar <> '' Then begin AnsString :=
AnsiString(StringVar); Result := PAnsiChar(PAnsiString(AnsString)); end;
Except InternalError := true; end; if InternalError or (String(Result) <>
stringVar) then begin Raise Exception.Create('Conversion from string to
PAnsiChar failed!'); end; end; Dec.25,2022 Delphi XE2 Pro...
This opens Command.com and copies an entire folder and its subfolders and all files to a different drive, then disappears.
WinExec(PAnsiChar('XCopy C:\Dir1 E:\Dir1 /E /H /C /I'),SW_SHOWNORMAL);
Next.
This opens Command.com and copies an entire folder and its subfolders and all files to an existing folder on the same drive named C:\NewDir. The resulting C:\NewDir will contain a folder named Dir1 with all of its subfolders and files.
WinExec(PAnsiChar('XCopy C:\Dir1 C:\NewDir /E /H /C /I'),SW_SHOWNORMAL);
Is there a way to access (and call) procedures like _CopyArray that are defined in the interface in the unit System?
NB: I am trying to create a routine that makes a deep clone of any dynamic array, and do not use Delphi 2010 (using Delphi 2007).
The reason why I am trying to solve this without using Copy is the fact that I have only a pointer where the dynamic array is located (the pointer that is) plus a typeinfo reference. I cannot call the Copy function because it implicitly needs to fill in the typeinfo.
SOLUTION:
You need to reference it by replacing the _ with an # and scoping it with system.
procedure CopyArray( dest, source, typeInfo: Pointer; cnt: Integer );
asm
PUSH dword ptr [EBP+8]
CALL system.#CopyArray
end;
type
PObject = ^TObject;
function TMessageRTTI.CloneDynArray( Source: Pointer; T: TTypeRecord ): Pointer;
var
TypeInfo: TTypeRecord;
L: Integer;
PObj: PObject;
PArr: PPointer;
begin
Assert( T.TypeKind = tkDynArray );
// set size of array
Result := nil;
L := Length( TIntegerDynArray( Source ) );
if L = 0 then Exit;
DynArraySetLength( Result, T.TypeInfo, 1, #L );
if Assigned( T.TypeData^.elType ) then TypeInfo := ByTypeInfo( T.TypeData^.elType^ ) else TypeInfo := nil;
if Assigned( TypeInfo ) then begin
case TypeInfo.TypeKind of
tkClass: begin
PObj := Result;
while L > 0 do begin
PObj^ := CloneObject( PObject( Source )^ );
Inc( PObject( Source ) );
Inc( PObj );
Dec( L );
end;
end;
tkDynArray: begin
PArr := Result;
while L > 0 do begin
PArr^ := CloneDynArray( PPointer( Source )^, TypeInfo );
Inc( PPointer( Source ) );
Inc( PArr );
Dec( L );
end;
end;
else CopyArray( Result, Source, TypeInfo.TypeInfo, L );
end;
end else begin
// We can simply clone the data
Move( Source^, Result^, L * T.ElementSize );
end;
end;
Like Serg and Andreas said, the _ routines all use compiler magic to provide functionality, so you should use Copy instead of _CopyArray, is instead of _IsClass, etc.
To directly answer your question though, no, there is no way to call those routines from Delphi code in other units. The makefile for the RTL passes an undocumented compiler switch when compiling System.pas and SysInit.pas which tells the compiler to convert any leading _ characters to #. _CopyArray becomes #CopyArray, for example. You can call it using a BASM (assembly) block, but that's it.
The comment by Andreas Rejbrand is actually an answer - the _CopyArray procedure is called automaticaly when you copy complicated arrays. For example, set a breakpoint in _CopyArray and run the following code (should be compiled with debug .dcu to activate the breakpoint):
procedure TForm1.Button4Click(Sender: TObject);
type
TArr2D = array of TBytes;
var
A, B: TArr2D;
begin
A:= TArr2D.Create(TBytes.Create(1, 2, 3), TBytes.Create(4, 5));
B:= Copy(A);
Button4.Caption:= IntToStr(B[1, 1]);
end;
I have an Delphi 4 application, that extracts data from XLS 2003 sheets (filled Forms ) and inserts into SQL2005 DB .
i have a group of fields in XSL and SQL2005 called.In the Delphi code it is correspondingly called 133, 167 etc.The words around "smrBgm133GallonsGross, .." i.e "smrBgm" and "GrossGallons" are concatinated accordingly in the Delphi files.
SQL/XLS Delphi
smrBgm133GallonsGross... 133
smrBgm167GallonsGross ... 167
For the above I added a new field called in XSL/SQL called smrBgm167GallonsGrossDA
But the PROBLEM is in the Delphi it should be NAMED AS 229, NOT as 'smrBgm167GallonsGrossDA' (as per some biz rules;coz the Delphi appl, processes both EDI/XLS and EDI accepts 229)Hence getting an error while inserting and updating data via the EXCEL sheets ."saying 229 not found in DB".
(Excel sheets it is named as 'smrBgm167GallonsGrossDA' where as in Delphi it is named as '229').
How to tell the Delphi application....
"if it is " smrBgm167GallonsGrossDA" then consider it as "229"?????????????
Not entirely sure what you need, I can't make head nor tail from what you specificly are asking but perhaps this gets you on the right path.
function ExtractNumber(const Value: string): Integer;
begin
if Value = 'smrBgm167GallonsGrossDA' then
Result := 229
else
Result := YourNormalFunctionToExtractTheNumber(Value);
end;
if copy(fieldname, Length(fieldname) - 2, 2) = 'DA' then
begin
delphiField = 229
end
???
You can create a lookup table. Which can be used to lookup the name.
For example:
const
cSize = 2;
cNames : array[0..cSize-1] of string = (
'Name1', 'Name2'
);
CNumbers : array[0..cSize-1] of Integer = (
99, 123
);
function Convert(const AName: string): Integer;
var
i : Integer;
begin
i := 0;
while (i<cSize) do begin
if cNames[i] = AName then begin
Result := cNumbers[i];
Exit;
end;
Inc(i);
end;
Result := NormalConvert(AName);
end;
Note you can also use one array of records:
type
TLookupRec = record
name : string;
number : Integer;
end;
const
cSize = 2;
cLookup : array[0..cSize-1] of TLookupRec = (
( name : 'Name1'; number : 99; ),
( name : 'Name2'; number : 123; )
);
function Convert(const AName: string): Integer;
var
i : Integer;
begin
i := 0;
while (i<cSize) do begin
if cLookUp[i].name = AName then begin
Result := cLookUp[i].number;
Exit;
end;
Inc(i);
end;
Result := NormalConvert(AName);
end;