tntjvjclutils.pas

TntExUpdate 是 流行的 TntUnicodeControls控件的扩展包.包括很难找到的 TntJVCL 也在里面. TntSysUtils2.pas/TntSysUtilsEx.pa

unit TntJvJCLUtils;

{ 03/22/2006: Add
  SplitCommandLineW, ClearDirW, DeleteDirW, AddSlashW, AddSlash2W
  20/08/2006: Add
  ShortToLongFileNameW, LongToShortFileNameW, ShortToLongPathW, LongToShortPathW
}

interface

{$I TntCompilers.inc}

uses
  TntSysUtils, Graphics,
  JvConsts;

function CountOfCharW (const Ch: WideChar; const S: WideString): Integer;

{ ClearDir clears folder Dir }
function ClearDirW (const Dir: WideString): Boolean;
{ DeleteDir clears and than delete folder Dir }
function DeleteDirW (const Dir: WideString): Boolean;

{ AddSlash add slash Char to Dir parameter, if needed }
procedure AddSlashW (var Dir: TWideFileName);
{ AddSlash returns string with added slash Char to Dir parameter, if needed }
function AddSlash2W (const Dir: TWideFileName): TWideFileName;
{ AddPath returns FileName with Path, if FileName not contain any path }

function WideDelSpace (const S: WideString): WideString;
{ WideDelSpace return a string with all white spaces removed. }
function WideDelChars (const S: WideString;  Chr: WideChar): WideString;
{ WideDelChars return a string with all Chr characters removed. }
function WideDelBSpace (const S: WideString): WideString;
{ WideDelBSpace trims leading spaces from the given string. }
function WideDelESpace (const S: WideString): WideString;
{ WideDelESpace trims trailing spaces from the given string. }
function WideDelRSpace (const S: WideString): WideString;
{ WideDelRSpace trims leading and trailing spaces from the given string. }

function ShortToLongFileNameW (const ShortName: WideString): WideString;
function LongToShortFileNameW (const LongName: WideString): WideString;
function ShortToLongPathW (const ShortName: WideString): WideString;
function LongToShortPathW (const LongName: WideString): WideString;

// execute a program without waiting
procedure ExecW (const FileName, Parameters, Directory: WideString);

function MinimizeTextW(const Text: WideString; Canvas: TCanvas;
  MaxWidth: Integer): WideString;

{ String routines }
procedure SplitCommandLineW(const CmdLine: WideString; var ExeName,
  Params: WideString);

implementation

uses
  Math, Windows, TntWindows, ShellAPI, SysUtils,
  TntGraphics, TntWideStrUtils;

function CountOfCharW (const Ch: WideChar; const S: WideString): Integer;
var
  I: Integer;
begin
  Result := 0;
  for I := 1 to Length(S) do
    if S[I] = Ch then
      Inc(Result);
end {CountOfCharW};


function ClearDirW (const Dir: WideString): Boolean;
var
  SearchRec: TSearchRecW;
  DosError: Integer;
  Path: TWideFileName;
begin
  Result := True;
  Path := Dir;
  AddSlashW(Path);
  DosError := WideFindFirst(Path + AllFilePattern, faAnyFile, SearchRec);
  while DosError = 0 do
  begin
    if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
    begin
      if (SearchRec.Attr and faDirectory) = faDirectory then
        Result := Result and DeleteDirW (Path + SearchRec.Name)
      else
        Result := Result and WideDeleteFile (Path + SearchRec.Name);
      // if not Result then Exit;
    end;
    DosError := WideFindNext(SearchRec);
  end;
  WideFindClose(SearchRec);
end;

function DeleteDirW (const Dir: WideString): Boolean;
begin
  ClearDirW (Dir);
  Result := WideRemoveDir (Dir);
end;


procedure AddSlashW (var Dir: TWideFileName);
begin
  if (Length(Dir) > 0) and (Dir[Length(Dir)] <> PathDelim) then
    Dir := Dir + PathDelim;
end;

function AddSlash2W (const Dir: TWideFileName): TWideFileName;
begin
  Result := Dir;
  if (Length(Dir) > 0) and (Dir[Length(Dir)] <> PathDelim) then
    Result := Dir + PathDelim;
end;


function WideDelChars (const S: WideString;  Chr: WideChar): WideString;
var
  I: Integer;
begin
  Result := S;
  for  I := Length (Result)  downto 1 do begin
    if  Result[I] = Chr
    then  Delete(Result, I, 1);
  end;
