tntsysutils.pas

TNT Components Source

    if FileName[I] = PathDelim then Dec(I);
    Result := Copy(FileName, 1, I);
  end else Result := '';
end;

function WideExtractFileName(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := WideLastDelimiter('\:', FileName);
  Result := Copy(FileName, I + 1, MaxInt);
end;

function WideExtractFileExt(const FileName: WideString): WideString;
var
  I: Integer;
begin
  I := WideLastDelimiter('.\:', FileName);
  if (I > 0) and (FileName[I] = '.') then
    Result := Copy(FileName, I, MaxInt) else
    Result := '';
end;

function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;
var
  BasePath, DestPath: WideString;
  BaseLead, DestLead: PWideChar;
  BasePtr, DestPtr: PWideChar;

  function WideExtractFilePathNoDrive(const FileName: WideString): WideString;
  begin
    Result := WideExtractFilePath(FileName);
    Delete(Result, 1, Length(WideExtractFileDrive(FileName)));
  end;

  function Next(var Lead: PWideChar): PWideChar;
  begin
    Result := Lead;
    if Result = nil then Exit;
    Lead := WStrScan(Lead, PathDelim);
    if Lead <> nil then
    begin
      Lead^ := #0;
      Inc(Lead);
    end;
  end;

begin
  if WideSameText(WideExtractFileDrive(BaseName), WideExtractFileDrive(DestName)) then
  begin
    BasePath := WideExtractFilePathNoDrive(BaseName);
    DestPath := WideExtractFilePathNoDrive(DestName);
    BaseLead := Pointer(BasePath);
    BasePtr := Next(BaseLead);
    DestLead := Pointer(DestPath);
    DestPtr := Next(DestLead);
    while (BasePtr <> nil) and (DestPtr <> nil) and WideSameText(BasePtr, DestPtr) do
    begin
      BasePtr := Next(BaseLead);
      DestPtr := Next(DestLead);
    end;
    Result := '';
    while BaseLead <> nil do
    begin
      Result := Result + '..' + PathDelim;             { Do not localize }
      Next(BaseLead);
    end;
    if (DestPtr <> nil) and (DestPtr^ <> #0) then
      Result := Result + DestPtr + PathDelim;
    if DestLead <> nil then
      Result := Result + DestLead;     // destlead already has a trailing backslash
    Result := Result + WideExtractFileName(DestName);
  end
  else
    Result := DestName;
end;

function WideExpandFileName(const FileName: WideString): WideString;
var
  FName: PWideChar;
  Buffer: array[0..MAX_PATH - 1] of WideChar;
begin
  SetString(Result, Buffer, Tnt_GetFullPathNameW(PWideChar(FileName), MAX_PATH, Buffer, FName));
end;

function WideExtractShortPathName(const FileName: WideString): WideString;
var
  Buffer: array[0..MAX_PATH - 1] of WideChar;
begin
  SetString(Result, Buffer, Tnt_GetShortPathNameW(PWideChar(FileName), Buffer, MAX_PATH));
end;

function WideFileCreate(const FileName: WideString): Integer;
begin
  Result := Integer(Tnt_CreateFileW(PWideChar(FileName), GENERIC_READ or GENERIC_WRITE,
    0, nil, CREATE_ALWAYS, FILE_ATTRIBUTE_NORMAL, 0))
end;

function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
const
  AccessMode: array[0..2] of LongWord = (
    GENERIC_READ,
    GENERIC_WRITE,
    GENERIC_READ or GENERIC_WRITE);
  ShareMode: array[0..4] of LongWord = (
    0,
    0,
    FILE_SHARE_READ,
    FILE_SHARE_WRITE,
    FILE_SHARE_READ or FILE_SHARE_WRITE);
begin
  Result := Integer(Tnt_CreateFileW(PWideChar(FileName), AccessMode[Mode and 3],
    ShareMode[(Mode and $F0) shr 4], nil, OPEN_EXISTING,
      FILE_ATTRIBUTE_NORMAL, 0));
end;

function WideFileAge(const FileName: WideString): Integer;
var
  Handle: THandle;
  FindData: TWin32FindDataW;
  LocalFileTime: TFileTime;
begin
  Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      if FileTimeToDosDateTime(LocalFileTime, LongRec(Result).Hi, LongRec(Result).Lo) then
        Exit
    end;
  end;
  Result := -1;
end;

function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean;
var
  Handle: THandle;
  FindData: TWin32FindDataW;
  LSystemTime: TSystemTime;
  LocalFileTime: TFileTime;
begin
  Result := False;
  Handle := Tnt_FindFirstFileW(PWideChar(FileName), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
    begin
      Result := True;
      FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
      FileTimeToSystemTime(LocalFileTime, LSystemTime);
      with LSystemTime do
        FileDateTime := EncodeDate(wYear, wMonth, wDay) +
          EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
    end;
  end;
end;

function WideDirectoryExists(const Name: WideString): Boolean;
var
  Code: Cardinal;
begin
  Code := WideFileGetAttr(Name);
  Result := (Code <> INVALID_FILE_ATTRIBUTES) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
end;

function WideFileExists(const Name: WideString): Boolean;
var
  Handle: THandle;
  FindData: TWin32FindDataW;
begin
  Result := False;
  Handle := Tnt_FindFirstFileW(PWideChar(Name), FindData);
  if Handle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(Handle);
    if (FindData.dwFileAttributes and FILE_ATTRIBUTE_DIRECTORY) = 0 then
      Result := True;
  end;
end;

function WideFileGetAttr(const FileName: WideString): Cardinal;
begin
  Result := Tnt_GetFileAttributesW(PWideChar(FileName));
end;

function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
begin
  Result := Tnt_SetFileAttributesW(PWideChar(FileName), Attr)
end;

function WideFileIsReadOnly(const FileName: WideString): Boolean;
begin
  Result := (Tnt_GetFileAttributesW(PWideChar(FileName)) and faReadOnly) <> 0;
end;

function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
var
  Flags: Integer;
begin
  Result := False;
  Flags := Tnt_GetFileAttributesW(PWideChar(FileName));
  if Flags = -1 then Exit;
  if ReadOnly then
    Flags := Flags or faReadOnly
  else
    Flags := Flags and not faReadOnly;
  Result := Tnt_SetFileAttributesW(PWideChar(FileName), Flags);
end;

function WideForceDirectories(Dir: WideString): Boolean;
begin
  Result := True;
  if Length(Dir) = 0 then
    raise ETntGeneralError.Create(SCannotCreateDir);
  Dir := WideExcludeTrailingBackslash(Dir);
  if (Length(Dir) < 3) or WideDirectoryExists(Dir)
    or (WideExtractFilePath(Dir) = Dir) then Exit; // avoid 'xyz:\' problem.
  Result := WideForceDirectories(WideExtractFilePath(Dir));
  if Result then
    Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil)
end;

function WideFileSearch(const Name, DirList: WideString): WideString;
var
  I, P, L: Integer;
  C: WideChar;
begin
  Result := Name;
  P := 1;
  L := Length(DirList);
  while True do
  begin
    if WideFileExists(Result) then Exit;
    while (P <= L) and (DirList[P] = PathSep) do Inc(P);
    if P > L then Break;
    I := P;
    while (P <= L) and (DirList[P] <> PathSep) do
      Inc(P);
    Result := Copy(DirList, I, P - I);
    C := TntWideLastChar(Result);
    if (C <> DriveDelim) and (C <> PathDelim) then
      Result := Result + PathDelim;
    Result := Result + Name;
  end;
  Result := '';
end;

function WideRenameFile(const OldName, NewName: WideString): Boolean;
begin
  Result := Tnt_MoveFileW(PWideChar(OldName), PWideChar(NewName))
end;

function WideDeleteFile(const FileName: WideString): Boolean;
begin
  Result := Tnt_DeleteFileW(PWideChar(FileName))
end;

function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;
begin
  Result := Tnt_CopyFileW(PWideChar(FromFile), PWideChar(ToFile), FailIfExists)
end;

function _WideFindMatchingFile(var F: TSearchRecW): Integer;
var
  LocalFileTime: TFileTime;
begin
  with F do
  begin
    while FindData.dwFileAttributes and ExcludeAttr <> 0 do
      if not Tnt_FindNextFileW(FindHandle, FindData) then
      begin
        Result := GetLastError;
        Exit;
      end;
    FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
    FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
    Size := (Int64(FindData.nFileSizeHigh) shl 32) + FindData.nFileSizeLow;
    Attr := FindData.dwFileAttributes;
    Name := FindData.cFileName;
  end;
  Result := 0;
end;

function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
const
  faSpecial = faHidden or faSysFile {$IFNDEF COMPILER_9_UP} or faVolumeID {$ENDIF} or faDirectory;
begin
  F.ExcludeAttr := not Attr and faSpecial;
  F.FindHandle := Tnt_FindFirstFileW(PWideChar(Path), F.FindData);
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := _WideFindMatchingFile(F);
    if Result <> 0 then WideFindClose(F);
  end else
    Result := GetLastError;
end;

function WideFindNext(var F: TSearchRecW): Integer;
begin
  if Tnt_FindNextFileW(F.FindHandle, F.FindData) then
    Result := _WideFindMatchingFile(F) else
    Result := GetLastError;
end;

procedure WideFindClose(var F: TSearchRecW);
begin
  if F.FindHandle <> INVALID_HANDLE_VALUE then
  begin
    Windows.FindClose(F.FindHandle);
    F.FindHandle := INVALID_HANDLE_VALUE;
  end;
end;

function WideCreateDir(const Dir: WideString): Boolean;
begin
  Result := Tnt_CreateDirectoryW(PWideChar(Dir), nil);
end;

function WideRemoveDir(const Dir: WideString): Boolean;
begin
  Result := Tnt_RemoveDirectoryW(PWideChar(Dir));
end;

function WideGetCurrentDir: WideString;
begin
  SetLength(Result, MAX_PATH);
  Tnt_GetCurrentDirectoryW(MAX_PATH, PWideChar(Result));
  Result := PWideChar(Result);
end;

function WideSetCurrentDir(const Dir: WideString): Boolean;
begin
  Result := Tnt_SetCurrentDirectoryW(PWideChar(Dir));
end;

//=============================================================================================
//==  DATE/TIME STRING PARSING ================================================================
//=============================================================================================

function _IntTryStrToDateTime(Str: WideString; Flags: Integer; out DateTime: TDateTime): HResult;
begin
  Result := VarDateFromStr(Str, GetThreadLocale, Flags, Double(DateTime));
  if (not Succeeded(Result)) then begin
    if (Flags = VAR_TIMEVALUEONLY)
    and SysUtils.TryStrToTime{TNT-ALLOW TryStrToTime}(Str, DateTime) then
      Result := S_OK // SysUtils seems confident (works for date = "dd.MM.yy" and time = "H.mm.ss")
    else if (Flags = VAR_DATEVALUEONLY)
    and SysUtils.TryStrToDate{TNT-ALLOW TryStrToDate}(Str, DateTime) then
      Result := S_OK // SysUtils seems confident
    else if (Flags = 0)
    and SysUtils.TryStrToDateTime{TNT-ALLOW TryStrToDateTime}(Str, DateTime) then
      Result := S_OK // SysUtils seems confident
  end;
end;

function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, 0, DateTime));
end;

