// $Id: util.pas,v 1.12 2001/04/16 17:35:38 xenon Exp $ unit util; interface uses SysUtils, ansiio; function URange(min, value, max : longint) : longint; function UMax(op1, op2 : longint) : longint; function UMin(op1, op2 : longint) : longint; function IS_SET(value, bit : cardinal) : boolean; procedure SET_BIT(var value : cardinal; bit : cardinal); procedure REMOVE_BIT(var value : cardinal; bit : cardinal); function pad_integer(s, num : integer) : string; function pad_integer_front(s, num : integer) : string; function pad_string(s : string; num : integer) : string; function pad_string_front(s : string; num : integer) : string; function trail_number(s:integer):string; function findNumber(var s:string):integer; function add_chars(num:integer; s : string; c : char) : string; function cap(s : string) : string; function one_argument(argument : string; var arg_first : string) : string; function number_range(val_from, val_to : integer) : integer; function number_percent:integer; function rolldice(num,size:integer):integer; function mudAnsi(color : integer) : string; function isName(name, substr : string) : boolean; function isObjectName(name, substr : string) : boolean; function DiffMinutes (const D1, D2 : TDateTime) : Integer; function DiffHours (const D1, D2 : TDateTime) : Integer; function DiffDays (const D1, D2 : TDateTime) : Integer; function StringMatches(Value, Pattern : String) : Boolean; function makedrunk(param : string) : string; implementation uses constants, strip; // returns value if min <= value <= max, or min when value < min // or max when value > max function URange(min, value, max : longint) : longint; begin if (value < min) then URange := min else if (value > max) then URange := max else URange := value; end; // returns the maximum of the two operands function UMax(op1, op2 : longint) : longint; begin if (op1 > op2) then UMax := op1 else UMax := op2; end; // returns the minimum of the two operands function UMin(op1, op2 : longint) : longint; begin if (op1 < op2) then UMin := op1 else UMin := op2; end; function IS_SET(value, bit : cardinal) : boolean; begin IS_SET := ((value and bit) = bit); end; procedure SET_BIT(var value : cardinal; bit : cardinal); begin value := value or bit; end; procedure REMOVE_BIT(var value : cardinal; bit : cardinal); begin if (IS_SET(value, bit)) then dec(value, bit); end; function pad_integer(s, num : integer) : string; var g : string; begin g := inttostr(s); pad_integer := g + StringOfChar(' ', num-length(g)); end; function pad_integer_front(s, num : integer) : string; var g : string; begin g := inttostr(s); pad_integer_front := StringOfChar(' ', num - length(g)) + g; end; function pad_string(s : string; num : integer) : string; begin pad_string := s + StringOfChar(' ', num - length(s)); end; function pad_string_front(s : string; num : integer) : string; begin pad_string_front := StringOfChar(' ', num - length(s)) + s; end; function trail_number(s:integer):string; var g:string; begin g:=inttostr(s); case s of 1:g:=g+'st'; 2:g:=g+'nd'; 3:g:=g+'rd'; else g:=g+'th'; end; trail_number:=g; end; function findNumber(var s:string):integer; var g:string; begin if (pos('.',s) = 0) then Result := 1 else begin g := left(s, '.'); s := right(s, '.'); try Result := strtoint(g); except Result := 1; end; end; end; function add_chars(num:integer; s : string; c : char) : string; begin if (length(s)>num) then begin add_chars := s; exit; end; add_chars := s + StringOfChar(c, num - length(s)); end; function cap(s : string) : string; var g : integer; begin if (length(s) = 0) then begin cap := ''; exit; end; g := 0; repeat inc(g); if (s[g] = '$') then inc(g, 2); until (byte(s[g]) in [33..126]) or (length(s) <= g); s[g] := upcase(s[g]); cap := s; end; function one_argument(argument : string; var arg_first : string) : string; var cEnd : char; count : integer; p : integer; begin count := 0; cEnd := ' '; p := 1; argument := trim(argument); arg_first := ''; if (length(argument) = 0) then begin one_argument := ''; exit; end; if (argument[p] = '''') or (argument[p] = '"') then begin cEnd := argument[p]; inc(p); end; while (p <= length(argument)) and (count < 256) do begin if (argument[p] = cEnd) or (argument[p] = #13) or (argument[p] = #10) then begin inc(p); break; end; arg_first := concat(arg_first, argument[p]); inc(p); inc(count); end; while (p <= length(argument)) and ((argument[p] = ' ') or (argument[p] = #13) or (argument[p] = #10)) do inc(p); one_argument := copy(argument, p, length(argument) - p + 1); end; function number_range(val_from, val_to : integer) : integer; begin number_range := random(val_to - val_from) + val_from; end; function number_percent:integer; begin number_percent:=random(100)+1; end; function rolldice(num,size:integer):integer; var s,a:integer; begin s:=0; for a:=1 to num do inc(s,random(size)+1); rolldice:=s; end; function mudAnsi(color : integer) : string; begin if (color > 8) then mudAnsi := '$B$' + inttostr(color - 8) else mudAnsi := '$A$' + inttostr(color); end; {Jago 10/Jan/2001 - utility function (- move it to util.pas)} {Xenon 16/Apr/2001: changed code so something like 'eno' doesn''t match xenon } {Xenon 16/Apr/2001: reverted last change for now } function isName(name, substr : string) : boolean; begin Result := (Pos(trim(uppercase(substr)), trim(uppercase(name)) ) > 0); // Result := (Pos(trim(uppercase(substr)), trim(uppercase(name))) = 1); end; {Xenon 16/Apr/2001: same as isName() but less strict } function isObjectName(name, substr : string) : boolean; begin Result := (Pos(trim(uppercase(substr)), trim(uppercase(name))) > 0); end; // functions borrowed from the Delphi Fundamentals const OneDay = 1.0; OneHour = OneDay / 24.0; OneMinute = OneHour / 60.0; OneSecond = OneMinute / 60.0; OneMillisecond = OneSecond / 1000.0; function DiffMinutes (const D1, D2 : TDateTime) : Integer; begin Result := Trunc ((D2 - D1) / OneMinute); end; function DiffHours (const D1, D2 : TDateTime) : Integer; begin Result := Trunc ((D2 - D1) / OneHour); end; function DiffDays (const D1, D2 : TDateTime) : Integer; begin Result := Trunc (D2 - D1); end; // functions borrowed from the Peter Morris' FastString lib function FastCharPos(const aSource : String; const C: Char; StartPos : Integer) : Integer; var L : Integer; begin //If this assert failed, it is because you passed 0 for StartPos, lowest value is 1 !! Assert(StartPos > 0); Result := 0; L := Length(aSource); if L = 0 then exit; if StartPos > L then exit; Dec(StartPos); asm PUSH EDI //Preserve this register mov EDI, aSource //Point EDI at aSource add EDI, StartPos mov ECX, L //Make a note of how many chars to search through sub ECX, StartPos mov AL, C //and which char we want @Loop: cmp Al, [EDI] //compare it against the SourceString jz @Found inc EDI dec ECX jnz @Loop jmp @NotFound @Found: sub EDI, aSource //EDI has been incremented, so EDI-OrigAdress = Char pos ! inc EDI mov Result, EDI @NotFound: POP EDI end; end; function StringMatches(Value, Pattern : String) : Boolean; var NextPos, Star1, Star2 : Integer; NextPattern : String; begin Star1 := FastCharPos(Pattern,'*',1); if Star1 = 0 then Result := (Value = Pattern) else begin Result := (Copy(Value,1,Star1-1) = Copy(Pattern,1,Star1-1)); if Result then begin if Star1 > 1 then Value := Copy(Value,Star1,Length(Value)); Pattern := Copy(Pattern,Star1+1,Length(Pattern)); NextPattern := Pattern; Star2 := FastCharPos(NextPattern, '*',1); if Star2 > 0 then NextPattern := Copy(NextPattern,1,Star2-1); NextPos := pos(NextPattern,Value); if (NextPos = 0) and not (NextPattern = '') then Result := False else begin Value := Copy(Value,NextPos,Length(Value)); if Pattern = '' then Result := True else Result := Result and StringMatches(Value,Pattern); end; end; end; end; // Drunken speech - Nemesis function makedrunk(param : string) : string; var temp : char; i, drunkpos : integer; buf, drunkstring : string; begin for i:=1 to length(param) do begin drunkpos := 0; param := uppercase(param); temp := param[i]; if (temp = ' ') then buf := ' ' else if not (temp in ['A'..'Z']) then buf := temp else begin try while (cap(temp) < 'Z') do begin inc(temp); inc(drunkpos); end; except drunkpos := -1; end; if (drunkpos >= 0) and (drunkpos <= 25) then buf := drunkbuf[drunkpos] else buf := temp; end; drunkstring := drunkstring + buf; end; Result := drunkstring; end; end.