end {WideDelChars};


function WideDelSpace (const S: WideString): WideString;
begin
  Result := WideDelChars(S, ' ');
end;

function WideDelBSpace (const S: WideString): WideString;
var
  I, L: Integer;
begin
  L := Length(S);
  I := 1;
  while (I <= L) and (S[I] = ' ') do Inc(I);
  Result := Copy(S, I, MaxInt);
end {WideDelBSpace};

function WideDelESpace (const S: WideString): WideString;
var
  I: Integer;
begin
  I := Length(S);
  while (I > 0) and (S[I] = ' ') do Dec(I);
  Result := Copy(S, 1, I);
end {WideDelESpace};

function WideDelRSpace (const S: WideString): WideString;
begin
  Result := WideDelBSpace(WideDelESpace(S));
end {WideDelRSpace};

procedure ExecW(const FileName, Parameters, Directory: WideString);
begin
  {$IFDEF MSWINDOWS}
  ShellExecuteW(Windows.GetForegroundWindow, 'open', PWideChar(FileName), PWideChar(Parameters), PWideChar(Directory),
    SW_SHOWNORMAL);
  {$ENDIF MSWINDOWS}
  {$IFDEF UNIX}  //?????????????
  ShellExecute(GetForegroundWindow, 'open', PWideChar(FileName), PWideChar(Parameters), PWideChar(Directory),
    SW_SHOWNORMAL);
  {$ENDIF UNIX}
end {ExecW};
{$IFDEF UNIX}
// begin
//  if Directory = '' then Directory := GetCurrentDir;
//  Libc.system(PChar(Format('cd "%s" ; "%s" %s &', [Directory, FileName, Parameters])));
// end;
{$ENDIF UNIX}


function ShortToLongFileNameW(const ShortName: WideString): WideString;
{$IFDEF MSWINDOWS}
var
  Temp: TWin32FindDataW;
  SearchHandle: THandle;
begin
  {$IFDEF CLR}
  SearchHandle := FindFirstFile(ShortName, Temp);
  {$ELSE}
  SearchHandle := Tnt_FindFirstFileW(PWideChar(ShortName), Temp);
  {$ENDIF CLR}
  if SearchHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := Temp.cFileName;
    if Result = '' then
      Result := Temp.cAlternateFileName;
  end
  else
    Result := '';
  Windows.FindClose(SearchHandle);
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
begin
  if WideFileExists(ShortName) then
    Result := ShortName
  else
    Result := '';
end;
{$ENDIF UNIX}

function LongToShortFileNameW(const LongName: WideString): WideString;
{$IFDEF MSWINDOWS}
var
  Temp: TWin32FindDataW;
  SearchHandle: THandle;
begin
  {$IFDEF CLR}
  SearchHandle := FindFirstFile(LongName, Temp);
  {$ELSE}
  SearchHandle := Tnt_FindFirstFileW(PWideChar(LongName), Temp);
  {$ENDIF CLR}
  if SearchHandle <> INVALID_HANDLE_VALUE then
  begin
    Result := Temp.cAlternateFileName;
    if Result = '' then
      Result := Temp.cFileName;
  end
  else
    Result := '';
  Windows.FindClose(SearchHandle);
end;
{$ENDIF MSWINDOWS}
{$IFDEF UNIX}
begin
  if WideFileExists(LongName) then
    Result := LongName
  else
    Result := '';
end;
{$ENDIF UNIX}

function ShortToLongPathW(const ShortName: WideString): WideString;
{$IFDEF CLR}
var
  LastSlash: Integer;
  TempPath: WideString;
begin
  Result := '';
  TempPath := ShortName;
  LastSlash := PosLastCharIdx(PathDelim, ShortName);
  while LastSlash > 0 do
  begin
    Result := PathDelim + ShortToLongFileNameW(TempPath) + Result;
    LastSlash := PosLastCharIdx(PathDelim, ShortName, LastSlash - 1);
    TempPath := Copy(TempPath, 1, LastSlash);
  end;
end;
{$ELSE}
var
  LastSlash: PWideChar;
  TempPathPtr: PWideChar;
begin
  Result := '';
  TempPathPtr := PWideChar(ShortName);
  LastSlash := WStrRScan(TempPathPtr, PathDelim);
  while LastSlash <> nil do
  begin
    Result := PathDelim + ShortToLongFileNameW(TempPathPtr) + Result;
    if LastSlash <> nil then
    begin
      LastSlash^ := #0;
      LastSlash := WStrRScan(TempPathPtr, PathDelim);
    end;
  end;
  Result := TempPathPtr + Result;
