tntsysutils.pas

TNT Components Source

{*****************************************************************************}
{                                                                             }
{    Tnt Delphi Unicode Controls                                              }
{      http://www.tntware.com/delphicontrols/unicode/                         }
{        Version: 2.3.0                                                       }
{                                                                             }
{    Copyright (c) 2002-2007, Troy Wolbrink ([e-mail])       }
{                                                                             }
{*****************************************************************************}

unit TntSysUtils;

{$INCLUDE TntCompilers.inc}

interface

{ TODO: Consider: more filename functions from SysUtils }
{ TODO: Consider: string functions from StrUtils. }

uses
  Types, SysUtils, Windows;

//---------------------------------------------------------------------------------------------
//                                 Tnt - Types
//---------------------------------------------------------------------------------------------

// ......... introduced .........
type
  // The user of the application did something plainly wrong.
  ETntUserError = class(Exception);
  // A general error occured. (ie. file didn't exist, server didn't return data, etc.)
  ETntGeneralError = class(Exception);
  // Like Assert().  An error occured that should never have happened, send me a bug report now!
  ETntInternalError = class(Exception);

//---------------------------------------------------------------------------------------------
//                                 Tnt - SysUtils
//---------------------------------------------------------------------------------------------

// ......... SBCS and MBCS functions with WideString replacements in SysUtils.pas .........

{TNT-WARN CompareStr}                   {TNT-WARN AnsiCompareStr}
{TNT-WARN SameStr}                      {TNT-WARN AnsiSameStr}
{TNT-WARN SameText}                     {TNT-WARN AnsiSameText}
{TNT-WARN CompareText}                  {TNT-WARN AnsiCompareText}
{TNT-WARN UpperCase}                    {TNT-WARN AnsiUpperCase}
{TNT-WARN LowerCase}                    {TNT-WARN AnsiLowerCase}

{TNT-WARN AnsiPos}  { --> Pos() supports WideString. }
{TNT-WARN FmtStr}
{TNT-WARN Format}
{TNT-WARN FormatBuf}

// ......... MBCS Byte Type Procs .........

{TNT-WARN ByteType}
{TNT-WARN StrByteType}
{TNT-WARN ByteToCharIndex}
{TNT-WARN ByteToCharLen}
{TNT-WARN CharToByteIndex}
{TNT-WARN CharToByteLen}

// ........ null-terminated string functions .........

{TNT-WARN StrEnd}
{TNT-WARN StrLen}
{TNT-WARN StrLCopy}
{TNT-WARN StrCopy}
{TNT-WARN StrECopy}
{TNT-WARN StrPLCopy}
{TNT-WARN StrPCopy}
{TNT-WARN StrLComp}
{TNT-WARN AnsiStrLComp}
{TNT-WARN StrComp}
{TNT-WARN AnsiStrComp}
{TNT-WARN StrLIComp}
{TNT-WARN AnsiStrLIComp}
{TNT-WARN StrIComp}
{TNT-WARN AnsiStrIComp}
{TNT-WARN StrLower}
{TNT-WARN AnsiStrLower}
{TNT-WARN StrUpper}
{TNT-WARN AnsiStrUpper}
{TNT-WARN StrPos}
{TNT-WARN AnsiStrPos}
{TNT-WARN StrScan}
{TNT-WARN AnsiStrScan}
{TNT-WARN StrRScan}
{TNT-WARN AnsiStrRScan}
{TNT-WARN StrLCat}
{TNT-WARN StrCat}
{TNT-WARN StrMove}
{TNT-WARN StrPas}
{TNT-WARN StrAlloc}
{TNT-WARN StrBufSize}
{TNT-WARN StrNew}
{TNT-WARN StrDispose}

{TNT-WARN AnsiExtractQuotedStr}
{TNT-WARN AnsiLastChar}
{TNT-WARN AnsiStrLastChar}
{TNT-WARN QuotedStr}
{TNT-WARN AnsiQuotedStr}
{TNT-WARN AnsiDequotedStr}

// ........ string functions .........

{$IFNDEF COMPILER_9_UP}
  //
  // pre-Delphi 9 issues w/ WideFormatBuf, WideFmtStr and WideFormat
  //

  {$IFDEF COMPILER_7_UP}
  type
    PFormatSettings = ^TFormatSettings;
  {$ENDIF}

  // SysUtils.WideFormatBuf doesn't correctly handle numeric specifiers.
  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const): Cardinal; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const;
      const FormatSettings: TFormatSettings): Cardinal; overload;
  {$ENDIF}

  // SysUtils.WideFmtStr doesn't handle string lengths > 4096.
  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const); {$IFDEF COMPILER_7_UP} overload; {$ENDIF}

  {$IFDEF COMPILER_7_UP}
  procedure Tnt_WideFmtStr(var Result: WideString; const FormatStr: WideString;
    const Args: array of const; const FormatSettings: TFormatSettings); overload;
  {$ENDIF}

  {----------------------------------------------------------------------------------------
    Without the FormatSettings parameter, Tnt_WideFormat is *NOT* necessary...
      TntSystem.InstallTntSystemUpdates([tsFixWideFormat]);
        will fix WideFormat as well as WideFmtStr.
  ----------------------------------------------------------------------------------------}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const): WideString; {$IFDEF COMPILER_7_UP} overload; {$ENDIF}

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormat(const FormatStr: WideString; const Args: array of const;
    const FormatSettings: TFormatSettings): WideString; overload;
  {$ENDIF}

