KsLibs/Source/ksString.pas

{*******************************************************}
{                                                       }
{       Methods of Sting                                }
{                                                       }
{       CopyRight (C) 2018-2023 KngStr                  }
{                                                       }
{   Some Code from                                      }
{     QDAC of swish, Inno                               }
{   Thanks                                              }
{                                                       }
{*******************************************************}

unit ksString;

interface

/// <summary>
/// 创建空白文件
/// </summary>
function CreateBlankFile(S: string): Boolean;
/// <summary>
/// 自动为已存在文件名加数字
/// </summary>
function AutoChangeFileName(AFile: string; AHaveExt: Boolean = True; AFormat: string = '(%d)'): string;
/// <summary>
/// 自动替换文件名中的非法字符为
/// </summary>
procedure ChangeInvalidFileNameChars(var FileName: string; AChar: Char = '_');
/// <summary>
/// 清理文件名中的 (1) [1]
/// (1)系统命名，[1]浏览器下载命名，甚至[1] (2)
/// </summary>
function CleanFileName(const Filename: string): string;

/// <summary>
/// 格式化秒为时间，冒号分割
/// </summary>
function FormatSeconds(const AValue: Int64): string; overload;
/// <summary>
/// 格式化秒为时间，冒号分割
/// </summary>
function FormatSeconds(const AValue: Integer): string; overload;
/// <summary>
/// 格式化秒为时间，冒号分割
/// </summary>
function FormatSeconds(const AValue: Double): string; overload;

/// <summary>
/// 格式化文件大小，拷贝自qdac，增加更多单位
/// </summary>
function FormatSize(ASize: Int64): string;

/// <summary>
/// 文件大小字符串转数字
/// 1[b] "1 k[b]" " 1 m[b] " 1g[b] 1t[b]
/// </summary>
function SizeStrToInt(ASize: string; ADefault: Int64 = 0): Int64;

/// <summary>
/// 文件大小单位转数字
/// </summary>
function SizeUnitToInt(AUnit: string): Int64; overload;
/// <summary>
/// 文件大小单位转数字
/// </summary>
function SizeUnitToInt(AUnit: Char): Int64; overload;

/// <summary>
/// 是否中国手机号
///  13900000000
///  +8613900000000
///  +86 139 0000 0000
///  +86-139-0000-0000
/// </summary>
/// <param name="AOnlyNum">仅允许数字和开头的+</param>
function IsChineseMobileNumber(S: string; AOnlyNum: Boolean = False): Boolean;

{
  文本参数解析，来自Inno
  Differences from Delphi's ParamStr:
  - No limits on parameter length
  - Doesn't ignore empty parameters ("")
  - Handles the empty argv[0] case like MSVC: if GetCommandLine() returns
    " a b" then NewParamStr(1) should return "a", not "b"
}

/// <summary>
/// 获取指定参数, 0-base
/// </summary>
/// <remarks>
/// 按命令行拆分方式
/// </remarks>
function StrParamStr(Command: string; Index: Integer): string; overload;
function StrParamStr(Command: PChar; Index: Integer): string; overload;
/// <summary>
/// 获取参数个数, 包含第一个参数
/// </summary>
/// <remarks>
/// 按命令行拆分方式
/// </remarks>
function StrParamCount(Command: string): Integer; overload;
function StrParamCount(Command: PChar): Integer; overload;
/// <summary>
/// 获取指定命令行参数的值，/x=xxx 和 -x=xxx
/// </summary>
/// <remarks>
/// 按命令行拆分方式
/// </remarks>
function GetStrParamVal(Command: string; const Param, Default: String): String; overload;
function GetStrParamVal(Command: PChar; const Param, Default: String): String; overload;
/// <summary>
/// 获取下一个参数，并返回剩余内容
/// </summary>
/// <remarks>
/// 按命令行拆分方式
/// </remarks>
function GetStrParamStr(P: PChar; var Param: string): PChar;

implementation

uses
  {$IFDEF MSWINDOWS}Windows,{$ENDIF}
  Classes, SysUtils, IOUtils;

function CreateBlankFile(S: string): Boolean;
var
  FStrm: TFileStream;
begin
  Result := False;
  try
    FStrm := TFileStream.Create(S, fmCreate);
    if FStrm = nil then
      Exit;
    Result := True;
    FreeAndNil(FStrm);
  except
    FStrm := nil;
  end;
end;

function AutoChangeFileName(AFile: string; AHaveExt: Boolean; AFormat: string): string;
var
  I: Integer;
  sPath, sExt: string;
begin
  Result := AFile;

  if AHaveExt then begin
    sPath := ChangeFileExt(Result, '');
    sExt := ExtractFileExt(Result);
  end
  else begin
    sPath := Result;
    sExt := '';
  end;

  // 注意：目录名不能写死到format里
  // 因为什么文件名都有，避免引起格式化错误
  I := 0;
  while FileExists(Result) or DirectoryExists(Result) do begin
    Inc(I);
    Result := Format('%s%s%s', [sPath, Format(AFormat, [I]), sExt]);
  end;
