I am currently using the following guidelines to get a file's "LastAccessTime" with Delphi
http://www.latiumsoftware.com/en/delphi/00007.php
Using FindNext, have access to a TSearchRec object from which I can access ftLastWriteTime which is of type TFileTime
when converting this to a TDateTime object (using the above source) and then outputting DateTimeToString I get the date and time out but the hour seems to be the sum of the two digits in the files ftLastWriteTime hour value.
i.e instead of getting 2009/09/03 13:45 I get 2009/09/03 04:45 or
instead of 2009/09/03 17:45 I get 2009/09/03 08:45
Any comments are most welcome, thanks in advance
"As usual" ;-) I'll point to the DSiWin32 which includes function DSiGetFileTimes which returns creation time, last access time and last modification time.
function DSiFileTimeToDateTime(fileTime: TFileTime; var dateTime: TDateTime): boolean;
var
sysTime: TSystemTime;
begin
Result := FileTimeToSystemTime(fileTime, sysTime);
if Result then
dateTime := SystemTimeToDateTime(sysTime);
end; { DSiFileTimeToDateTime }
function DSiGetFileTimes(const fileName: string; var creationTime, lastAccessTime,
lastModificationTime: TDateTime): boolean;
var
fileHandle : cardinal;
fsCreationTime : TFileTime;
fsLastAccessTime : TFileTime;
fsLastModificationTime: TFileTime;
begin
Result := false;
fileHandle := CreateFile(PChar(fileName), GENERIC_READ, FILE_SHARE_READ, nil,
OPEN_EXISTING, 0, 0);
if fileHandle <> INVALID_HANDLE_VALUE then try
Result :=
GetFileTime(fileHandle, #fsCreationTime, #fsLastAccessTime,
#fsLastModificationTime) and
DSiFileTimeToDateTime(fsCreationTime, creationTime) and
DSiFileTimeToDateTime(fsLastAccessTime, lastAccessTime) and
DSiFileTimeToDateTime(fsLastModificationTime, lastModificationTime);
finally
CloseHandle(fileHandle);
end;
end; { DSiGetFileTimes }
Typical, 20 minutes after making my first post I solve my own problem.
The author to the linked code avbove had two versions of the same code the second one is posted here http://www.latiumsoftware.com/en/delphi/00051.php
Problem solved! - I reckon the DOS library's interpretation of the Win32 timestamps was incorrect and that carried over into the code that followed. Maybe not? i will investigate futher if time allows.
The timestamps are in UTC, not local time.
Related
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 need UTC variants of the functions DateTimeToUnix and UnixToDateTime, so a Chinese customer is able to interact with the server in Germany. Both sides should be able to exchange Unix timestamps (in UTC, without DST) and be able to communicate through this way.
In a bugreport of HeidiSQL , users discussed that DateTimeToUnix and UnixToDateTime do not care about the time zone, and there I have found following code:
function DateTimeToUTC(dt: TDateTime): Int64;
var
tzi: TTimeZoneInformation;
begin
Result := DateTimeToUnix(dt);
GetTimeZoneInformation(tzi);
Result := Result + tzi.Bias * 60;
end;
MSDN explains twi.Bias as follows:
All translations between UTC time and local time are based on the following formula:
UTC = local time + bias
The bias is the difference, in minutes, between UTC time and local time.
This sounds logical, but since I was unsure if the code above was correct, I made following program to check it:
// A date in summer time (DST)
Memo1.Lines.add('1401494400'); // 31 May 2014 00:00:00 GMT according to http://www.epochconverter.com/
Memo1.Lines.add(inttostr(DateTimeToUnixUTC(StrToDate('31.05.2014'))));
// A date in winter time
Memo1.Lines.add('567302400'); // 24 Dec 1987 00:00:00 GMT according to http://www.epochconverter.com/
Memo1.Lines.add(inttostr(DateTimeToUnixUTC(StrToDate('24.12.1987'))));
The output in Germany (GMT+1+DST) is currently:
1401494400
1401490800
567302400
567298800
I expected the output being:
1401494400
1401494400
567302400
567302400
What am I doing wrong?
PS: For this project I am bound to Delphi 6.
You have already found DateTimeToUnix and UnixToDateTime. So that part of the conversion is taken care of.
All you need to do now is convert between local and UTC time. You can do that using DateUtils.TTimeZone class. Specifically DateUtils.TTimeZone.ToUniversalTime and DateUtils.TTimeZone.ToLocalTime.
These four functions give you all that you need.
I think I have found some solutions for my question. All 3 solutions gave the same output, but I will try to find out which one is best and I will test it on several machines with different locales.
Solution #1 using TzSpecificLocalTimeToSystemTime and SystemTimeToTzSpecificLocalTime works fine, but requires Windows XP and above:
(Source: https://stackoverflow.com/a/15567777/3544341 , modified)
// Statically binds Windows API functions instead of calling them dynamically.
// Requires Windows XP for the compiled application to run.
{.$DEFINE USE_NEW_WINDOWS_API}
{$IFDEF USE_NEW_WINDOWS_API}
function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime,lpLocalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'SystemTimeToTzSpecificLocalTime';
{$ELSE}
function SystemTimeToTzSpecificLocalTime(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime,lpLocalTime: TSystemTime): BOOL; stdcall;
var
h: HModule;
f: function(lpTimeZoneInformation: PTimeZoneInformation; var lpUniversalTime,lpLocalTime: TSystemTime): BOOL; stdcall;
begin
h := LoadLibrary(kernel32);
if h = 0 then RaiseLastOSError;
#f := GetProcAddress(h, 'SystemTimeToTzSpecificLocalTime');
if #f = nil then RaiseLastOSError;
result := f(lpTimeZoneInformation, lpUniversalTime, lpLocalTime);
end;
{$ENDIF}
{$IFDEF USE_NEW_WINDOWS_API}
function TzSpecificLocalTimeToSystemTime(lpTimeZoneInformation: PTimeZoneInformation; var lpLocalTime, lpUniversalTime: TSystemTime): BOOL; stdcall; external kernel32 name 'TzSpecificLocalTimeToSystemTime';
{$ELSE}
function TzSpecificLocalTimeToSystemTime(lpTimeZoneInformation: PTimeZoneInformation; var lpLocalTime, lpUniversalTime: TSystemTime): BOOL; stdcall;
var
h: HModule;
f: function(lpTimeZoneInformation: PTimeZoneInformation; var lpLocalTime, lpUniversalTime: TSystemTime): BOOL; stdcall;
begin
h := LoadLibrary(kernel32);
if h = 0 then RaiseLastOSError;
#f := GetProcAddress(h, 'TzSpecificLocalTimeToSystemTime');
if #f = nil then RaiseLastOSError;
result := f(lpTimeZoneInformation, lpLocalTime, lpUniversalTime);
end;
{$ENDIF}
function UTCToLocalDateTime_WinXP(d: TDateTime): TDateTime;
var
TZI: TTimeZoneInformation;
LocalTime, UniversalTime: TSystemTime;
begin
GetTimeZoneInformation(tzi);
DateTimeToSystemTime(d,UniversalTime);
SystemTimeToTzSpecificLocalTime(#tzi,UniversalTime,LocalTime);
Result := SystemTimeToDateTime(LocalTime);
end;
function LocalDateTimeToUTC_WinXP(d: TDateTime): TDateTime;
var
TZI: TTimeZoneInformation;
LocalTime, UniversalTime: TSystemTime;
begin
GetTimeZoneInformation(tzi);
DateTimeToSystemTime(d,LocalTime);
TzSpecificLocalTimeToSystemTime(#tzi,LocalTime,UniversalTime);
Result := SystemTimeToDateTime(UniversalTime);
end;
Solution #2 as workaround for older operating systems does also work fine:
(Source: http://www.delphipraxis.net/299286-post4.html )
uses DateUtils;
function GetDateTimeForBiasSystemTime(GivenDateTime: TSystemTime; GivenYear: integer): TDateTime;
var
Year, Month, Day: word;
Hour, Minute, Second, MilliSecond: word;
begin
GivenDateTime.wYear := GivenYear;
while not TryEncodeDayOfWeekInMonth(GivenDateTime.wYear, GivenDateTime.wMonth, GivenDateTime.wDay, GivenDateTime.wDayOfWeek, Result) do
Dec(GivenDateTime.wDay);
DecodeDateTime(Result, Year, Month, Day, Hour, Minute, Second, MilliSecond);
Result := EncodeDateTime(Year, Month, Day, GivenDateTime.wHour, GivenDateTime.wMinute, GivenDateTime.wSecond, GivenDateTime.wMilliseconds);
end;
function GetBiasForDate(GivenDateTime: TDateTime): integer;
var
tzi: TIME_ZONE_INFORMATION;
begin
GetTimeZoneInformation(tzi);
if (GivenDateTime < GetDateTimeForBiasSystemTime(tzi.StandardDate, YearOf(GivenDateTime))) and
(GivenDateTime >= GetDateTimeForBiasSystemTime(tzi.DaylightDate, YearOf(GivenDateTime))) then
Result := (tzi.Bias + tzi.DaylightBias) * -1
else
Result := (tzi.Bias + tzi.StandardBias) * -1;
end;
function UTCToLocalDateTime_OldWin(aUTC: TDateTime): TDateTime;
begin
Result := IncMinute(aUTC, GetBiasForDate(aUTC));
end;
function LocalDateTimeToUTC_OldWin(aLocal: TDateTime): TDateTime;
begin
Result := IncMinute(aLocal, GetBiasForDate(aLocal) * -1);
end;
Solution #3 using TTimeZone for users of newer versions of Delphi, does give the same results as the codes above:
(Solution by David Heffernan, alas not possible in my current project, because I am bound to Delphi 6)
uses DateUtils;
{$IF Declared(TTimeZone)}
function UTCToLocalDateTime_XE(aUTC: TDateTime): TDateTime;
begin
result := TTimeZone.Local.ToLocalTime(aUTC);
end;
function LocalDateTimeToUTC_XE(aLocal: TDateTime): TDateTime;
begin
result := TTimeZone.Local.ToUniversalTime(aLocal);
end;
{$IFEND}
Now we can put all 3 solutions together! :-)
function UTCToLocalDateTime(aUTC: TDateTime): TDateTime;
begin
{$IF Declared(UTCToLocalDateTime_XE)}
result := UTCToLocalDateTime_XE(aUTC);
{$ELSE}
{$IFDEF USE_NEW_WINDOWS_API}
result := UTCToLocalDateTime_WinXP(aUTC);
{$ELSE}
try
result := UTCToLocalDateTime_WinXP(aUTC);
except
on E: EOSError do
begin
// Workaround for Windows versions older than Windows XP
result := UTCToLocalDateTime_OldWin(aUTC);
end
else raise;
end;
{$ENDIF}
{$IFEND}
end;
function LocalDateTimeToUTC(aLocal: TDateTime): TDateTime;
begin
{$IF Declared(LocalDateTimeToUTC_XE)}
result := LocalDateTimeToUTC_XE(aLocal);
{$ELSE}
{$IFDEF USE_NEW_WINDOWS_API}
result := LocalDateTimeToUTC_WinXP(aLocal);
{$ELSE}
try
result := LocalDateTimeToUTC_WinXP(aLocal);
except
on E: EOSError do
begin
// Workaround for Windows versions older than Windows XP
result := LocalDateTimeToUTC_OldWin(aLocal);
end
else raise;
end;
{$ENDIF}
{$IFEND}
end;
An easy method to get the current UTC unix timestamp is
function NowUTC: TDateTime;
var
st: TSystemTime;
begin
GetSystemTime(st);
result := EncodeDateTime(st.wYear, st.wMonth, st.wDay, st.wHour, st.wMinute, st.wSecond, st.wMilliseconds);
end;
function CurrentUnixUTCTimestamp: int64;
begin
result := DateTimeToUnix(NowUTC);
end;
DateTimeToUnix and UnixToDateTime have got a second argument now:
function DateTimeToUnix(const AValue: TDateTime; AInputIsUTC: Boolean): Int64;
function UnixToDateTime(const AValue: Int64; AReturnUTC: Boolean): TDateTime;
So, you can easily choose between UTC and local time.
Using kbmMW's TkbmMWDateTime class it is very easy as it is always timezone aware:
var
dt:TkbmMWDateTime;
unix:int64;
begin
dt:=TkbmMWDateTime.Now;
unix:=dt.UTCSinceEpoch;
end;
And it also goes the other way around. In fact there are many such epoch variations and time formats supported in TkbmMWDateTime.
I would recommend, if you any place need to exchange a string with date/time info in it, to use ISO8601 format. In kbmMW you do like this:
var
s:string;
begin
s:=TkbmMWDateTime.Now.ISO8601String;
...
end;
It also goes two ways.
You can read a bit more about kbmMW's DateTime handling here:
https://components4developers.blog/2018/05/25/kbmmw-features-3-datetime/
kbmMW is a toolbox that fully supports Delphi including all platforms.
I have a problem getting file modified time as julian date. My Delphi 2010 looks like this:
AHandle := FindFirstFile(PChar('C:\*'), FindData);
if (AHandle <> INVALID_HANDLE_VALUE) then
begin
repeat
if (FindData.dwFileAttributes And FILE_ATTRIBUTE_DIRECTORY = 0) then
ModifJulianDate := FileTimeToJulianDate(FindData.ftLastWriteTime);
until Not FindNextFile(AHandle, FindData);
end;
The problem is: FileTimeToJulianDate() returned result has one hour offset, ie. if the file's modified time is 10:01, this code returns 9:01!!
How can I fix this?
The functionality that you are looking for, assuming your answer is accurate, is most easily implemented using FileTimeToLocalFileTime.
function UTCFileTimeToLocalDateTime(const UTCFileTime: TFileTime): TDateTime;
var
LocalFileTime: TFileTime;
LocalSystemTime: TSystemTime;
begin
if not FileTimeToLocalFileTime(UTCFileTime, LocalFileTime) then
RaiseLastOSError;
if not FileTimeToSystemTime(LocalFileTime, LocalSystemTime) then
RaiseLastOSError;
Result := SystemTimeToDateTime(LocalSystemTime);
end;
Or if you prefer to use SystemTimeToTzSpecificLocalTime then do so like this:
function UTCFileTimeToLocalDateTime(const UTCFileTime: TFileTime): TDateTime;
var
UTCSystemTime, LocalSystemTime: TSystemTime;
begin
if not FileTimeToSystemTime(UTCFileTime, UTCSystemTime) then
RaiseLastOSError;
if not SystemTimeToTzSpecificLocalTime(nil, UTCSystemTime, LocalSystemTime) then
RaiseLastOSError;
Result := SystemTimeToDateTime(LocalSystemTime);
end;
With the help of LU RD & the code posted here, I managed to get what I wanted, in case someone need something like this, here's my code:
function GetDateFileModified(UTCTime : TFileTime{FindData : TWin32FindData}) : TDateTime;
// Return the file modified date as a string in local time
var
GMTsystemTime : Windows.TSystemTime;
LocalSysTime : Windows.TSystemTime;
TimeZone : Windows._TIME_ZONE_INFORMATION;
begin
Result := 0;
// Get Timezone Information
GetTimeZoneInformation(TimeZone);
// UTCTime := FindData.ftLastWriteTime;
if FileTimeToSystemTime(UTCTime, GMTsystemTime) then
begin
SystemTimeToTzSpecificLocalTime(#TimeZone, GMTsystemTime, LocalSysTime);
Result := SystemTimeToDateTime(LocalSysTime);
end;
end;
about get size of a file, i have this two functions:
function GetFileSize1(const FileName: TFileName): Int64;
var
iTmp: Int64;
SearchRec: TSearchRec;
begin
iTmp := -1;
if FindFirst(FileName, faAnyFile, SearchRec) = 0 then
begin
iTmp := SearchRec.Size;
System.SysUtils.FindClose(SearchRec);
end;
Result := iTmp;
end;
And:
function GetFileSize2(const FileName: TFileName): Int64;
var
FileStream: TFileStream;
begin
FileStream := TFileStream.Create(FileName, fmOpenRead);
try
Result := FileStream.Size;
finally
FileStream.Free;
end;
end;
In practise, what is the difference of it? Both return same result of course but what is more affidable, more fast, more secure? Or better, what is preferible use? First or second?
Thanks very much.
Well, the obvious difference is that GetFileSize2 opens the file, using the CreateFile API to obtain a file handle. In contrast, GetFileSize1 does not because it reads the size from the file meta data.
So I would expect GetFileSize1 to perform better. Although, for many applications that performance difference would not matter. Much more significantly, GetFileSize2 can fail due to a sharing violation in situations that GetFileSize1 will succeed. So you really should not use GetFileSize2.
Note also that the two functions you present behave differently in case of an error: GetFileSize1 returns -1, and GetFileSize2 raises an exception.
Personally I prefer this version:
function GetFileSize3(const FileName: string): Int64;
var
fad: TWin32FileAttributeData;
begin
if not GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, #fad) then
RaiseLastOSError;
Int64Rec(Result).Lo := fad.nFileSizeLow;
Int64Rec(Result).Hi := fad.nFileSizeHigh;
end;
Or, if you prefer to return -1 in case of error you would write it like this:
function GetFileSize3(const FileName: string): Int64;
var
fad: TWin32FileAttributeData;
begin
if not GetFileAttributesEx(PChar(FileName), GetFileExInfoStandard, #fad) then
exit(-1);
Int64Rec(Result).Lo := fad.nFileSizeLow;
Int64Rec(Result).Hi := fad.nFileSizeHigh;
end;
Some how this feels more natural than calling FindFirstFile, but that's perhaps just personal preference. There's really nothing wrong with the FindFirstFile approach. Although it doesn't need that iTmp variable. You can write it more clearly like this:
function GetFileSize1(const FileName: TFileName): Int64;
var
SearchRec: TSearchRec;
begin
if FindFirst(FileName, faAnyFile, SearchRec) = 0 then
begin
Result := SearchRec.Size;
System.SysUtils.FindClose(SearchRec);
end
else
Result := -1;
end;
Update: #CodeInChaos makes a good point about the approaches that don't open a file handle. These approaches can give inaccurate results for hard linked files.
The difference is, that GetFileSize1 reads the Meta Information of a file (Windows-API-Call) and GetFileSize2 has a direct touch to the file (getting FileHandle, walk through until the end to calculate the size).
So GetFileSize1 consumes less performance/ressources than GetFileSize2
UPDATE
I forgot to mention, if the file is already in use, you maybe not allowed to get access with a TFileStream, but the Meta Information will be available.
UPDATE (just another Variant of Davids suggestion)
function GetFileSize1(const FileName: TFileName): Int64;
var
SearchRec: TSearchRec;
begin
if FindFirst( FileName, faAnyFile, SearchRec ) = 0 then
try
Exit( SearchRec.Size );
finally
System.SysUtils.FindClose(SearchRec);
end;
Result := -1;
end;
I need to compare if two TStream descendant have the same content.
The only interesting result for me is the boolean Yes / No.
I'm going to code a simple loop checking byte after byte the streams content's.
But I'm curious to know if there is an already existing function. I haven't found any inside DelphiXE or JCL/JVCL libs.
Of course, the two streams have the same size !
Exactly, as Nickolay O. said you should read your stream in blocks and use CompareMem. Here is an example (including size test) ...
function IsIdenticalStreams(Source, Destination: TStream): boolean;
const Block_Size = 4096;
var Buffer_1: array[0..Block_Size-1] of byte;
Buffer_2: array[0..Block_Size-1] of byte;
Buffer_Length: integer;
begin
Result := False;
if Source.Size <> Destination.Size then
Exit;
while Source.Position < Source.Size do
begin
Buffer_Length := Source.Read(Buffer_1, Block_Size);
Destination.Read(Buffer_2, Block_Size);
if not CompareMem(#Buffer_1, #Buffer_2, Buffer_Length) then
Exit;
end;
Result := True;
end;
The IsIdenticalStreams function posted by daemon_x is excellent - but needs one adjustment to work properly. (Uwe Raabe caught the issue already.) It is critical that you reset the stream positions before starting the loop - or this procedure will probably return an incorrect TRUE if the two streams were already accessed outside this function.
This is the final solution that works every time. I just renamed the function to suit my naming conventions. Thank you daemon_x for the elegant solution.
function StreamsAreIdentical(Stream1, Stream2: TStream): boolean;
const
Block_Size = 4096;
var
Buffer_1: array[0..Block_Size-1] of byte;
Buffer_2: array[0..Block_Size-1] of byte;
Buffer_Length: integer;
begin
Result := False;
if Stream1.Size <> Stream2.Size then exit;
// These two added lines are critical for proper operation
Stream1.Position := 0;
Stream2.Position := 0;
while Stream1.Position < Stream1.Size do
begin
Buffer_Length := Stream1.Read(Buffer_1, Block_Size);
Stream2.Read(Buffer_2, Block_Size);
if not CompareMem(#Buffer_1, #Buffer_2, Buffer_Length) then exit;
end;
Result := True;
end;
There is no such built-in function. Only one thing I can recommend - read not byte-to-byte, but using blocks of 16-64kbytes, that would be much faster.
Answers from user532231 and Mike are working in 99% cases, but there are additional checks to be made!
Descendants of TStream can be almost anything, so it's not guaranteed that Stream.Read will return same amount of data, even if streams are of the same length (stream descendant can also download data, so may return readed=0 bytes, while waiting for next chunk). Streams can be also on completelly different media and stream read error could occur on just one.
For 100% working code all these checks should be made. I modified the function from Mike.
If this function is used for example to rewrite stream 2 if not identical to Stream1, all errors should be checked. When function result is True, everthing is ok, but if it is False, it would be very smart to check if Streams are actually different or just some error occured.
Edited: Added some additional checks, FilesAreIdentical function based on StreamsAreIdentical and usage example.
// Usage example
var lError: Integer;
...
if FilesAreIdentical(lError, 'file1.ext', 'file2.ext')
then Memo1.Lines.Append('Files are identical.')
else case lError of
0: Memo1.Lines.Append('Files are NOT identical!');
1: Memo1.Lines.Append('Files opened, stream read exception raised!');
2: Memo1.Lines.Append('File does not exist!');
3: Memo1.Lines.Append('File open exception raised!');
end; // case
...
// StreamAreIdentical
function StreamsAreIdentical(var aError: Integer;
const aStream1, aStream2: TStream;
const aBlockSize: Integer = 4096): Boolean;
var
lBuffer1: array of byte;
lBuffer2: array of byte;
lBuffer1Readed,
lBuffer2Readed,
lBlockSize: integer;
begin
Result:=False;
aError:=0;
try
if aStream1.Size <> aStream2.Size
then Exit;
aStream1.Position:=0;
aStream2.Position:=0;
if aBlockSize>0
then lBlockSize:=aBlockSize
else lBlockSize:=4096;
SetLength(lBuffer1, lBlockSize);
SetLength(lBuffer2, lBlockSize);
lBuffer1Readed:=1; // just for entering while
while (lBuffer1Readed > 0) and (aStream1.Position < aStream1.Size) do
begin
lBuffer1Readed := aStream1.Read(lBuffer1[0], lBlockSize);
lBuffer2Readed := aStream2.Read(lBuffer2[0], lBlockSize);
if (lBuffer1Readed <> lBuffer2Readed) or ((lBuffer1Readed <> lBlockSize) and (aStream1.Position < aStream1.Size))
then Exit;
if not CompareMem(#lBuffer1[0], #lBuffer2[0], lBuffer1Readed)
then Exit;
end; // while
Result:=True;
except
aError:=1; // stream read exception
end;
end;
// FilesAreIdentical using function StreamsAreIdentical
function FilesAreIdentical(var aError: Integer;
const aFileName1, aFileName2: String;
const aBlockSize: Integer = 4096): Boolean;
var lFileStream1,
lFilestream2: TFileStream;
begin
Result:=False;
try
if not (FileExists(aFileName1) and FileExists(aFileName2))
then begin
aError:=2; // file not found
Exit;
end;
lFileStream1:=nil;
lFileStream2:=nil;
try
lFileStream1:=TfileStream.Create(aFileName1, fmOpenRead or fmShareDenyNone);
lFileStream2:=TFileStream.Create(aFileName2, fmOpenRead or fmShareDenyNone);
result:=StreamsAreIdentical(aError, lFileStream1, lFileStream2, aBlockSize);
finally
if lFileStream2<>nil
then lFileStream2.Free;
if lFileStream1<>nil
then lFileStream1.Free;
end; // finally
except
aError:=3; // file open exception
end; // except
end;