hutil32.pas

传世源码可编译的,功能齐全.是学习的好模版,会DELPHI的朋友们也可以自己修改,弄个自己的引擎.

unit HUtil32;

//============================================
// Latest Update date : 1998 1
// Add/Update Function and procedure :
// 		CaptureString
//       Str_PCopy          	(4/29)
//			Str_PCopyEx			 	(5/2)
//			memset					(6/3)
//       SpliteBitmap         (9/3)
//       ArrestString         (10/27)  {name changed}
//       IsStringNumber       (98'1/1)
//			GetDirList				(98'12/9)
//       GetFileDate          (98'12/9)
//       CatchString          (99'2/4)
//       DivString            (99'2/4)
//       DivTailString        (99'2/4)
//       SPos                 (99'2/9)
//============================================


interface

uses
	Classes, SysUtils,StrUtils, WinTypes, WinProcs, Graphics, Messages, Dialogs;

type
	Str4096 = array [0..4096] of char;
   Str256 = array [0..256] of char;
   TyNameTable = record
   	Name: string;
      varl:	Longint;
   end;

   TLRect = record
   	Left, Top, Right, Bottom: Longint;
   end;

const
	MAXDEFCOLOR			= 16;
	ColorNames: array [1..MAXDEFCOLOR] of TyNameTable = (
   	(Name: 'BLACK'; 		varl: clBlack),
      (Name: 'BROWN';		varl: clMaroon),
      (Name: 'MARGENTA';	varl: clFuchsia),
      (Name: 'GREEN';		varl: clGreen),
      (Name: 'LTGREEN';		varl: clOlive),
      (Name: 'BLUE';			varl: clNavy),
      (Name: 'LTBLUE';		varl: clBlue),
      (Name: 'PURPLE';		varl: clPurple),
      (Name: 'CYAN';			varl: clTeal),
      (Name: 'LTCYAN';		varl: clAqua),
      (Name: 'GRAY';			varl: clGray),
      (Name: 'LTGRAY';		varl: clsilver),
      (Name: 'YELLOW';		varl: clYellow),
      (Name: 'LIME';			varl: clLime),
      (Name: 'WHITE';		varl: clWhite),
      (Name: 'RED';			varl: clRed)
   );

   MAXLISTMARKER    = 3;
   LiMarkerNames: array [1..MAXLISTMARKER] of TyNameTable = (
   	(Name: 'DISC';			varl: 0),
      (Name: 'CIRCLE';		varl: 1),
      (Name: 'SQUARE';		varl: 2)
   );

   MAXPREDEFINE    = 3;
   PreDefineNames: array [1..MAXPREDEFINE] of TyNameTable = (
   	(Name: 'LEFT';			varl: 0),
      (Name: 'RIGHT';		varl: 1),
      (Name: 'CENTER';		varl: 2)
   );