{$ENDIF}

{TNT-WARN WideUpperCase} // SysUtils.WideUpperCase is broken on Win9x for D6, D7, D9.
function Tnt_WideUpperCase(const S: WideString): WideString;
{TNT-WARN WideLowerCase} // SysUtils.WideLowerCase is broken on Win9x for D6, D7, D9.
function Tnt_WideLowerCase(const S: WideString): WideString;

function TntWideLastChar(const S: WideString): WideChar;

{TNT-WARN StringReplace}
{TNT-WARN WideStringReplace} // <-- WideStrUtils.WideStringReplace uses SysUtils.WideUpperCase which is broken on Win9x.
function Tnt_WideStringReplace(const S, OldPattern, NewPattern: WideString;
  Flags: TReplaceFlags; WholeWord: Boolean = False): WideString;

{TNT-WARN AdjustLineBreaks}
type TTntTextLineBreakStyle = (tlbsLF, tlbsCRLF, tlbsCR);
function TntAdjustLineBreaksLength(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): Integer;
function TntAdjustLineBreaks(const S: WideString; Style: TTntTextLineBreakStyle = tlbsCRLF): WideString;

{TNT-WARN WrapText}
function WideWrapText(const Line, BreakStr: WideString; const BreakChars: TSysCharSet;
  MaxCol: Integer): WideString; overload;
function WideWrapText(const Line: WideString; MaxCol: Integer): WideString; overload;

// ........ filename manipulation .........

{TNT-WARN SameFileName}           // doesn't apply to Unicode filenames, use WideSameText
{TNT-WARN AnsiCompareFileName}    // doesn't apply to Unicode filenames, use WideCompareText
{TNT-WARN AnsiLowerCaseFileName}  // doesn't apply to Unicode filenames, use WideLowerCase
{TNT-WARN AnsiUpperCaseFileName}  // doesn't apply to Unicode filenames, use WideUpperCase

{TNT-WARN IncludeTrailingBackslash}
function WideIncludeTrailingBackslash(const S: WideString): WideString;
{TNT-WARN IncludeTrailingPathDelimiter}
function WideIncludeTrailingPathDelimiter(const S: WideString): WideString;
{TNT-WARN ExcludeTrailingBackslash}
function WideExcludeTrailingBackslash(const S: WideString): WideString;
{TNT-WARN ExcludeTrailingPathDelimiter}
function WideExcludeTrailingPathDelimiter(const S: WideString): WideString;
{TNT-WARN IsDelimiter}
function WideIsDelimiter(const Delimiters, S: WideString; Index: Integer): Boolean;
{TNT-WARN IsPathDelimiter}
function WideIsPathDelimiter(const S: WideString; Index: Integer): Boolean;
{TNT-WARN LastDelimiter}
function WideLastDelimiter(const Delimiters, S: WideString): Integer;
{TNT-WARN ChangeFileExt}
function WideChangeFileExt(const FileName, Extension: WideString): WideString;
{TNT-WARN ExtractFilePath}
function WideExtractFilePath(const FileName: WideString): WideString;
{TNT-WARN ExtractFileDir}
function WideExtractFileDir(const FileName: WideString): WideString;
{TNT-WARN ExtractFileDrive}
function WideExtractFileDrive(const FileName: WideString): WideString;
{TNT-WARN ExtractFileName}
function WideExtractFileName(const FileName: WideString): WideString;
{TNT-WARN ExtractFileExt}
function WideExtractFileExt(const FileName: WideString): WideString;
{TNT-WARN ExtractRelativePath}
function WideExtractRelativePath(const BaseName, DestName: WideString): WideString;

// ........ file management routines .........