end;
{$ENDIF CLR}

function LongToShortPathW(const LongName: WideString): WideString;
{$IFDEF CLR}
begin
  Result := ExtractShortPathName(LongName);
end;
{$ELSE}
var
  LastSlash: PWideChar;
  TempPathPtr: PWideChar;
begin
  Result := '';
  TempPathPtr := PWideChar(LongName);
  LastSlash := WStrRScan(TempPathPtr, PathDelim);
  while LastSlash <> nil do
  begin
    Result := PathDelim + LongToShortFileNameW(TempPathPtr) + Result;
    if LastSlash <> nil then
    begin
      LastSlash^ := #0;
      LastSlash := WStrRScan(TempPathPtr, PathDelim);
    end;
  end;
  Result := TempPathPtr + Result;
end;
{$ENDIF CLR}


function MinimizeTextW (const Text: WideString; Canvas: TCanvas;
  MaxWidth: Integer): WideString;
var
  I: Integer;
begin
  Result := Text;
  I := 1;
  while (I <= Length(Text)) and (WideCanvasTextWidth(Canvas, Result) > MaxWidth) do
  begin
    Inc(I);
    Result := Copy(Text, 1, Max(0, Length(Text) - I)) + '...';
  end;
end {MinimizeTextW};

{ function GetParamStr copied from SYSTEM.PAS unit of Delphi 2.0 }

function GetParamStrW(P: PWideChar; var Param: WideString): PWideChar;
var
  Len: Integer;
  Buffer: array [Byte] of WideChar;
begin
  while True do
  begin
    while (P[0] <> #0) and (P[0] <= ' ') do
      Inc(P);
    if (P[0] = '"') and (P[1] = '"') then
      Inc(P, 2)
    else
      Break;
  end;
  Len := 0;
  while P[0] > ' ' do
    if P[0] = '"' then
    begin
      Inc(P);
      while (P[0] <> #0) and (P[0] <> '"') do
      begin
        Buffer[Len] := P[0];
        Inc(Len);
        Inc(P);
      end;
      if P[0] <> #0 then
        Inc(P);
    end
    else
    begin
      Buffer[Len] := P[0];
      Inc(Len);
      Inc(P);
    end;
  SetString(Param, Buffer, Len);
  Result := P;
end {GetParamStrW};

function ParamCountFromCommandLineW(CmdLine: PWideChar): Integer;
var
  S: WideString;
  P: PWideChar;
begin
  P := CmdLine;
  Result := 0;
  while True do
  begin
    P := GetParamStrW(P, S);
    if S = '' then
      Break;
    Inc(Result);
  end;
end {ParamCountFromCommandLineW};

function ParamStrFromCommandLineW(CmdLine: PWideChar; Index: Integer): WideString;
var
  P: PWideChar;
begin
  P := CmdLine;
  while True do
  begin
    P := GetParamStrW(P, Result);
    if (Index = 0) or (Result = '') then
      Break;
    Dec(Index);
  end;
end {ParamStrFromCommandLineW};

procedure SplitCommandLineW(const CmdLine: WideString; var ExeName,
  Params: WideString);
var
  Buffer: PWideChar;
  Cnt, I: Integer;
  S: WideString;
begin
  ExeName := '';
  Params := '';
 {$IFDEF COMPILER_9_UP}
  Buffer := StrNewW(PWideChar(CmdLine));
 {$ELSE}
  Buffer := WStrNew(PWideChar(CmdLine));
 {$ENDIF}
  try
    Cnt := ParamCountFromCommandLineW(Buffer);
    if Cnt > 0 then
    begin
      ExeName := ParamStrFromCommandLineW(Buffer, 0);
      for I := 1 to Cnt - 1 do
      begin
        S := ParamStrFromCommandLineW(Buffer, I);
        if Pos(' ', S) > 0 then
          S := '"' + S + '"';
        Params := Params + S;
        if I < Cnt - 1 then
          Params := Params + ' ';
      end;
    end;
  finally
   {$IFDEF COMPILER_9_UP}
    StrDisposeW(Buffer);
   {$ELSE}
    WStrDispose(Buffer);
   {$ENDIF}
  end;
end {SplitCommandLineW};

end.