end;

procedure ChangeInvalidFileNameChars(var FileName: string; AChar: Char);
var
  PFileName: PChar;
  FileNameLen: Integer;
  Ch: Char;
  I: Integer;
begin
  I := 0;
  PFileName := PChar(FileName);
  FileNameLen := Length(FileName);
  while I < FileNameLen do begin
    Ch := PFileName[I];

    if not TPath.IsValidFileNameChar(Ch) then
      PFileName[I] := AChar;
    Inc(I);
  end;
end;

function CleanFileName(const Filename: string): string;
var
  s: string;
  i: integer;
begin
  Result := ExtractFileName(Filename);
  Result := ChangeFileExt(Result, '');

  // 处理 () 情况
  s := Copy(Result, Length(Result) - 2, 3);
  if (Copy(s, 1, 1) = '(') and (Copy(s, Length(s), 1) = ')') then begin
    i := StrToIntDef(Copy(s, 2, 1), 0);
    if (10 > i) and (i > 0) then
      Result := Copy(Result, 1, Length(Result) - 3);
  end;

  // 处理 [] 情况
  s := Copy(Result, Length(Result) - 2, 3);
  if (Copy(s, 1, 1) = '[') and (Copy(s, Length(s), 1) = ']') then begin
    i := StrToIntDef(Copy(s, 2, 1), 0);
    if (10 > i) and (i > 0) then
      Result := Copy(Result, 1, Length(Result) - 3);
  end;

  Result := Trim(Result);
end;

function FormatSeconds(const AValue: Double): string; overload;
var
  h, m, s, ms: Integer;
begin
  ms := Trunc(Frac(AValue) * 1000);
  s := Trunc(AValue);
  m := s div 60;
  h := m div 60;
  if h > 0 then
    Result := Format('%.2d:%.2d:%.2d.%.3d', [h, m mod 60, s mod 60, ms])
  else
    Result := Format('%.2d:%.2d.%.3d', [m, s mod 60, ms]);
end;

function FormatSeconds(const AValue: Int64): string;
var
  h, m, s: Integer;
begin
  s := AValue;
  m := s div 60;
  h := m div 60;
  if h > 0 then
    Result := Format('%.2d:%.2d:%.2d', [h, m mod 60, s mod 60])
  else
    Result := Format('%.2d:%.2d', [m, s mod 60]);
end;

function FormatSeconds(const AValue: Integer): string; overload;
begin
  FormatSeconds(Int64(AValue));
end;

function FormatSize(ASize: Int64): string;
var
  AIdx, R1, s1: Int64;
  AIsNeg: Boolean;
const
  Units: array [0 .. 6] of string = ('EB', 'PB', 'TB', 'GB', 'MB', 'KB', 'B');
begin
  AIsNeg := (ASize < 0);
  AIdx := 6;
  R1 := 0;
  if AIsNeg then
    ASize := -ASize;
  Result := '';
  while (AIdx >= 0) do
  begin
    s1 := ASize mod 1024;
    ASize := ASize shr 10;
    if (ASize = 0) or (AIdx = 0) then
    begin
      R1 := R1 * 100 div 1024;
      if R1 > 0 then
      begin
        if R1 >= 10 then
          Result := IntToStr(s1) + '.' + IntToStr(R1) + Units[AIdx]
        else
          Result := IntToStr(s1) + '.' + '0' + IntToStr(R1) + Units[AIdx];
      end
      else
        Result := IntToStr(s1) + Units[AIdx];
      Break;
    end;
    R1 := s1;
    Dec(AIdx);
  end;
  if AIsNeg then
    Result := '-' + Result;
end;

function IsChineseMobileNumber(S: string; AOnlyNum: Boolean): boolean;
var
  p: PChar;
  i: Integer;
begin
  Result := False;

  // 最短肯定是11位
  if (Length(S) < 11) then
    Exit;

  i := 0;
  p := PChar(S);
  while p^ <> #0 do begin
    if p^ = '+' then begin
      if i > 0 then // +号必须在第一位
        Exit;
      if (p[1] = '8') and (p[2] = '6') then // +86，而且是连续的
        Inc(p, 3)
      else
        Exit;
    end
    else if ((p^ >= '0') and (p^ <= '9')) then begin
      if (i = 0) and (p^ <> '1') then // 中国手机号都是1开头
        Exit;
      Inc(p);
      Inc(i);
    end
    else if (not AOnlyNum) and ((p^ = '-') or (p^ = ' ')) then
      Inc(p)
    else
      Exit;
  end;
  Result := i = 11; //中国手机号 11位
end;

function SizeUnitToInt(AUnit: Char): Int64;
const
  Units: array [0 .. 6] of Char = ('b', 'k', 'm', 'g', 't', 'p', 'e');