function CountGarbage (paper: TCanvas; Src: PChar; TargWidth: Longint): integer; {garbage}
{[ArrestString]
      Result = Remain string,
      RsltStr = captured string
}
function  ArrestString (Source, SearchAfter, ArrestBefore: string;
					  const DropTags: array of string; var RsltStr: string): string;
{*}
function  ArrestStringEx (Source, SearchAfter, ArrestBefore: string; var ArrestStr: string): string;
function  CaptureString (source: string; var rdstr: string): string;
procedure ClearWindow (aCanvas: TCanvas; aLeft, aTop, aRight, aBottom:Longint; aColor: TColor);
function  CombineDirFile (SrcDir, TargName: string): string;
{*}
function  CompareLStr (src, targ: string; compn: integer): Boolean;
function  CompareBackLStr (src, targ: string; compn: integer): Boolean;
function  CompareBuffer (p1, p2: PByte; len: integer): Boolean;
function  CreateMask (Src: PChar; TargPos: Integer): string;
procedure DrawTileImage (Canv: TCanvas; Rect: TRect; TileImage: TBitmap);
procedure DrawingGhost (Rc: TRect);
function  ExtractFileNameOnly (const fname: string): string;
function  FloatToString (F: Real): string;
function  FloatToStrFixFmt (fVal: Double; prec, digit: Integer): string;
function  FileSize (const FName: string): Longint;
{*}
function  FileCopy(source,dest: String): Boolean;
function  FileCopyEx(source,dest: String): Boolean;
function  GetSpaceCount (Str: string): Longint;
function  RemoveSpace (str: string): string;
function  GetFirstWord (Str: string; var sWord: string; var FrontSpace: Longint): string;
function  GetDefColorByName (Str: string): TColor;
function  GetULMarkerType (Str: string): Longint;
{*}
function  GetValidStr3 (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetValidStr4 (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetValidStrVal (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetValidStrCap (Str: string; var Dest: string; const Divider: array of Char): string;
function  GetStrToCoords (Str: string): TRect;
function  GetDefines (Str: string): Longint;
function  GetValueFromMask (Src: PChar; Mask: string): string;
procedure GetDirList (path: string; fllist: TStringList);
function  GetFileDate (filename: string): integer; //DOS format file date..
function  HexToIntEx (shap_str: string): Longint;
function  HexToInt( str: string ): LongInt;
function  IntToStrFill (num, len: integer; fill: char): string;
function  IsInB (Src: string; Pos: integer; Targ: string): Boolean;
function  IsInRect (X, Y: integer; Rect: TRect): Boolean;
function  IsEnglish (Ch: Char): Boolean;
function  IsEngNumeric (Ch: Char): Boolean;
function  IsFloatNumeric (str: string): Boolean;
function  IsUniformStr (src: string; ch: char): Boolean;
function  IsStringNumber (str: string): boolean;
function  KillFirstSpace (var Str: string): Longint;
procedure KillGabageSpace (var Str: string);
function  LRect (l, t, r, b: Longint): TLRect;
procedure MemPCopy (Dest: PChar; Src: string);
procedure MemCpy (Dest, Src: PChar; Count: Longint);                {PChar type}
procedure memcpy2 (TargAddr, SrcAddr: Longint; count: integer);     {Longint type}
procedure memset (buffer: PChar; fillchar: char; count: integer);
procedure PCharSet (P: PChar; n: integer; ch: char);
function  ReplaceChar (src: string; srcchr, repchr: char): string;
function  Replacestr(sMsg,sStr,sText:String):String;
function  Replaceallstr(sMsg,sStr,sText:String):String;
function  IntToSex(sex:integer):string;
function  IntToJob(job:integer):string;

function  Str_ToDate (str: string): TDateTime;
function  Str_ToTime (str: string): TDateTime;
function  Str_ToInt (Str: string; def: Longint): Longint;
function  Str_ToFloat (str: string): Real;
function  SkipStr (Src: string; const Skips: array of char): string;
procedure ShlStr (Source: PChar; count: integer);
procedure ShrStr (Source: PChar; count: integer);
procedure Str256PCopy (Dest: PChar; const Src: string);
function  _StrPas (dest: PChar): string;
function  Str_PCopy (dest: PChar; src: string): integer;
function  Str_PCopyEx (dest: PChar; const src: string; buflen: longint): integer;
procedure SpliteBitmap (DC: HDC; X, Y: integer; bitmap: TBitmap; transcolor: TColor);
procedure TiledImage (Canv: TCanvas; Rect: TLRect; TileImage: TBitmap);
function  Trim_R (const str: string): string;
function  IsEqualFont (SrcFont, TarFont: TFont): Boolean;
function  CutHalfCode (Str: string): string;
function  ConvertToShortName(Canvas : TCanvas; Source : string; WantWidth : integer) : string;
{*}
function  CatchString (source: string; cap: char; var catched: string): string;
function  DivString (source: string; cap: char; var sel: string): string;
function  DivTailString (source: string; cap: char; var sel: string): string;
function  SPos (substr, str: string): integer;
function  NumCopy (str: string): integer;
function  GetMonDay: string;
function  BoolToStr(boo: Boolean): string;
function  BoolToIntStr(boo: Boolean): string;
function IsIPaddr(IP:String):Boolean;
function TagCount (source: string; tag: char): integer;
function   BoolToCStr(s:boolean):string;
 function  IntToStr2(n: integer): string;
function _MIN (n1, n2: integer): integer;
function _MAX (n1, n2: integer): integer;
function CalcFileCRC(FileName:String):Integer;
function CalcBufferCRC(Buffer:PChar;nSize:Integer):Integer;

function GetDayCount(MaxDate,MinDate:TDateTime):Integer;
function MakeHumanFeature(btRaceImg,btDress,btWeapon,btHair:Byte):Integer;

  function MakeMonsterFeature(btRaceImg,btWeapon:Byte;wAppr:Word):Integer;

implementation

//var
//	CSUtilLock: TRTLCriticalSection;

{ capture "double quote streams" }
function MakeHumanFeature(btRaceImg,btDress,btWeapon,btHair:Byte):Integer;
begin
  Result:=MakeLong(MakeWord(btRaceImg,btWeapon),MakeWord(btHair,btDress));
end;
function MakeMonsterFeature(btRaceImg,btWeapon:Byte;wAppr:Word):Integer;
begin
  Result:=MakeLong(MakeWord(btRaceImg,btWeapon),wAppr);
end;
function  BoolToIntStr(boo: Boolean): string;
begin
   if boo then Result := '1'
   else Result := '0';
end;






 function CalcFileCRC(FileName:String):Integer;
var
  I: Integer;
  nFileHandle:Integer;
  nFileSize,nBuffSize:Integer;
  Buffer:PChar;
  Int:^Integer;
  nCrc:Integer;
begin
  Result:=0;
  if not FileExists(FileName) then begin
    exit;
  end;
  nFileHandle:=FileOpen(FileName,fmOpenRead or fmShareDenyNone);
  if nFileHandle = 0 then exit;
  nFileSize:=FileSeek(nFileHandle,0,2);
  nBuffSize:=(nFileSize div 4) * 4;
  GetMem(Buffer,nBuffSize);
  FillChar(Buffer^,nBuffSize,0);
  FileSeek(nFileHandle,0,0);
  FileRead(nFileHandle,Buffer^,nBuffSize);
  FileClose(nFileHandle);
  Int:=Pointer(Buffer);
  nCrc:=0;
    Exception.Create(IntToStr(SizeOf(Integer)));
  for I := 0 to nBuffSize div 4 - 1 do begin
    nCrc:=nCrc xor Int^;
    Int:=Pointer(Integer(Int) + 4);
  end;
  FreeMem(Buffer);

  Result:=nCrc;
end;
function CalcBufferCRC(Buffer:PChar;nSize:Integer):Integer;
var
  I:Integer;
  Int:^Integer;
  nCrc:Integer;
begin
  Int:=Pointer(Buffer);
  nCrc:=0;
  for I := 0 to nSize div 4 - 1 do begin
    nCrc:=nCrc xor Int^;
    Int:=Pointer(Integer(Int) + 4);
  end;
  Result:=nCrc;
end;

  function IntToStr2(n: integer): string;
begin
  if n < 10 then Result := '0' + IntToStr(n)
  else Result := IntToStr(n);
end;

function   BoolToCStr(s:boolean):string;
begin
  if s then result:= 'YES' else result:='NO' ;
end;

function TagCount (source: string; tag: char): integer;
var
   i, tcount: integer;
begin
   tcount := 0;
   for i:=1 to Length(source) do
      if source[i] = tag then Inc (tcount);
   Result := tcount;
end;

function IsIPaddr(IP:String):Boolean;
var
  Node:array [0..3] of integer;
  tIP:String;
  tNode:String;
  tPos:Integer;
  tLen:Integer;
begin
 Result:=False;
 tIP:=IP;
 tLen:=Length(tIP);
 tPos:=Pos('.',tIP);
 tNode:=MidStr(tIP,1,tPos -1);
 tIP:=MidStr(tIP,tPos +1 ,tLen - tPos);
 if not TryStrToInt(tNode,Node[0]) then exit;

 tLen:=Length(tIP);
 tPos:=Pos('.',tIP);
 tNode:=MidStr(tIP,1,tPos -1);
 tIP:=MidStr(tIP,tPos +1 ,tLen - tPos);
 if not TryStrToInt(tNode,Node[1]) then exit;

 tLen:=Length(tIP);
 tPos:=Pos('.',tIP);
 tNode:=MidStr(tIP,1,tPos -1);
 tIP:=MidStr(tIP,tPos +1 ,tLen - tPos);
 if not TryStrToInt(tNode,Node[2]) then exit;

 if not TryStrToInt(tIP,Node[3]) then exit;
 for tLen:=Low(Node) to High(Node) do begin
   if(Node[tLen] < 0) or (Node[tLen] > 255) then exit;
 end;
 Result:=True;
end;

function  CaptureString (source: string; var rdstr: string): string;
var
	st, et, c, len, i: integer;
begin
   if source = '' then begin
   	rdstr := ''; Result := '';
      exit;
   end;
	c := 1;
   //et := 0;
   len := Length (source);
	while source[c] = ' ' do
      if c < len then Inc (c)
      else break;

   if (source[c] = '"') and (c < len) then begin

      st := c+1;
      et := len;
    	for i:=c+1 to len do
      	if source[i] = '"' then begin
            et := i-1;
         	break;
         end;

   end else begin
   	st := c;
      et := len;
      for i:=c to len do
      	if source[i] = ' ' then begin
         	et := i-1;
            break;
         end;

   end;

   rdstr := Copy (source, st, (et-st+1));
   if len >= (et+2) then
   	Result := Copy (source, et+2, len-(et+1)) else
      Result := '';

end;


function CountUglyWhiteChar (sPtr: PChar): Longint;
var
   Cnt, Killw: Longint;
begin
   Killw := 0;
   for Cnt := (StrLen(sPtr)-1) downto 0 do begin
      if sPtr[Cnt] = ' ' then begin
         Inc (KillW);
         {sPtr[Cnt] := #0;}
      end else break;
   end;
   Result := Killw;
end;


function CountGarbage (paper: TCanvas; Src: PChar; TargWidth: Longint): integer; {garbage}
var
	gab, destWidth: integer;
begin

   gab := CountUglyWhiteChar (Src);
   destWidth := paper.TextWidth(StrPas (Src)) - gab;
   Result := TargWidth - DestWidth + (gab * paper.TextWidth(' '));

end;


function GetSpaceCount (Str: string): Longint;
var
	Cnt, Len, SpaceCount: Longint;
begin
	SpaceCount := 0;
	Len := Length (Str);
   for Cnt := 1 to Len do
     	if Str[Cnt] = ' ' then SpaceCount := SpaceCount + 1;
   Result := SpaceCount;
end;

function  RemoveSpace (str: string): string;
var
   i: integer;
begin
   Result := '';
   for i:=1 to Length(str) do
      if str[i] <> ' ' then
         Result := Result + str[i];
end;

function KillFirstSpace (var Str: string): Longint;
var
	Cnt, Len: Longint;
begin
   Result := 0;
   Len := Length (Str);
	for Cnt := 1 to Len do
   	if Str[Cnt] <> ' ' then begin
         Str := Copy (Str, Cnt, Len-Cnt+1);
         Result := Cnt-1;
         break;
      end;
end;

procedure KillGabageSpace (var Str: string);
var
	Cnt, Len: Longint;
begin
   Len := Length (Str);
	for Cnt := Len downto 1 do
   	if Str[Cnt] <> ' ' then begin
         Str := Copy (Str, 1, Cnt);
         KillFirstSpace (Str);
         break;
      end;
end;

function GetFirstWord (Str: string; var sWord: string; var FrontSpace: Longint): string;
var
   Cnt, Len, N: Longint;
   DestBuf: Str4096;
begin
   Len := Length (Str);
   if Len <= 0 then
   	Result := ''
   else begin
   	FrontSpace := 0;
      for Cnt := 1 to Len do begin
         if Str[Cnt] = ' ' then Inc (FrontSpace)
         else break;
      end;
      N := 0;
      for Cnt := Cnt to Len do begin
         if Str[Cnt] <> ' ' then
            DestBuf[N] := Str[Cnt]
         else begin
            DestBuf[N] := #0;
            sWord := StrPas (DestBuf);
            Result := Copy (Str, Cnt, Len-Cnt+1);
            exit;
         end;
         Inc (N);
      end;
      DestBuf[N] := #0;
      sWord := StrPas (DestBuf);
      Result := '';
   end;
end;

function HexToIntEx (shap_str: string): Longint;
begin
   Result := HexToInt (Copy (Shap_str, 2, Length(Shap_str)-1));
end;

function HexToInt( str: string ): LongInt;
var
   digit: Char;
   count, i: Integer;
   Cur, Val: LongInt;
begin
   Val := 0;
   count := Length(str);
   for i := 1 to count do begin
      digit := str[i];
           if (digit >= '0') and (digit <= '9') then Cur := Ord(digit) - Ord('0')
      else if (digit >= 'A') and (digit <= 'F') then Cur := Ord(digit) - Ord('A') + 10
      else if (digit >= 'a') and (digit <= 'f') then Cur := Ord(digit) - Ord('a') + 10
      else Cur := 0;
      Val := Val + (Cur shl (4*(count-i)));
   end;
   Result := Val;
//   Result := (Val and $0000FF00) or ((Val shl 16) and $00FF0000) or ((Val shr 16) and $000000FF);
end;

function Str_ToInt (Str: string; def: Longint): Longint;
begin
   Result := def;
   if Str <> '' then begin
      if ((word(Str[1]) >= word('0')) and (word(str[1]) <= word('9'))) or
         (str[1] = '+') or (str[1] = '-') then
         try
            Result := StrToInt64 (Str);
         except
         end;
   end;
end;

function Str_ToDate (Str: string): TDateTime;
begin
   if Trim(Str) = '' then Result := Date
   else
      Result := StrToDate (str);
end;

function  IntToSex(sex:integer):string;
begin
    result:='未知' ;
    case sex of
    0:result:='男' ;
    1:result:='女' ;
    2:result:='人妖' ;
    end;
end;
function  IntToJob(job:integer):string;
begin
     result:='未知' ;
    case job of
    0:result:='战士' ;
    1:result:='法师' ;
    2:result:='道士' ;
    end;
end;
function Str_ToTime (Str: string): TDateTime;
begin
   if Trim(Str) = '' then Result := Time
   else
      Result := StrToTime (str);
end;