hutil32.pas

传奇的登陆器!也是在网上搜索的!不知道好不好用

	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;
   Result := len;
end;

function Str_Catch (src, dest: string; len: integer): string; //Result is rests..
begin

end;

function  Trim_R (const str: string): string;
var
	I, Len, tr: integer;
begin
	tr := 0;
	Len := Length (str);
   for I:=Len downto 1 do
   	if str[I] = ' ' then Inc (tr)
      else break;
   Result := Copy (str, 1, Len - tr);
end;

function IsEqualFont (SrcFont, TarFont: TFont): Boolean;
begin
	Result := TRUE;
	if SrcFont.Name <> TarFont.Name then Result := FALSE;
   if SrcFont.Color <> TarFont.Color then Result := FALSE;
   if SrcFont.Style <> TarFont.Style then Result := FALSE;
   if SrcFont.Size <> TarFont.Size then Result := FALSE;
end;


function CutHalfCode (Str: string): string;
var
	pos, Len: integer;
begin

	Result := '';
	pos := 1;
   Len := Length (Str);

	while TRUE do begin

   	if pos > Len then break;

      if (Str[pos] > #127) then begin

      	if ((pos+1) <= Len) and (Str[pos+1] > #127) then begin
      		Result := Result + Str[pos] + Str[pos+1];
         	Inc (pos);
         end;

      end else
      	Result := Result + Str[pos];

      Inc (pos);

   end;
end;


function ConvertToShortName(Canvas : TCanvas; Source : string; WantWidth : integer) : string;
var
   I, Len: integer;
   Str: string;
begin
	if Length(Source) > 3 then
      if Canvas.TextWidth (Source) > WantWidth then begin

 			Len := Length (Source);
         for I:=1 to Len do begin

            Str := Copy (Source, 1, (Len-I));
            Str := Str + '..';

            if Canvas.TextWidth (Str) < (WantWidth-4) then begin
               Result := CutHalfCode (Str);
               exit;
            end;

         end;

         Result := CutHalfCode (Copy (Source, 1, 2)) + '..';
         exit;

      end;

   Result := Source;

end;


function DuplicateBitmap (bitmap: TBitmap): HBitmap;
var
	hbmpOldSrc, hbmpOldDest, hbmpNew : HBitmap;
   hdcSrc, hdcDest						: HDC;

begin
   hdcSrc := CreateCompatibleDC (0);
   hdcDest := CreateCompatibleDC (hdcSrc);

   hbmpOldSrc := SelectObject(hdcSrc, bitmap.Handle);

   hbmpNew := CreateCompatibleBitmap(hdcSrc, bitmap.Width, bitmap.Height);

   hbmpOldDest := SelectObject(hdcDest, hbmpNew);

   BitBlt(hdcDest, 0, 0, bitmap.Width, bitmap.Height, hdcSrc, 0, 0,
     SRCCOPY);

   SelectObject(hdcDest, hbmpOldDest);
   SelectObject(hdcSrc, hbmpOldSrc);

   DeleteDC(hdcDest);
   DeleteDC(hdcSrc);

   Result := hbmpNew;
end;


procedure SpliteBitmap (DC: HDC; X, Y: integer; bitmap: TBitmap; transcolor: TColor);
var
   hdcMixBuffer, hdcBackMask, hdcForeMask, hdcCopy 			: HDC;
   hOld, hbmCopy, hbmMixBuffer, hbmBackMask, hbmForeMask 	: HBitmap;
   oldColor: TColor;
begin

   {UnrealizeObject (DC);}
(*   SelectPalette (DC, bitmap.Palette, FALSE);
   RealizePalette (DC);
  *)

	hbmCopy := DuplicateBitmap (bitmap);
	hdcCopy := CreateCompatibleDC (DC);
   hOld := SelectObject (hdcCopy, hbmCopy);

   hdcBackMask := CreateCompatibleDC (DC);
	hdcForeMask := CreateCompatibleDC (DC);
	hdcMixBuffer:= CreateCompatibleDC (DC);

	hbmBackMask := CreateBitmap (bitmap.Width, bitmap.Height, 1, 1, nil);
	hbmForeMask := CreateBitmap (bitmap.Width, bitmap.Height, 1, 1, nil);
	hbmMixBuffer:= CreateCompatibleBitmap (DC, bitmap.Width, bitmap.Height);

   SelectObject (hdcBackMask, hbmBackMask);
	SelectObject (hdcForeMask, hbmForeMask);
	SelectObject (hdcMixBuffer, hbmMixBuffer);

	oldColor := SetBkColor (hdcCopy, transcolor); //clWhite);

	BitBlt (hdcForeMask, 0, 0, bitmap.Width, bitmap.Height, hdcCopy, 0, 0, SRCCOPY);

	SetBkColor (hdcCopy, oldColor);

	BitBlt( hdcBackMask, 0, 0, bitmap.Width, bitmap.Height, hdcForeMask, 0, 0, NOTSRCCOPY );

	BitBlt( hdcMixBuffer, 0, 0, bitmap.Width, bitmap.Height, DC, X, Y, SRCCOPY );

	BitBlt( hdcMixBuffer, 0, 0, bitmap.Width, bitmap.Height, hdcForeMask, 0, 0, SRCAND );

	BitBlt( hdcCopy, 0, 0, bitmap.Width, bitmap.Height, hdcBackMask, 0, 0, SRCAND );

	BitBlt( hdcMixBuffer, 0, 0, bitmap.Width, bitmap.Height, hdcCopy, 0, 0, SRCPAINT );

	BitBlt( DC, X, Y, bitmap.Width, bitmap.Height, hdcMixBuffer, 0, 0, SRCCOPY );

   {DeleteObject (hbmCopy);}
   DeleteObject( SelectObject( hdcCopy, hOld ) );
	DeleteObject( SelectObject( hdcForeMask, hOld ) );
	DeleteObject( SelectObject( hdcBackMask, hOld ) );
	DeleteObject( SelectObject( hdcMixBuffer, hOld ) );

	DeleteDC( hdcCopy );
	DeleteDC( hdcForeMask );
	DeleteDC( hdcBackMask );
   DeleteDC( hdcMixBuffer );

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;

{ "xxxxxx" => xxxxxx }
function TakeOffTag (src: string; tag: char; var rstr: string): string;
var
   i, n2: integer;
begin
   n2 := Pos (tag, Copy (src, 2, Length(src)));
   rstr := Copy (src, 2, n2-1);
   Result := Copy (src, n2+2, length(src)-n2);
end;

function CatchString (source: string; cap: char; var catched: string): string;
var
   n: integer;
begin
   Result := '';
   catched := '';
   if source = '' then exit;
   if Length(source) < 2 then begin
      Result := source;
      exit;
   end;
   if source[1] = cap then begin
      if source[2] = cap then   //##abc#
         source := Copy (source, 2, Length(source));
      if TagCount (source, cap) >= 2 then begin
         Result := TakeOffTag (source, cap, catched);
      end else
         Result := source;
   end else begin
      if TagCount (source, cap) >= 2 then begin
         n := Pos (cap, source);
         source := Copy (source, n, Length(source));
         Result := TakeOffTag (source, cap, catched);
      end else
         Result := source;
   end;
end;

{ GetValidStr3客 崔府 侥喊磊啊 楷加栏肺 唱棵版快 贸府 救凳 }
{ 侥喊磊啊 绝阑 版快, nil 府畔.. }
function DivString (source: string; cap: char; var sel: string): string;
var
   n: integer;
begin
   if source = '' then begin
      sel := '';
      Result := '';
      exit;
   end;
   n := Pos (cap, source);
   if n > 0 then begin
      sel := Copy (source, 1, n-1);
      Result := Copy (source, n+1, Length(source));
   end else begin
      sel := source;
      Result := '';
   end;
end;

function DivTailString (source: string; cap: char; var sel: string): string;
var
   i, n: integer;
begin
   if source = '' then begin
      sel := '';
      Result := '';
      exit;
   end;
   n := 0;
   for i:=Length(source) downto 1 do
      if source[i] = cap then begin
         n := i;
         break;
      end;
   if n > 0 then begin
      sel := Copy (source, n+1, Length(source));
      Result := Copy (source, 1, n-1);
   end else begin
      sel := '';
      Result := source;
   end;
end;


function SPos (substr, str: string): integer;
var
   i, j, len, slen: integer;
   flag : Boolean;
begin
   Result := -1;
   len  := Length(str);
   slen := Length(substr);
   for i:=0 to len-slen do begin
      flag := TRUE;
      for j:=1 to slen do begin
         if byte(str[i + j]) >= $B0 then begin
            if (j < slen) and (i+j < len) then begin
               if substr[j] <> str[i + j] then begin
                  flag := FALSE;
                  break;
               end;
               if substr[j+1] <> str[i + j + 1] then begin
                  flag := FALSE;
                  break;
               end;
            end else
               flag := FALSE;
         end else
            if substr[j] <> str[i + j] then begin
               flag := FALSE;
               break;
            end;
      end;
      if flag then begin
         Result := i + 1;
         break;
      end;
   end;
end;

function NumCopy (str: string): integer;
var
   i: integer;
   data: string;
begin
   data := '';
   for i:=1 to Length(str) do begin
      if (Word('0') <= Word(str[i])) and (Word('9') >= Word(str[i])) then begin
         data := data + str[i];
      end else
         break;
   end;
   Result := Str_ToInt (data, 0);
end;

function  GetMonDay: string;
var
   year, mon, day: word;
   str: string;
begin
   DecodeDate (Date, year, mon, day);
   str := IntToStr(year);
   if mon < 10 then str := str + '0' + IntToStr(mon)
   else str := IntToStr(mon);
   if day < 10 then str := str + '0' + IntToStr(day)
   else str := IntToStr(day);
   Result := str;
end;

function  BoolToStr(boo: Boolean): string;
begin
   if boo then Result := 'TRUE'
   else Result := 'FALSE';
end;

function _MIN (n1, n2: integer): integer;
begin
	if n1 < n2 then Result := n1
   else Result := n2;
end;

function _MAX (n1, n2: integer): integer;
begin
	if n1 > n2 then Result := n1
   else Result := n2;
end;



end.