⭐ 欢迎来到虫虫下载站! | 📦 资源下载 📁 资源专辑 ℹ️ 关于我们
⭐ 虫虫下载站

📄 hutil32.pas

📁 飞尔传奇世界的引擎代码可直接编译M2Engine 请使用Delphi编译
💻 PAS
📖 第 1 页 / 共 4 页
字号:
    Dest := '';
  end;
end;
function IntToStr2(N: Integer): string;
begin
  if N < 10 then Result := '0' + IntToStr(N)
  else Result := IntToStr(N);
end;

function IntToStrFill(num, Len: Integer; Fill: Char): string;
var
  I: Integer;
  Str: string;
begin
  Result := '';
  Str := IntToStr(num);
  for I := 1 to Len - Length(Str) do
    Result := Result + Fill;
  Result := Result + Str;
end;

function IsInB(Src: string; Pos: Integer; targ: string): Boolean;
var
  tLen, I: Integer;
begin
  Result := False;
  tLen := Length(targ);
  if Length(Src) < Pos + tLen then Exit;
  for I := 0 to tLen - 1 do
    if UpCase(Src[Pos + I]) <> UpCase(targ[I + 1]) then Exit;

  Result := True;
end;

function IsInRect(x, y: Integer; Rect: TRect): Boolean;
begin
  if (x >= Rect.Left) and (x <= Rect.Right) and (y >= Rect.Top) and (y <= Rect.Bottom) then
    Result := True else
    Result := False;
end;

function IsStringNumber(Str: string): Boolean;
var I: Integer;
begin
  Result := True;
  for I := 1 to Length(Str) do
    if (Byte(Str[I]) < Byte('0')) or (Byte(Str[I]) > Byte('9')) then begin
      Result := False;
      Break;
    end;
end;

{function IsVarNumber (str: string): boolean;
var i: integer;
begin
   Result := FALSE;
   if length(str) <= 3 then begin
     if (UpCase(str[1]) = 'P') or (UpCase(str[1]) = 'G') or (UpCase(str[1]) = 'M') or (UpCase(str[1]) = 'I') or (UpCase(str[1]) = 'D') or (UpCase(str[1]) = 'N') or (UpCase(str[1]) = 'A') then begin
       if (length(str) = 3) and IsStringNumber(str[2]) and IsStringNumber(str[3]) then Result := TRUE
       else if (length(str) = 2) and IsStringNumber(str[2]) then Result := TRUE;
     end;
   end;
end; }
function IsVarNumber(Str: string): Boolean;
begin
  Result := (CompareLStr(Str, 'HUMAN', Length('HUMAN'))) or (CompareLStr(Str, 'GUILD', Length('GUILD'))) or (CompareLStr(Str, 'GLOBAL', Length('GLOBAL')));
end;

{Return : remain string}

function ArrestString(Source, SearchAfter, ArrestBefore: string;
  const DropTags: array of string; var RsltStr: string): string;
const
  BUF_SIZE = $7FFF;
var
  buf: array[0..BUF_SIZE] of Char;
  BufCount, SrcCount, srclen, {AfterLen, BeforeLen,} DropCount, I: Integer;
  ArrestNow: Boolean;
begin
  try
    //EnterCriticalSection (CSUtilLock);
    RsltStr := ''; {result string}
    srclen := Length(Source);

    if srclen > BUF_SIZE then begin
      Result := '';
      Exit;
    end;

    BufCount := 0;
    SrcCount := 1;
    ArrestNow := False;
    DropCount := SizeOf(DropTags) div SizeOf(string);

    if (SearchAfter = '') then ArrestNow := True;

    //GetMem (Buf, BUF_SIZE);

    while True do begin
      if SrcCount > srclen then Break;

      if not ArrestNow then begin
        if IsInB(Source, SrcCount, SearchAfter) then ArrestNow := True;
      end else begin
        buf[BufCount] := Source[SrcCount];
        if IsInB(Source, SrcCount, ArrestBefore) or (BufCount >= BUF_SIZE - 2) then begin
          BufCount := BufCount - Length(ArrestBefore);
          buf[BufCount + 1] := #0;
          RsltStr := string(buf);
          BufCount := 0;
          Break;
        end;

        for I := 0 to DropCount - 1 do begin
          if IsInB(Source, SrcCount, DropTags[I]) then begin
            BufCount := BufCount - Length(DropTags[I]);
            Break;
          end;
        end;

        Inc(BufCount);
      end;
      Inc(SrcCount);
    end;

    if (ArrestNow) and (BufCount <> 0) then begin
      buf[BufCount] := #0;
      RsltStr := string(buf);
    end;

    Result := Copy(Source, SrcCount + 1, srclen - SrcCount); {result is remain string}
  finally
    //LeaveCriticalSection (CSUtilLock);
  end;
