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

📄 hutil32.pas

📁 尚未完成的传奇3资源编辑器,需要就下吧
💻 PAS
📖 第 1 页 / 共 4 页
字号:
🔍
1234 
         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 IsEnglishStr (sEngStr:String): Boolean;
var
  i:Integer;
begin
	Result := FALSE;

  for i:= 1 to length(sEngStr) do begin
    Result := IsEnglish(sEngStr[i]);
    if Result then break;
  end;
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;
1234

⌨️ 快捷键说明

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