714 lines
22 KiB
ObjectPascal
714 lines
22 KiB
ObjectPascal
////////////////////////////////////////////////////////////////////////////////
|
||
//
|
||
// ****************************************************************************
|
||
// * Project : FWZip
|
||
// * Unit Name : FWZipUtils
|
||
// * Purpose : Набор платформозависимых методов
|
||
// * Author : Александр (Rouse_) Багель
|
||
// * Copyright : © Fangorn Wizards Lab 1998 - 2024.
|
||
// * Version : 2.0.4
|
||
// * Home Page : http://rouse.drkb.ru
|
||
// * Home Blog : http://alexander-bagel.blogspot.ru
|
||
// ****************************************************************************
|
||
// * Stable Release : http://rouse.drkb.ru/components.php#fwzip
|
||
// * Latest Source : https://github.com/AlexanderBagel/FWZip
|
||
// ****************************************************************************
|
||
//
|
||
// Используемые источники:
|
||
// ftp://ftp.info-zip.org/pub/infozip/doc/appnote-iz-latest.zip
|
||
// https://zlib.net/zlib-1.3.1.tar.gz
|
||
// http://www.base2ti.com/
|
||
//
|
||
|
||
unit FWZipUtils;
|
||
|
||
{$IFDEF FPC}
|
||
{$MODE Delphi}
|
||
{$H+}
|
||
// у FPC криво реализованы инлайны, в частности FileSizeToInt64 теряет
|
||
// значение FileSizeHi при компиляции в 32 бита, поэтому отключаем
|
||
{$IFDEF CPU32}
|
||
{$UNDEF USE_INLINE}
|
||
{$ELSE}
|
||
{$DEFINE USE_INLINE}
|
||
{$ENDIF}
|
||
{$ELSE}
|
||
{$IF COMPILERVERSION > 15.0 }
|
||
{$DEFINE USE_INLINE}
|
||
{$IFEND}
|
||
{$ENDIF}
|
||
|
||
interface
|
||
|
||
uses
|
||
{$IFDEF LINUX}
|
||
Unix, Baseunix, DateUtils, Types,
|
||
{$ELSE}
|
||
Windows,
|
||
{$ENDIF}
|
||
{$IFDEF FPC}
|
||
LConvEncoding,
|
||
{$ENDIF}
|
||
SysUtils,
|
||
FWZipConsts;
|
||
|
||
// утилитарные преобразования для отключения ворнингов под FPC
|
||
// ===========================================================================
|
||
function HiByte(W: Word): Byte; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
function HiWord(L: DWORD): Word; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
function PtrToUInt(Value: Pointer): NativeUInt; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
function UIntToPtr(Value: NativeUInt): Pointer; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
|
||
function FileSizeToInt64(FileSizeLo, FileSizeHi: DWORD): Int64; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
function FileSizeToStr(Value: Int64): string;
|
||
|
||
// это позволит избежать сообщения об неинициализированных переменных под FPC
|
||
procedure ZeroMemory(Destination: Pointer; Length: NativeUInt); {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
|
||
// конвертация строк
|
||
// ===========================================================================
|
||
function ConvertToOemString(const Value: AnsiString): AnsiString;
|
||
function ConvertFromOemString(const Value: AnsiString): AnsiString;
|
||
function ExceptionMessage(const E: Exception): string; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
function LongPrefixPresent(const {%H-}APath: string): Boolean; {$IFDEF USE_INLINE}inline;{$ENDIF}
|
||
function IncludeLongNamePrefix(const Value: string): string;
|
||
|
||
// работа с аттрибутами файла
|
||
// ===========================================================================
|
||
function GetDiskFreeAvailable(const AFilePath: string): Int64;
|
||
function GetFileAttributes(const AFilePath: string;
|
||
out AAttr: TFileAttributeData): Boolean;
|
||
function IsAttributesPresent(Value: TFileAttributeData): Boolean;
|
||
procedure SetNormalFileAttributes(const AFilePath: string);
|
||
procedure SetFileAttributes(const AFilePath: string; AAttr: TFileAttributeData);
|
||
|
||
// работа с путями
|
||
// ===========================================================================
|
||
function PathCanonicalize(const AFilePath: string): string;
|
||
function MakeUniqueName(const AFilePath: string): string;
|
||
function ForceDirectoriesEx(Dir: string): Boolean;
|
||
|
||
// преобразование времени
|
||
// ===========================================================================
|
||
function FileTimeToLocalFileDate(AFileTime: TFileTime): Cardinal;
|
||
function FileTimeToLocalDateTime(AFileTime: TFileTime): TDateTime;
|
||
function DateTimeToFileTime(ADateTime: TDateTime): TFileTime;
|
||
|
||
// не реализованные под Linux аналоги Windows функций
|
||
// ===========================================================================
|
||
procedure FinallyFileBuffers(AHandle: THandle);
|
||
|
||
implementation
|
||
|
||
{$IFDEF MSWINDOWS}
|
||
function PathCanonicalizeApi(lpszDes, lpszSrc: PChar): BOOL; stdcall; external 'shlwapi.dll'
|
||
name {$IFDEF UNICODE}'PathCanonicalizeW'{$ELSE}'PathCanonicalizeA'{$ENDIF};
|
||
function PathMakeUniqueName(pszUniqueName: PWideChar; cchMax: Cardinal;
|
||
pszTemplate, pszLongPlate, pszDir: PWideChar): Boolean; stdcall; external 'shell32.dll';
|
||
{$ENDIF}
|
||
|
||
function FileSizeToInt64(FileSizeLo, FileSizeHi: DWORD): Int64;
|
||
begin
|
||
Result := FileSizeHi;
|
||
Result := Result shl 32;
|
||
Inc(Result, FileSizeLo);
|
||
end;
|
||
|
||
function HiByte(W: Word): Byte;
|
||
begin
|
||
Result := W shr 8;
|
||
end;
|
||
|
||
function HiWord(L: DWORD): Word;
|
||
begin
|
||
Result := L shr 16;
|
||
end;
|
||
|
||
procedure ZeroMemory(Destination: Pointer; Length: NativeUInt);
|
||
begin
|
||
FillChar(Destination^, Length, 0);
|
||
end;
|
||
|
||
function PtrToUInt(Value: Pointer): NativeUInt;
|
||
begin
|
||
Result := {%H-}NativeUInt(Value);
|
||
end;
|
||
|
||
function UIntToPtr(Value: NativeUInt): Pointer;
|
||
begin
|
||
Result := {%H-}Pointer(Value);
|
||
end;
|
||
|
||
{$IFDEF LINUX}
|
||
|
||
// эмуляция апи для работы с NTFS атрибутами, в частности с временем
|
||
|
||
const
|
||
NSECPERSEC = 10000000;
|
||
NSECPERMSEC = 10000;
|
||
MSECPERSEC = 1000;
|
||
SECSPERMIN = 60;
|
||
MINSPERHOUR = 60;
|
||
HOURSPERDAY = 24;
|
||
EPOCHWEEKDAY = 1; // 1 января 1601 был понедельником
|
||
DAYSPERWEEK = 7;
|
||
DAYSPERQUADRICENTENNIUM = 365 * 400 + 97;
|
||
DAYSPERNORMALQUADRENNIUM = 365 * 4 + 1;
|
||
MonthLength: array [Boolean] of array [0..11] of Integer =
|
||
((31, 28, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31),
|
||
(31, 29, 31, 30, 31, 30, 31, 31, 30, 31, 30, 31));
|
||
|
||
function SystemTimeToFileTime(
|
||
const ATime: TSystemTime; out AFileTime: TFileTime): Boolean;
|
||
|
||
function IsLeapYear: Boolean;
|
||
begin
|
||
Result := (ATime.Year mod 400 = 0) and
|
||
(ATime.Year mod 100 <> 0) or (ATime.Year mod 4 = 0);
|
||
end;
|
||
|
||
function IsDayTooBig: Boolean;
|
||
begin
|
||
Result := ATime.Day >
|
||
MonthLength[(ATime.Month = 2) and IsLeapYear][ATime.Month - 1];
|
||
end;
|
||
|
||
var
|
||
CalcYear, CalcMonth, CalcLeapCount, CalcDay: UInt64;
|
||
begin
|
||
Result := False;
|
||
|
||
// проверка входных данных
|
||
if ATime.Millisecond > 999 then Exit;
|
||
if ATime.Second > 59 then Exit;
|
||
if ATime.Minute > 59 then Exit;
|
||
if ATime.Hour > 23 then Exit;
|
||
if (ATime.Month < 1) or (ATime.Month > 12) then Exit;
|
||
if (ATime.Day < 1) or IsDayTooBig then Exit;
|
||
if (ATime.Year < 1601) or (ATime.Year > 30827) then Exit;
|
||
|
||
// преобразование с учетом високосных годов
|
||
// если текущий месяц меньше марта, то просто отнимаем год и добавляем 12 месяцев
|
||
// это учтется в дальнейшем
|
||
CalcYear := ATime.Year;
|
||
CalcMonth := ATime.Month;
|
||
if ATime.Month < 3 then
|
||
begin
|
||
Dec(CalcYear);
|
||
Inc(CalcMonth, 12);
|
||
end;
|
||
|
||
// количество високосных годов в пределах столетия
|
||
CalcLeapCount := (3 * (CalcYear div 100) + 3) shr 2;
|
||
|
||
// количество дней с 1601 года
|
||
CalcDay :=
|
||
(36525 * CalcYear) div 100 - CalcLeapCount + // год * количество дней в столетии с коррекцией по високосным
|
||
(1959 * (CalcMonth + 1)) shr 6 + // месяц * среднее кол-во дней
|
||
ATime.Day - // день
|
||
584817; // за вычетом количества дней до 1601 года
|
||
|
||
// считаем результат
|
||
PUint64(@AFileTime)^ := ((((
|
||
CalcDay * HOURSPERDAY +
|
||
ATime.Hour) * MINSPERHOUR +
|
||
ATime.Minute) * SECSPERMIN +
|
||
ATime.Second) * MSECPERSEC +
|
||
ATime.Millisecond) * NSECPERMSEC;
|
||
|
||
Result := True;
|
||
end;
|
||
|
||
function FileTimeToSystemTime(const AFileTime: TFileTime;
|
||
out ASystemTime: TSystemTime): Boolean;
|
||
var
|
||
FullTime, CalcYear, CalcMonth, CalcLeapCount,
|
||
CalcYearDay, CalcDay, CalcSecond: Int64;
|
||
begin
|
||
Result := False;
|
||
FullTime := PInt64(@AFileTime)^;
|
||
if FullTime < 0 then Exit;
|
||
|
||
// вытаскиваем количество миллисекунд и преобразуем время в секунды
|
||
ASystemTime.Millisecond := (FullTime mod NSECPERSEC) div NSECPERMSEC;
|
||
FullTime := FullTime div NSECPERSEC;
|
||
|
||
// получаем количество секунд
|
||
CalcSecond := FullTime mod SECSPERDAY;
|
||
|
||
// считаем время дня
|
||
ASystemTime.Hour := CalcSecond div SECSPERHOUR;
|
||
CalcSecond := CalcSecond mod SECSPERHOUR;
|
||
ASystemTime.Minute := CalcSecond div SECSPERMIN;
|
||
ASystemTime.Second := CalcSecond mod SECSPERMIN;
|
||
|
||
// получаем количество дней
|
||
CalcDay := FullTime div SECSPERDAY;
|
||
|
||
// считаем день недели
|
||
ASystemTime.DayOfWeek := (EPOCHWEEKDAY + CalcDay) mod DAYSPERWEEK;
|
||
|
||
// считаем год, месяц и день месяца
|
||
CalcLeapCount :=
|
||
(3 * ((CalcDay shl 2 + 1227) div DAYSPERQUADRICENTENNIUM) + 3) shr 2;
|
||
Inc(CalcDay, 28188 + CalcLeapCount);
|
||
CalcYear := (20 * CalcDay - 2442) div (5 * DAYSPERNORMALQUADRENNIUM);
|
||
CalcYearDay := CalcDay - (CalcYear * DAYSPERNORMALQUADRENNIUM) shr 2;
|
||
CalcMonth := (CalcYearDay shl 6) div 1959;
|
||
|
||
// результат для года который начинается с марта, если залазит на следущий
|
||
// то для преобразования отнимаем 12 месяцев и увеличиваем год
|
||
ASystemTime.Month := CalcMonth - 1;
|
||
ASystemTime.Year := CalcYear + 1524;
|
||
if ASystemTime.Month > 12 then
|
||
begin
|
||
Dec(ASystemTime.Month, 12);
|
||
Inc(ASystemTime.Year);
|
||
end;
|
||
|
||
ASystemTime.Day := CalcYearDay - (1959 * CalcMonth) shr 6;
|
||
end;
|
||
|
||
// преобразование из stat.st_atime (qword) в TFileTime
|
||
function UnixDateToFileTime(Value: Int64): TFileTime;
|
||
var
|
||
SystemTime: TSystemTime;
|
||
begin
|
||
DateTimeToSystemTime(UnixToDateTime(Value), SystemTime);
|
||
SystemTimeToFileTime(SystemTime, Result);
|
||
end;
|
||
|
||
function FileTimeToUnixDate(Value: TFileTime): Int64;
|
||
var
|
||
SystemTime: TSystemTime;
|
||
begin
|
||
FileTimeToSystemTime(Value, SystemTime);
|
||
Result := DateTimeToUnix(SystemTimeToDateTime(SystemTime));
|
||
end;
|
||
|
||
{$ENDIF}
|
||
|
||
function ConvertToOemString(const Value: AnsiString): AnsiString;
|
||
begin
|
||
Result := Value;
|
||
if Result = '' then Exit;
|
||
UniqueString(Result);
|
||
{$IFDEF FPC}
|
||
Result := UTF8ToCP866(Value);
|
||
{$ELSE}
|
||
AnsiToOem(PAnsiChar(Value), PAnsiChar(Result));
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function ConvertFromOemString(const Value: AnsiString): AnsiString;
|
||
begin
|
||
Result := Value;
|
||
if Result = '' then Exit;
|
||
UniqueString(Result);
|
||
{$IFDEF FPC}
|
||
Result := CP866ToUTF8(Value);
|
||
{$ELSE}
|
||
OemToAnsi(PAnsiChar(Result), PAnsiChar(Result));
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function ExceptionMessage(const E: Exception): string;
|
||
begin
|
||
Result := E.ClassName + ': ' + E.Message;
|
||
end;
|
||
|
||
function LongPrefixPresent(const APath: string): Boolean;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
Result := (Length(APath) >= 4) and
|
||
( (APath[1] = LongNamePrefix[1]) and
|
||
(APath[2] = LongNamePrefix[2]) and
|
||
(APath[3] = LongNamePrefix[3]) and
|
||
(APath[4] = LongNamePrefix[4]));
|
||
{$ELSE}
|
||
Result := False;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function IsLocalDrive(const Value: string): Boolean;
|
||
begin
|
||
Result := (Length(Value) > 2) and (Value[2] = ':');
|
||
end;
|
||
|
||
function IsNetworkSlashPresent(const Value: string): Boolean;
|
||
begin
|
||
Result := (Length(Value) > 2) and (Value[1] = '\') and (Value[2] = '\');
|
||
end;
|
||
|
||
function FixupFilePrefix(const Value: string): string;
|
||
begin
|
||
Result := StringReplace(Value, '/', '\', [rfReplaceAll]);
|
||
if AnsiSameText(Copy(Result, 1, 7), 'file:\\') then
|
||
begin
|
||
Delete(Result, 1, 7);
|
||
if not IsLocalDrive(Result) then
|
||
Result := '\\' + Result;
|
||
end;
|
||
end;
|
||
|
||
function IncludeLongNamePrefix(const Value: string): string;
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
if UseLongNamePrefix and not LongPrefixPresent(Value) and (Length(Value) > MAX_PATH) then
|
||
begin
|
||
Result := FixupFilePrefix(Value);
|
||
if IsLocalDrive(Result) then
|
||
Result := LongNamePrefix + Result
|
||
else
|
||
begin
|
||
if IsNetworkSlashPresent(Result) then
|
||
Delete(Result, 1, 2);
|
||
Result := UNCLongNamePrefix + Result;
|
||
end;
|
||
end
|
||
else
|
||
{$ENDIF}
|
||
Result := Value;
|
||
end;
|
||
|
||
function GetPresentFolder(const AFilePath: string): string;
|
||
begin
|
||
Result := AFilePath;
|
||
{$IFDEF LINUX}
|
||
while (Result <> '') and not DirectoryExists(Result) do
|
||
Result := ExtractFilePath(ExcludeTrailingPathDelimiter(Result));
|
||
if Result = '' then
|
||
Result := ExpandFileName('~');
|
||
{$ELSE}
|
||
if LongPrefixPresent(Result) then
|
||
Delete(Result, 1, 4);
|
||
Result := ExtractFileDrive(Result);
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function GetDiskFreeAvailable(const AFilePath: string): Int64;
|
||
{$IFDEF MSWINDOWS}
|
||
var
|
||
FreeAvailable, TotalSpace: Int64;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF LINUX}
|
||
Result := DiskFree(AddDisk(GetPresentFolder(AFilePath)));
|
||
{$ELSE}
|
||
{$IFDEF FPC}
|
||
FreeAvailable := -1;
|
||
TotalSpace := -1;
|
||
{$ENDIF}
|
||
if GetDiskFreeSpaceEx(PChar(GetPresentFolder(AFilePath)), FreeAvailable, TotalSpace, nil) then
|
||
Result := FreeAvailable
|
||
else
|
||
Result := -1;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function GetFileAttributes(const AFilePath: string;
|
||
out AAttr: TFileAttributeData): Boolean;
|
||
{$IFDEF LINUX}
|
||
|
||
var
|
||
Info: Stat;
|
||
SystemFileName: RawByteString;
|
||
begin
|
||
FillChar(AAttr, SizeOf(AAttr), 0);
|
||
SystemFileName := ToSingleByteFileSystemEncodedFileName(AFilePath);
|
||
Info := default(Stat);
|
||
if (fpstat(PChar(SystemFileName), Info) < 0) or fpS_ISDIR(info.st_mode) then
|
||
Result := False
|
||
else
|
||
begin
|
||
AAttr.dwFileAttributes := FileGetAttr(SystemFileName);
|
||
Result := AAttr.dwFileAttributes <> DWORD(-1);
|
||
if Result then
|
||
begin
|
||
AAttr.ftCreationTime := UnixDateToFileTime(Info.st_ctime);
|
||
AAttr.ftLastAccessTime := UnixDateToFileTime(Info.st_atime);
|
||
AAttr.ftLastWriteTime := UnixDateToFileTime(Info.st_mtime);
|
||
AAttr.nFileSizeHigh := Info.st_size shr 32;
|
||
AAttr.nFileSizeLow := DWORD(Info.st_size);
|
||
end;
|
||
end;
|
||
|
||
{$ELSE}
|
||
begin
|
||
Result := GetFileAttributesEx(PChar(AFilePath),
|
||
GetFileExInfoStandard, @AAttr);
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function IsAttributesPresent(Value: TFileAttributeData): Boolean;
|
||
begin
|
||
Result := (Value.ftCreationTime.dwLowDateTime <> 0) and
|
||
(Value.ftCreationTime.dwHighDateTime <> 0);
|
||
end;
|
||
|
||
procedure SetNormalFileAttributes(const AFilePath: string);
|
||
var
|
||
AAttr: TFileAttributeData;
|
||
begin
|
||
{$IFDEF FPC}
|
||
AAttr := Default(TFileAttributeData);
|
||
{$ENDIF}
|
||
AAttr.dwFileAttributes := $80; // FILE_ATTRIBUTE_NORMAL
|
||
SetFileAttributes(AFilePath, AAttr);
|
||
end;
|
||
|
||
procedure SetFileAttributes(const AFilePath: string; AAttr: TFileAttributeData);
|
||
{$IFDEF MSWINDOWS}
|
||
var
|
||
hFile: THandle;
|
||
{$ELSE}
|
||
var
|
||
SystemFileName: RawByteString;
|
||
t: TUTimBuf;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
Windows.SetFileAttributes(PChar(AFilePath), AAttr.dwFileAttributes);
|
||
{$ENDIF}
|
||
|
||
// проверка, есть ли аттрибуты времени?
|
||
if not IsAttributesPresent(AAttr) then Exit;
|
||
|
||
{$IFDEF LINUX}
|
||
t.actime := FileTimeToUnixDate(AAttr.ftLastAccessTime);
|
||
t.modtime:= FileTimeToUnixDate(AAttr.ftLastWriteTime);
|
||
SystemFileName := ToSingleByteFileSystemEncodedFileName(AFilePath);
|
||
fputime(PChar(SystemFileName), @t);
|
||
{$ELSE}
|
||
hFile := FileOpen(AFilePath, fmOpenWrite);
|
||
try
|
||
SetFileTime(hFile,
|
||
@AAttr.ftCreationTime,
|
||
@AAttr.ftLastAccessTime,
|
||
@AAttr.ftLastWriteTime);
|
||
finally
|
||
FileClose(hFile);
|
||
end;
|
||
{$ENDIF}
|
||
end;
|
||
|
||
{$IFDEF MSWINDOWS}
|
||
function CallPathCanonicalize(const AFilePath: string): string;
|
||
begin
|
||
Result := StringOfChar(#0, MAX_PATH);
|
||
if PathCanonicalizeApi(PChar(Result), PChar(AFilePath)) then
|
||
Result := PChar(Result)
|
||
else
|
||
Result := AFilePath;
|
||
end;
|
||
{$ENDIF}
|
||
|
||
function PathCanonicalize(const AFilePath: string): string;
|
||
begin
|
||
Result := AFilePath;
|
||
if Result = '' then Exit;
|
||
if Result[1] = '.' then
|
||
Result := IncludeTrailingPathDelimiter(GetCurrentDir) + Result;
|
||
{$IFDEF MSWINDOWS}
|
||
Result := IncludeLongNamePrefix(CallPathCanonicalize(Result));
|
||
{$ELSE}
|
||
Result := ExpandFileName(Result);
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function MakeUniqueName(const AFilePath: string): string;
|
||
{$IFDEF LINUX}
|
||
var
|
||
FilePath, FileName, FileExt, NewFileName: string;
|
||
I: Integer;
|
||
begin
|
||
Result := AFilePath;
|
||
if not FileExists(Result) then Exit;
|
||
FilePath := ExtractFilePath(AFilePath);
|
||
FileName := ExtractFileName(AFilePath);
|
||
FileExt := ExtractFileExt(FileName);
|
||
FileName := ChangeFileExt(FileName, '');
|
||
I := 1;
|
||
repeat
|
||
Inc(I);
|
||
NewFileName := FileName + ' (' + IntToStr(I) + ')' + FileExt;
|
||
until not FileExists(FilePath + NewFileName);
|
||
Result := FilePath + NewFileName;
|
||
{$ELSE}
|
||
{$IFDEF UNICODE}
|
||
var
|
||
FilePath, FileName: string;
|
||
begin
|
||
Result := AFilePath;
|
||
if not FileExists(Result) then Exit;
|
||
FilePath := ExtractFilePath(AFilePath);
|
||
FileName := ExtractFileName(AFilePath);
|
||
SetLength(Result, MAX_PATH);
|
||
if PathMakeUniqueName(PWideChar(Result), MAX_PATH,
|
||
nil, PWideChar(FileName), PWideChar(FilePath)) then
|
||
Result := PWideChar(Result);
|
||
{$ELSE}
|
||
var
|
||
UnicodeResult, FilePath, FileName: WideString;
|
||
begin
|
||
Result := AFilePath;
|
||
if not FileExists(Result) then Exit;
|
||
FilePath := WideString(ExtractFilePath(AFilePath));
|
||
FileName := WideString(ExtractFileName(AFilePath));
|
||
{$IFDEF FPC}
|
||
UnicodeResult := '';
|
||
{$ENDIF}
|
||
SetLength(UnicodeResult, MAX_PATH);
|
||
if PathMakeUniqueName(PWideChar(UnicodeResult), MAX_PATH,
|
||
nil, PWideChar(FileName), PWideChar(FilePath)) then
|
||
Result := AnsiString(PWideChar(UnicodeResult));
|
||
{$ENDIF}
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function ForceDirectoriesEx(Dir: string): Boolean;
|
||
|
||
// Обход ошибки ForceDirectories в случае использования префикса для
|
||
// поддержки длинных имен. Проверить ошибку можно вот таким кодом:
|
||
//
|
||
// S := '\\?\w:\test\'; // этой папки быть не должно!
|
||
// ForceDirectories(S); // с префиксом она не создастся
|
||
//
|
||
// Глюк заключается в том что при вызове DirectoryExists на строке "\\?\w:"
|
||
// функция GetFileAttributes возвращает INVALID_FILE_ATTRIBUTES,
|
||
// требуя чтобы для корня был указан слэш в конце в случае использования префикса,
|
||
// причем про эту особенность в MSDN нигде не написано.
|
||
//
|
||
// Соответсвтенно т.к. это будет второй рекурсивный вызов,
|
||
// он вернет первому False и в первом не выполнится CreateDir
|
||
|
||
{$IFDEF MSWINDOWS}
|
||
function InternalForce(Dir: string): Boolean;
|
||
var
|
||
PreviosDir: string;
|
||
begin
|
||
Result := Dir <> '';
|
||
if not Result or DirectoryExists(Dir) then
|
||
Exit;
|
||
|
||
Dir := ExcludeTrailingPathDelimiter(Dir);
|
||
PreviosDir := ExtractFilePath(Dir);
|
||
if PreviosDir = Dir then
|
||
Result := True
|
||
else
|
||
Result := InternalForce(PreviosDir) and CreateDir(Dir);
|
||
end;
|
||
{$ENDIF}
|
||
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
if LongPrefixPresent(Dir) then
|
||
Result := InternalForce(Dir)
|
||
else
|
||
{$ENDIF}
|
||
Result := ForceDirectories(Dir);
|
||
end;
|
||
|
||
function FileTimeToLocalFileDate(AFileTime: TFileTime): Cardinal;
|
||
{$IFDEF LINUX}
|
||
var
|
||
SystemTime: TSystemTime;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF LINUX}
|
||
DateTimeToSystemTime(FileTimeToLocalDateTime(AFileTime), SystemTime);
|
||
if (SystemTime.Year < 1980) or (SystemTime.Year > 2107) then
|
||
Result := 0
|
||
else
|
||
with SystemTime do
|
||
begin
|
||
LongRec(Result).Lo := (Second shr 1) or (Minute shl 5) or (Hour shl 11);
|
||
LongRec(Result).Hi := Day or (Month shl 5) or ((Year - 1980) shl 9);
|
||
end;
|
||
{$ELSE}
|
||
Result := DateTimeToFileDate(FileTimeToLocalDateTime(AFileTime));
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function FileTimeToLocalDateTime(AFileTime: TFileTime): TDateTime;
|
||
var
|
||
{$IFDEF LINUX}
|
||
UnixTime: Int64;
|
||
{$ELSE}
|
||
SystemTime: TSystemTime;
|
||
{$ENDIF}
|
||
begin
|
||
{$IFDEF LINUX}
|
||
UnixTime := FileTimeToUnixDate(AFileTime);
|
||
Result := UnixToDateTime(UnixTime, False);
|
||
{$ELSE}
|
||
// Rouse_ 25.10.2013
|
||
// Правка небольшой ошибки замеченой Владиславом Нечепоренко
|
||
//FileTimeToSystemTime(CurrentItem.Attributes.ftLastWriteTime, SystemTyme);
|
||
FileTimeToLocalFileTime(AFileTime, AFileTime);
|
||
{$IFDEF FPC}
|
||
SystemTime := Default(TSystemTime);
|
||
{$ENDIF}
|
||
FileTimeToSystemTime(AFileTime, SystemTime);
|
||
Result := SystemTimeToDateTime(SystemTime);
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function DateTimeToFileTime(ADateTime: TDateTime): TFileTime;
|
||
{$IFDEF MSWINDOWS}
|
||
var
|
||
SystemTime: TSystemTime;
|
||
begin
|
||
{$IFDEF FPC}
|
||
Result := Default(TFileTime);
|
||
{$ENDIF}
|
||
DateTimeToSystemTime(ADateTime, SystemTime);
|
||
SystemTimeToFileTime(SystemTime, Result);
|
||
LocalFileTimeToFileTime(Result, Result);
|
||
{$ELSE}
|
||
begin
|
||
Result := UnixDateToFileTime(DateTimeToUnix(ADateTime, False));
|
||
{$ENDIF}
|
||
end;
|
||
|
||
function FileSizeToStr(Value: Int64): string;
|
||
begin
|
||
if Value < 1024 then
|
||
begin
|
||
Result := Format('%d байт', [Value]);
|
||
Exit;
|
||
end;
|
||
Value := Value div 1024;
|
||
if Value < 1024 then
|
||
begin
|
||
Result := Format('%d килобайт', [Value]);
|
||
Exit;
|
||
end;
|
||
Value := Value div 1024;
|
||
if Value < 1024 then
|
||
begin
|
||
Result := Format('%d мегабайт', [Value]);
|
||
Exit;
|
||
end;
|
||
Value := Value div 1024;
|
||
if Value < 1024 then
|
||
begin
|
||
Result := Format('%d гигабайт', [Value]);
|
||
Exit;
|
||
end;
|
||
// ну а чем бог не шутит? :)
|
||
Value := Value div 1024;
|
||
Result := Format('%d терабайт', [Value]);
|
||
end;
|
||
|
||
procedure FinallyFileBuffers(AHandle: THandle);
|
||
begin
|
||
{$IFDEF MSWINDOWS}
|
||
FlushFileBuffers(AHandle);
|
||
{$ELSE}
|
||
FileFlush(AHandle);
|
||
{$ENDIF}
|
||
end;
|
||
|
||
end.
|