{TNT-WARN ExpandFileName}
function WideExpandFileName(const FileName: WideString): WideString;
{TNT-WARN ExtractShortPathName}
function WideExtractShortPathName(const FileName: WideString): WideString;
{TNT-WARN FileCreate}
function WideFileCreate(const FileName: WideString): Integer;
{TNT-WARN FileOpen}
function WideFileOpen(const FileName: WideString; Mode: LongWord): Integer;
{TNT-WARN FileAge}
function WideFileAge(const FileName: WideString): Integer; overload;
function WideFileAge(const FileName: WideString; out FileDateTime: TDateTime): Boolean; overload;
{TNT-WARN DirectoryExists}
function WideDirectoryExists(const Name: WideString): Boolean;
{TNT-WARN FileExists}
function WideFileExists(const Name: WideString): Boolean;
{TNT-WARN FileGetAttr}
function WideFileGetAttr(const FileName: WideString): Cardinal;
{TNT-WARN FileSetAttr}
function WideFileSetAttr(const FileName: WideString; Attr: Integer): Boolean;
{TNT-WARN FileIsReadOnly}
function WideFileIsReadOnly(const FileName: WideString): Boolean;
{TNT-WARN FileSetReadOnly}
function WideFileSetReadOnly(const FileName: WideString; ReadOnly: Boolean): Boolean;
{TNT-WARN ForceDirectories}
function WideForceDirectories(Dir: WideString): Boolean;
{TNT-WARN FileSearch}
function WideFileSearch(const Name, DirList: WideString): WideString;
{TNT-WARN RenameFile}
function WideRenameFile(const OldName, NewName: WideString): Boolean;
{TNT-WARN DeleteFile}
function WideDeleteFile(const FileName: WideString): Boolean;
{TNT-WARN CopyFile}
function WideCopyFile(FromFile, ToFile: WideString; FailIfExists: Boolean): Boolean;


{TNT-WARN TFileName}
type
  TWideFileName = type WideString;

{TNT-WARN TSearchRec} // <-- FindFile - warning on TSearchRec is all that is necessary
type
  TSearchRecW = record
    Time: Integer;
    Size: Int64;
    Attr: Integer;
    Name: TWideFileName;
    ExcludeAttr: Integer;
    FindHandle: THandle;
    FindData: TWin32FindDataW;
  end;