var
  I: Integer;
  LUnit: Char;
begin
  Result := 1;
  case AUnit of
    'A'..'Z':
      LUnit := Char(Word(AUnit) or $0020);
  else
    LUnit := AUnit;
  end;
  for I := Low(Units) to High(Units) do begin
    if (I > 0) then
      Result := Result * 1024;
    if LUnit = Units[I] then
      Exit;
  end;

  Result := 1;
end;

function SizeUnitToInt(AUnit: string): Int64;
var
  LSize: string;
begin
  Result := 1;

  LSize := Trim(AUnit);
  case Length(LSize) of
    1,2: Result := SizeUnitToInt(PChar(AUnit)^);
  end;
end;

function SizeStrToInt(ASize: string; ADefault: Int64): Int64;
var
  p: PChar;
  c: Char;
  s: string;
begin
  Result := ADefault;

  if Length(ASize) = 0 then
    Exit;

  s := '';
  c := #0;
  p := PChar(ASize);
  while p^ <> #0 do
    case p^ of
      'b', 'k', 'm', 'g', 't', 'p', 'e',
      'B', 'K', 'M', 'G', 'T', 'P', 'E':
        begin
          if s = '' then
            Exit;
          if c <> #0 then
            Exit;
          c := p^;
          Inc(p);
          if (p^ = 'b') or (p^ = 'B') then
            Inc(p);
        end;
      '0' .. '9':
        begin
          if c <> #0 then
            Exit;
          s := s + p^;
          Inc(p);
        end;
      ',':
        begin
          if c <> #0 then
            Exit;
          Inc(p);
        end;
      ' ':
        Inc(p);
    else
      Exit;
    end;

  if s <> '' then
    Result := StrToInt64Def(s, Result) * SizeUnitToInt(c);
end;

function GetStrParamStr(P: PChar; var Param: String): PChar;

  function Extract(P: PChar; const Buffer: PChar; var Len: Integer): PChar;
  var
    InQuote: Boolean;
  begin
    Len := 0;
    InQuote := False;
    while (P^ <> #0) and ((P^ > ' ') or InQuote) do begin
      if P^ = '"' then
        InQuote := not InQuote
      else begin
        if Assigned(Buffer) then
          Buffer[Len] := P^;
        Inc(Len);
      end;
      Inc(P);
    end;
    Result := P;
  end;

var
  Len: Integer;
  Buffer: String;
begin
  Extract(P, nil, Len);
  SetString(Buffer, nil, Len);
  Result := Extract(P, @Buffer[1], Len);
  Param := Buffer;
  while (Result^ <> #0) and (Result^ <= ' ') do
    Inc(Result);
end;

function GetStrParamVal(Command: PChar; const Param, Default: String): String;
var
  I, PCount: Integer;
  Z: String;
begin
  PCount := StrParamCount(Command);
  for I := 0 to PCount - 1 do
  begin
    Z := StrParamStr(Command, I);
    if (StrLIComp(PChar(Z), PChar('/' + Param + '='), Length(Param) + 2) = 0)
      or (StrLIComp(PChar(Z), PChar('-' + Param + '='), Length(Param) + 2) = 0) then
    begin
      Delete(Z, 1, Length(Param) + 2);
      Result := Z;
      Exit;
    end;
  end;

  Result := Default;
end;

function GetStrParamVal(Command: string; const Param, Default: String): String;
begin
  Result := GetStrParamVal(PChar(Command), Param, Default);
end;

function StrParamCount(Command: PChar): Integer;
var
  P: PChar;
  S: String;
begin
  Result := 0;
  P := Command;
  while (P^ <> #0) and (P^ <= ' ') do
    Inc(P);
  while P^ <> #0 do begin
    P := GetStrParamStr(P, S);
    Inc(Result);
  end;
end;

function StrParamCount(Command: string): Integer;
begin
  Result := StrParamCount(PChar(Command));
end;

function StrParamStr(Command: PChar; Index: Integer): string;
{ Returns the Indexth command line parameter, or an empty string if Index is
  out of range.
  Differences from Delphi's ParamStr:
  - No limits on parameter length
  - Doesn't ignore empty parameters ("")
  - Handles the empty argv[0] case like MSVC: if GetCommandLine() returns
    " a b" then NewParamStr(1) should return "a", not "b" }
var
  Buffer: array[0..MAX_PATH-1] of Char;
  S: String;
  P: PChar;
begin
  if Index <= 0 then begin
    Result := '';
  end
  else begin
    P := Command;
    while True do begin
      if P^ = #0 then begin
        S := '';
        Break;
      end;
      P := GetStrParamStr(P, S);
      if Index = 0 then Break;
      Dec(Index);
    end;
    Result := S;
  end;
end;

function StrParamStr(Command: string; Index: Integer): string;
begin
  Result := StrParamStr(PChar(Command), Index);
end;

end.