hutil32.pas

乐都SQL版传奇全套代码,绝对可编译

  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
            intFlag := False;
            Dec(BufCount);
          end;
        end;
      end;
    end;
    Inc(Pos);
  end;
  if LocCount = TargLoc then
  begin
    Buf[BufCount] := #0;
    if Sign then
      Result := '-' + StrPas(Buf)
    else
      Result := StrPas(Buf);
  end
  else
    Result := '';
end;

procedure GetDirList(path: string; fllist: TStringList);
var
  SearchRec                             : TSearchRec;
begin
  if FindFirst(path, faAnyFile, SearchRec) = 0 then
  begin
    fllist.AddObject(SearchRec.Name, TObject(SearchRec.Time));
    while True do
    begin
      if FindNext(SearchRec) = 0 then
      begin
        fllist.AddObject(SearchRec.Name, TObject(SearchRec.Time));
      end
      else
      begin
        SysUtils.FindClose(SearchRec);
        break;
      end;
    end;
  end;
end;

function GetFileDate(filename: string): Integer; //DOS format file date..
var
  SearchRec                             : TSearchRec;
begin
  Result := 0;                                              //jacky
  if FindFirst(filename, faAnyFile, SearchRec) = 0 then
  begin
    Result := SearchRec.Time;
    SysUtils.FindClose(SearchRec);
  end;
end;




procedure ShlStr(Source: PChar; Count: Integer);
var
  i, len                                : Integer;
begin
  len := StrLen(Source);
  while (Count > 0) do
  begin
    for i := 0 to len - 2 do
      Source[i] := Source[i + 1];
    Source[len - 1] := #0;

    Dec(Count);
  end;
end;

procedure ShrStr(Source: PChar; Count: Integer);
var
  i, len                                : Integer;
begin
  len := StrLen(Source);
  while (Count > 0) do
  begin
    for i := len - 1 downto 0 do
      Source[i + 1] := Source[i];
    Source[len + 1] := #0;

    Dec(Count);
  end;
end;

function LRect(l, t, r, b: Longint): TLRect;
begin
  Result.Left := l;
  Result.Top := t;
  Result.Right := r;
  Result.Bottom := b;
end;

procedure MemPCopy(Dest: PChar; Src: string);
var
  i                                     : Integer;
begin
  for i := 0 to Length(Src) - 1 do
    Dest[i] := Src[i + 1];
end;

procedure MemCpy(Dest, Src: PChar; Count: Longint);
var
  i                                     : Longint;
begin
  for i := 0 to Count - 1 do
  begin
    PChar(Longint(Dest) + i)^ := PChar(Longint(Src) + i)^;
  end;
end;

procedure memcpy2(TargAddr, SrcAddr: Longint; Count: Integer);
var
  i                                     : Integer;
begin
  for i := 0 to Count - 1 do
    PChar(TargAddr + i)^ := PChar(SrcAddr + i)^;
end;

procedure memset(Buffer: PChar; FillChar: Char; Count: Integer);
var
  i                                     : Integer;
begin
  for i := 0 to Count - 1 do
    Buffer[i] := FillChar;
end;

procedure Str256PCopy(Dest: PChar; const Src: string);
begin
  StrPLCopy(Dest, Src, 255);
end;

function _StrPas(Dest: PChar): string;
var
  i                                     : Integer;
begin
  Result := '';
  for i := 0 to Length(Dest) - 1 do
    if Dest[i] <> Chr(0) then
      Result := Result + Dest[i]
    else
      break;
end;

function Str_PCopy(Dest: PChar; Src: string): Integer;
var
  len, i                                : Integer;
begin
  len := Length(Src);
  for i := 1 to len do
    Dest[i - 1] := Src[i];
  Dest[len] := #0;
  Result := len;
end;

function Str_PCopyEx(Dest: PChar; const Src: string; buflen: Longint): Integer;
var
  len, i                                : Integer;
begin
  len := _MIN(Length(Src), buflen);
  for i := 1 to len do
    Dest[i - 1] := Src[i];
  Dest[len] := #0;