{*******************************************************} { } { Methods of Sting } { } { CopyRight (C) 2018-2020 KngStr } { } { Some Code from } { QDAC of swish, Inno } { Thanks } { } {*******************************************************} unit ksString; interface /// /// 创建空白文件 /// function CreateBlankFile(S: string): Boolean; /// /// 自动为已存在文件名加数字 /// function AutoChangeFileName(AFile: string): string; /// /// 自动替换文件名中的非法字符为 /// procedure ChangeInvalidFileNameChars(var FileName: string; AChar: Char = '_'); /// /// 格式化秒为时间,冒号分割 /// function FormatSeconds(const AValue: Int64): string; overload; /// /// 格式化秒为时间,冒号分割 /// function FormatSeconds(const AValue: Integer): string; overload; /// /// 格式化秒为时间,冒号分割 /// function FormatSeconds(const AValue: Double): string; overload; /// /// 格式化文件大小,拷贝自qdac,增加更多单位 /// function FormatSize(ASize: Int64): string; /// /// 文件大小字符串转数字 /// 1[b] "1 k[b]" " 1 m[b] " 1g[b] 1t[b] /// function SizeStrToInt(ASize: string; ADefault: Int64 = 0): Int64; /// /// 文件大小单位转数字 /// function SizeUnitToInt(AUnit: string): Int64; overload; /// /// 文件大小单位转数字 /// function SizeUnitToInt(AUnit: Char): Int64; overload; /// /// 是否中国手机号 /// 13900000000 /// +8613900000000 /// +86 139 0000 0000 /// +86-139-0000-0000 /// /// 仅允许数字和开头的+ 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" } /// /// 获取指定参数, one-base /// /// /// 按命令行拆分方式 /// function StrParamStr(Command: string; Index: Integer): string; overload; function StrParamStr(Command: PChar; Index: Integer): string; overload; /// /// 获取参数个数 /// /// /// 按命令行拆分方式 /// function StrParamCount(Command: string): Integer; overload; function StrParamCount(Command: PChar): Integer; overload; /// /// 获取指定命令行参数的值,/x=xxx 和 -x=xxx /// /// /// 按命令行拆分方式 /// function GetStrParamVal(Command: string; const Param, Default: String): String; overload; function GetStrParamVal(Command: PChar; const Param, Default: String): String; overload; /// /// 获取下一个参数,并返回剩余内容 /// /// /// 按命令行拆分方式 /// 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): string; var I: Integer; sPath, sExt: string; begin Result := AFile; I := 0; sPath := ChangeFileExt(Result, ''); sExt := ExtractFileExt(Result); while FileExists(Result) or DirectoryExists(Result) do begin Inc(I); Result := Format('%s(%d)%s', [sPath, 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 else Inc(I); end; 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 := 1 to PCount 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 P := GetStrParamStr(Command, S); Result := 0; while P^ <> #0 do begin Inc(Result); P := GetStrParamStr(P, S); 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.