function WideFindFirst(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer;
function WideFindNext(var F: TSearchRecW): Integer;
procedure WideFindClose(var F: TSearchRecW);

{TNT-WARN CreateDir}
function WideCreateDir(const Dir: WideString): Boolean;
{TNT-WARN RemoveDir}
function WideRemoveDir(const Dir: WideString): Boolean;
{TNT-WARN GetCurrentDir}
function WideGetCurrentDir: WideString;
{TNT-WARN SetCurrentDir}
function WideSetCurrentDir(const Dir: WideString): Boolean;


// ........ date/time functions .........

{TNT-WARN TryStrToDateTime}
function TntTryStrToDateTime(Str: WideString; out DateTime: TDateTime): Boolean;
{TNT-WARN TryStrToDate}
function TntTryStrToDate(Str: WideString; out DateTime: TDateTime): Boolean;
{TNT-WARN TryStrToTime}
function TntTryStrToTime(Str: WideString; out DateTime: TDateTime): Boolean;

{ introduced }
function ValidDateTimeStr(Str: WideString): Boolean;
function ValidDateStr(Str: WideString): Boolean;
function ValidTimeStr(Str: WideString): Boolean;

{TNT-WARN StrToDateTime}
function TntStrToDateTime(Str: WideString): TDateTime;
{TNT-WARN StrToDate}
function TntStrToDate(Str: WideString): TDateTime;
{TNT-WARN StrToTime}
function TntStrToTime(Str: WideString): TDateTime;
{TNT-WARN StrToDateTimeDef}
function TntStrToDateTimeDef(Str: WideString; Default: TDateTime): TDateTime;
{TNT-WARN StrToDateDef}
function TntStrToDateDef(Str: WideString; Default: TDateTime): TDateTime;
{TNT-WARN StrToTimeDef}
function TntStrToTimeDef(Str: WideString; Default: TDateTime): TDateTime;

{TNT-WARN CurrToStr}
{TNT-WARN CurrToStrF}
function TntCurrToStr(Value: Currency; lpFormat: PCurrencyFmtW = nil): WideString;
{TNT-WARN StrToCurr}
function TntStrToCurr(const S: WideString): Currency;
{TNT-WARN StrToCurrDef}
function ValidCurrencyStr(const S: WideString): Boolean;
function TntStrToCurrDef(const S: WideString; const Default: Currency): Currency;
function GetDefaultCurrencyFmt: TCurrencyFmtW;

// ........ misc functions .........

{TNT-WARN GetLocaleStr}
function WideGetLocaleStr(LocaleID: LCID; LocaleType: Integer; const Default: WideString): WideString;
{TNT-WARN SysErrorMessage}
function WideSysErrorMessage(ErrorCode: Integer): WideString;

// ......... introduced .........

function WideLibraryErrorMessage(const LibName: WideString; Dll: THandle; ErrorCode: Integer): WideString;

const
  CR = WideChar(#13);
  LF = WideChar(#10);
  CRLF = WideString(#13#10);
  WideLineSeparator = WideChar($2028);

var
  Win32PlatformIsUnicode: Boolean;
  Win32PlatformIsXP: Boolean;
  Win32PlatformIs2003: Boolean;
  Win32PlatformIsVista: Boolean;

{$IFNDEF COMPILER_7_UP}
function CheckWin32Version(AMajor: Integer; AMinor: Integer = 0): Boolean;
{$ENDIF}
function WinCheckH(RetVal: Cardinal): Cardinal;
function WinCheckFileH(RetVal: Cardinal): Cardinal;
function WinCheckP(RetVal: Pointer): Pointer;

function WideGetModuleFileName(Instance: HModule): WideString;
function WideSafeLoadLibrary(const Filename: Widestring;
  ErrorMode: UINT = SEM_NOOPENFILEERRORBOX): HMODULE;
function WideLoadPackage(const Name: Widestring): HMODULE;

function IsWideCharUpper(WC: WideChar): Boolean;
function IsWideCharLower(WC: WideChar): Boolean;
function IsWideCharDigit(WC: WideChar): Boolean;
function IsWideCharSpace(WC: WideChar): Boolean;
function IsWideCharPunct(WC: WideChar): Boolean;
function IsWideCharCntrl(WC: WideChar): Boolean;
function IsWideCharBlank(WC: WideChar): Boolean;
function IsWideCharXDigit(WC: WideChar): Boolean;
function IsWideCharAlpha(WC: WideChar): Boolean;
function IsWideCharAlphaNumeric(WC: WideChar): Boolean;

function WideTextPos(const SubStr, S: WideString): Integer;

function ExtractStringArrayStr(P: PWideChar): WideString;
function ExtractStringFromStringArray(var P: PWideChar; Separator: WideChar = #0): WideString;
function ExtractStringsFromStringArray(P: PWideChar; Separator: WideChar = #0): TWideStringDynArray;

function IsWideCharMappableToAnsi(const WC: WideChar): Boolean;
function IsWideStringMappableToAnsi(const WS: WideString): Boolean;
function IsRTF(const Value: WideString): Boolean;

function ENG_US_FloatToStr(Value: Extended): WideString;
function ENG_US_StrToFloat(const S: WideString): Extended;

//---------------------------------------------------------------------------------------------
//                                 Tnt - Variants
//---------------------------------------------------------------------------------------------

// ........ Variants.pas has WideString versions of these functions .........
{TNT-WARN VarToStr}
{TNT-WARN VarToStrDef}

var
  _SettingChangeTime: Cardinal;

implementation

uses
  ActiveX, ComObj, SysConst,
  {$IFDEF COMPILER_9_UP} WideStrUtils, {$ENDIF} TntWideStrUtils,
  TntSystem, TntWindows, TntFormatStrUtils;

//---------------------------------------------------------------------------------------------
//                                 Tnt - SysUtils
//---------------------------------------------------------------------------------------------

{$IFNDEF COMPILER_9_UP}

  function _Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const
      {$IFDEF COMPILER_7_UP}; const FormatSettings: PFormatSettings {$ENDIF}): Cardinal;
  var
    OldFormat: WideString;
    NewFormat: WideString;
  begin
    SetString(OldFormat, PWideChar(@FormatStr), FmtLen);
    { The reason for this is that WideFormat doesn't correctly format floating point specifiers.
      See QC#4254. }
    NewFormat := ReplaceFloatingArgumentsInFormatString(OldFormat, Args{$IFDEF COMPILER_7_UP}, FormatSettings{$ENDIF});
    {$IFDEF COMPILER_7_UP}
    if FormatSettings <> nil then
      Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
        Length(NewFormat), Args, FormatSettings^)
    else
    {$ENDIF}
      Result := WideFormatBuf(Buffer, BufLen, Pointer(NewFormat)^,
        Length(NewFormat), Args);
  end;

  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const): Cardinal;
  begin
    Result := _Tnt_WideFormatBuf(Buffer, BufLen, FormatStr, FmtLen, Args{$IFDEF COMPILER_7_UP}, nil{$ENDIF});
  end;

  {$IFDEF COMPILER_7_UP}
  function Tnt_WideFormatBuf(var Buffer; BufLen: Cardinal; const FormatStr;
    FmtLen: Cardinal; const Args: array of const; const FormatSettings: TFormatSettings): Cardinal;