lasarus_compotents/fwzip/delphi7/FWZipUtils.pas

////////////////////////////////////////////////////////////////////////////////
//
//  ****************************************************************************
//  * 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.