function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, DateTime));
end;

function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, DateTime));
end;

function ValidDateTimeStr(Str: WideString): Boolean;
var
  Temp: TDateTime;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, 0, Temp));
end;

function ValidDateStr(Str: WideString): Boolean;
var
  Temp: TDateTime;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_DATEVALUEONLY, Temp));
end;

function ValidTimeStr(Str: WideString): Boolean;
var
  Temp: TDateTime;
begin
  Result := Succeeded(_IntTryStrToDateTime(Str, VAR_TIMEVALUEONLY, Temp));
end;

function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
begin
  if not TntTryStrToDateTime(Str, Result) then
    Result := Default;
end;

function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
begin
  if not TntTryStrToDate(Str, Result) then
    Result := Default;
end;

function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;
begin
  if not TntTryStrToTime(Str, Result) then
    Result := Default;
end;

function _IntStrToDateTime(Str: WideString; Flags: Integer; ErrorFormatStr: WideString): TDateTime;
begin
  try
    OleCheck(_IntTryStrToDateTime(Str, Flags, Result));
  except
    on E: Exception do begin
      E.Message := E.Message + CRLF + WideFormat(ErrorFormatStr, [Str]);
      raise EConvertError.Create(E.Message);
    end;
  end;
end;

function TntStrToDateTime(Str: WideString): TDateTime;