end;


function ArrestStringEx(Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
var
  BufCount, SrcCount, srclen: Integer;
  GoodData, fin: Boolean;
  I, N: Integer;
begin
  ArrestStr := ''; {result string}
  if Source = '' then begin
    Result := '';
    Exit;
  end;

  try
    srclen := Length(Source);
    GoodData := False;
    if srclen >= 2 then
      if Source[1] = SearchAfter then begin
        Source := Copy(Source, 2, srclen - 1);
        srclen := Length(Source);
        GoodData := True;
      end else begin
        N := Pos(SearchAfter, Source);
        if N > 0 then begin
          Source := Copy(Source, N + 1, srclen - (N));
          srclen := Length(Source);
          GoodData := True;
        end;
      end;
    fin := False;
    if GoodData then begin
      N := Pos(ArrestBefore, Source);
      if N > 0 then begin
        ArrestStr := Copy(Source, 1, N - 1);
        Result := Copy(Source, N + 1, srclen - N);
      end else begin
        Result := SearchAfter + Source;
      end;
    end else begin
      for I := 1 to srclen do begin
        if Source[I] = SearchAfter then begin
          Result := Copy(Source, I, srclen - I + 1);
          Break;
        end;
      end;
    end;
  except
    ArrestStr := '';
    Result := '';
  end;
end;

function SkipStr(Src: string; const Skips: array of Char): string;
var
  I, Len, C: Integer;
  NowSkip: Boolean;
begin
  Len := Length(Src);
  //   Count := sizeof(Skips) div sizeof (Char);

  for I := 1 to Len do begin
    NowSkip := False;
    for C := Low(Skips) to High(Skips) do
      if Src[I] = Skips[C] then begin
        NowSkip := True;
        Break;
      end;
    if not NowSkip then Break;
  end;

  Result := Copy(Src, I, Len - I + 1);

end;


function GetStrToCoords(Str: string): TRect;
var
  temp: string;
begin

  Str := GetValidStr3(Str, temp, [',', ' ']); Result.Left := Str_ToInt(temp, 0);
  Str := GetValidStr3(Str, temp, [',', ' ']); Result.Top := Str_ToInt(temp, 0);
  Str := GetValidStr3(Str, temp, [',', ' ']); Result.Right := Str_ToInt(temp, 0);
  GetValidStr3(Str, temp, [',', ' ']); Result.Bottom := Str_ToInt(temp, 0);

end;

function CombineDirFile(SrcDir, TargName: string): string;
begin
  if (SrcDir = '') or (TargName = '') then begin
    Result := SrcDir + TargName;
    Exit;
  end;
  if SrcDir[Length(SrcDir)] = '\' then
    Result := SrcDir + TargName
  else Result := SrcDir + '\' + TargName;
end;

function CompareLStr(Src, targ: string; compn: Integer): Boolean;
var
  I: Integer;
begin
  Result := False;
  if compn <= 0 then Exit;
  if Length(Src) < compn then Exit;
  if Length(targ) < compn then Exit;
  Result := True;
  for I := 1 to compn do
    if UpCase(Src[I]) <> UpCase(targ[I]) then begin
      Result := False;
      Break;
    end;
end;

function CompareBuffer(p1, p2: PByte; Len: Integer): Boolean;
var
  I: Integer;
begin
  Result := True;
  for I := 0 to Len - 1 do
    if PByte(Integer(p1) + I)^ <> PByte(Integer(p2) + I)^ then begin
      Result := False;
      Break;
    end;
end;

function CompareBackLStr(Src, targ: string; compn: Integer): Boolean;
var
  I, slen, tLen: Integer;
begin
  Result := False;
  if compn <= 0 then Exit;
  if Length(Src) < compn then Exit;
  if Length(targ) < compn then Exit;
  slen := Length(Src);
  tLen := Length(targ);
  Result := True;
  for I := 0 to compn - 1 do
    if UpCase(Src[slen - I]) <> UpCase(targ[tLen - I]) then begin
      Result := False;
      Break;
    end;
end;


function IsEnglish(Ch: Char): Boolean;
begin
  Result := False;
  if ((Ch >= 'A') and (Ch <= 'Z')) or ((Ch >= 'a') and (Ch <= 'z')) then
    Result := True;
end;

function IsEngNumeric(Ch: Char): Boolean;
begin
  Result := False;
  if IsEnglish(Ch) or ((Ch >= '0') and (Ch <= '9')) then
    Result := True;
end;

function IsFloatNumeric(Str: string): Boolean;
begin
  if Trim(Str) = '' then begin
    Result := False;
    Exit;
  end;
  try
    StrToFloat(Str);
    Result := True;
  except
    Result := False;
  end;
end;

procedure PCharSet(p: PChar; N: Integer; Ch: Char);
var
  I: Integer;
begin
  for I := 0 to N - 1 do
    (p + I)^ := Ch;
end;

function ReplaceChar(Src: string; srcchr, repchr: Char): string;
var
  I, Len: Integer;
begin
  if Src <> '' then begin
    Len := Length(Src);
    for I := 0 to Len - 1 do
      if Src[I] = srcchr then Src[I] := repchr;
  end;
  Result := Src;
end;


function IsUniformStr(Src: string; Ch: Char): Boolean;
var
  I, Len: Integer;
begin
  Result := True;
  if Src <> '' then begin
    Len := Length(Src);
    for I := 0 to Len - 1 do
      if Src[I] = Ch then begin
        Result := False;
        Break;
      end;
  end;
end;


function CreateMask(Src: PChar; TargPos: Integer): string;
  function IsNumber(Chr: Char): Boolean;
  begin
    if (Chr >= '0') and (Chr <= '9') then
      Result := True
    else Result := False;
  end;
var
  intFlag, Loop: Boolean;
  Cnt, IntCnt, srclen: Integer;
  Ch, Ch2: Char;
begin
  intFlag := False;
  Loop := True;
  Cnt := 0;
  IntCnt := 0;
  srclen := StrLen(Src);

  while Loop do begin
    Ch := PChar(LongInt(Src) + Cnt)^;
    case Ch of
      #0: begin
          Result := '';
          Break;
        end;
      ' ': begin
        end;
    else begin

        if not intFlag then begin { Now Reading char }
          if IsNumber(Ch) then begin
            intFlag := True;
            Inc(IntCnt);
          end;
        end else begin { If, now reading integer }
          if not IsNumber(Ch) then begin { XXE+3 }
            case UpCase(Ch) of
              'E': begin
                  if (Cnt >= 1) and (Cnt + 2 < srclen) then begin
                    Ch := PChar(LongInt(Src) + Cnt - 1)^;
                    if IsNumber(Ch) then begin
                      Ch := PChar(LongInt(Src) + Cnt + 1)^;
                      Ch2 := PChar(LongInt(Src) + Cnt + 2)^;
                      if not ((Ch = '+') and (IsNumber(Ch2))) then begin
                        intFlag := False;
                      end;
                    end;
                  end;
                end;
              '+': begin
                  if (Cnt >= 1) and (Cnt + 1 < srclen) then begin
                    Ch := PChar(LongInt(Src) + Cnt - 1)^;
                    Ch2 := PChar(LongInt(Src) + Cnt + 1)^;
                    if not ((UpCase(Ch) = 'E') and (IsNumber(Ch2))) then begin
                      intFlag := False;
                    end;
                  end;
                end;
              '.': begin
                  if (Cnt >= 1) and (Cnt + 1 < srclen) then begin
                    Ch := PChar(LongInt(Src) + Cnt - 1)^;
                    Ch2 := PChar(LongInt(Src) + Cnt + 1)^;
                    if not ((IsNumber(Ch)) and (IsNumber(Ch2))) then begin
                      intFlag := False;
                    end;
                  end;
                end;

            else
              intFlag := False;
            end;
          end;
        end; {end of case else}
      end; {end of Case}
    end;
    if (intFlag) and (Cnt >= TargPos) then begin
      Result := '%' + Format('%d', [IntCnt]);
      Exit;
    end;
    Inc(Cnt);
  end;
end;

function GetValueFromMask(Src: PChar; Mask: string): string;
  function Positon(Str: string): Integer;
  var
    str2: string;
  begin
    str2 := Copy(Str, 2, Length(Str) - 1);
    Result := StrToIntDef(str2, 0);
    if Result <= 0 then Result := 1;
  end;
  function IsNumber(Ch: Char): Boolean;
  begin
    case Ch of
      '0'..'9': Result := True;
    else Result := False;
    end;
  end;
var
  intFlag, Loop, Sign: Boolean;
  buf: Str256;
  BufCount, Pos, LocCount, TargLoc, srclen: Integer;
  Ch, Ch2: Char;
begin
  srclen := StrLen(Src);
  LocCount := 0;
  BufCount := 0;
  Pos := 0;
  intFlag := False;
  Loop := True;
  Sign := False;

  if Mask = '' then Mask := '%1';
  TargLoc := Positon(Mask);

  while Loop do begin
    if Pos >= srclen then Break;
    Ch := PChar(Src + Pos)^;
    if not intFlag then begin {now reading chars}
      if LocCount < TargLoc then begin
        if IsNumber(Ch) then begin
          intFlag := True;
          BufCount := 0;
          Inc(LocCount);
        end else begin
          if not Sign then begin {default '+'}
            if Ch = '-' then Sign := True;
          end else begin
            if Ch <> ' ' then Sign := False;
          end;
        end;
      end else begin
        Break;
      end;
    end;
    if intFlag then begin {now reading numbers}
      buf[BufCount] := Ch;
      Inc(BufCount);
      if not IsNumber(Ch) then begin
        case Ch of
          'E', 'e': begin
              if (Pos >= 1) and (Pos + 2 < srclen) then begin
                Ch := PChar(Src + Pos - 1)^;
                if IsNumber(Ch) then begin
                  Ch := PChar(Src + Pos + 1)^;
                  Ch2 := PChar(Src + Pos + 2)^;
                  if not ((Ch = '+') or (Ch = '-') and (IsNumber(Ch2))) then begin
                    Dec(BufCount);
                    intFlag := False;
                  end;
                end;
              end;
            end;
          '+', '-': begin
              if (Pos >= 1) and (Pos + 1 < srclen) then begin
                Ch := PChar(Src + Pos - 1)^;
                Ch2 := PChar(Src + Pos + 1)^;
                if not ((UpCase(Ch) = 'E') and (IsNumber(Ch2))) then begin
                  Dec(BufCount);
                  intFlag := False;
                end;
              end;
            end;
          '.': begin
              if (Pos >= 1) and (Pos + 1 < srclen) then begin
                Ch := PChar(Src + Pos - 1)^;
                Ch2 := PChar(Src + Pos + 1)^;
                if not ((IsNumber(Ch)) and (IsNumber(Ch2))) then begin
                  Dec(BufCount);
                  intFlag := False;
                end;
              end;
            end;
        else begin

⌨️ 快捷键说明

复制代码 Ctrl + C
搜索代码 Ctrl + F
全屏模式 F11
切换主题 Ctrl + Shift + D
显示快捷键 ?
增大字号 Ctrl + =
减小字号 Ctrl + -