vg3sysutils.pas

Midas.dll全部源码

{$I hb.inc}
{$D-,L-}

unit vg3SysUtils;

interface
uses Windows, SysUtils, TypInfo, Classes;

function FindInteger(Value: Integer; const Buff; Count: Integer): Integer;
function CompareChars(const Buffer1, Buffer2; Count: Integer): Integer;
procedure ZeroMem(pBuff: Pointer; Count: Integer);
function MaxInteger(A:Integer;B:Integer):Integer;
function MinInteger(A:Integer; B:Integer):Integer;
function Like(const Source, Template: String): Boolean;
procedure AddDelimeted(var dest: string; const SubStr, Delimeter: string);
function ListAdd(var List: TList; Item: Pointer): integer;
procedure ListClear(var List: TList);
function ListCount(List: TList): Integer;
procedure ListDestroyObjects(var List: TList;DestroyList:Boolean);
procedure ListFreeMem(var List: TList;DestroyList:Boolean);
function ListCheck(var List: TList): TList;
procedure FreeObject(var Obj);
implementation
function FindInteger(Value: Integer; const Buff; Count: Integer): Integer; assembler;
asm
        XCHG    EDI,EDX
        PUSH    ECX
        REPNE   SCASD
        MOV     EDI,EDX
        POP     EAX
        JE      @@1
        XOR     EAX,EAX
@@1:    SUB     EAX,ECX
        DEC     EAX
        MOV     EDI,EDX
end;

function CompareChars(const Buffer1, Buffer2; Count: Integer): Integer;
asm
        PUSH    ESI
        PUSH    EDI
        MOV     ESI, EAX
        MOV     EDI, EDX
        XOR     EAX, EAX
        REPE    CMPSB
        JB      @@1
        NEG     ECX
@@1:    SUB     EAX,ECX
        POP     EDI
        POP     ESI
end;

procedure ZeroMem(pBuff: Pointer; Count: Integer);
asm
        MOV     ECX,EDX
        SAR     ECX,2
        JS      @@exit
        PUSH    EDI
        MOV     EDI,EAX { Point EDI to destination      }
        XOR     EAX,EAX
        REP     STOSD   { Fill count DIV 4 dwords       }
        MOV     ECX,EDX
        AND     ECX,3
        REP     STOSB   { Fill count MOD 4 bytes        }
        POP     EDI
@@exit:
end;

function MaxInteger (A:Integer; B:Integer):Integer;
begin
if a<=b then
    result:=b
else
    result:=a;
end;

function MinInteger (A:Integer; B: Integer):Integer;
begin
  if a>=b then
    result:=b
else
    result:=a;
end;

function Like(const Source, Template: String): Boolean;
const
  SpecialChars: TSysCharSet = ['%', '*', '?', '_'];
var
 I, J, K, LTemplate, LSource: Integer;
begin
  Result := False;
  LTemplate := Length(Template);
  LSource := Length(Source);
  I := 1; J := 1;
  while (I <= LTemplate) and (J <= LSource) do
  begin
    case Template[I] of
      '?', '_':
        ;
      '*', '%':
        begin
          while (Template[I] in SpecialChars) and (I <= LTemplate) do Inc(I);
          if I > LTemplate then
            Result := True
          else
            while J <= LSource do
            begin
              while (Source[J] <> Template[I]) and (J <= LSource) do Inc(J);
              if J > LSource then Break;
              K := 0;
              while (Source[J + K] = Template[I + K]) and
                    (J + K <= LSource) and (I + K <= LTemplate) and
                    (not (Template[I + K] in SpecialChars)) do Inc(K);
              if (Template[I + K] in SpecialChars) or (I + K > LTemplate) then
              begin
                Inc(I, K - 1);
                Inc(J, K - 1);
                Break;
              end;
              Inc(J, K);
            end;
            if J > LSource then Break;
        end;
      else
        if (Source[J] <> Template[I]) then Break;
    end;
    Inc(I); Inc(J);
    if (J > LSource) then
    begin
      K := 0;
      while (Template[I + K] in ['%', '*']) and (I + K <= LTemplate) do Inc(K);
      if (I + K > LTemplate) then Result := True;
    end;
  end;
end;

procedure AddDelimeted(var dest: string; const SubStr, Delimeter: string);
begin
  if dest <> '' then dest :=dest + Delimeter;
  dest := dest + SubStr;
end;

function ListAdd(var List: TList; Item: Pointer): integer;
begin
  result:=TList(ListCheck(List)).Add(Item);
end;

procedure ListClear(var List: TList);
begin
FreeAndNil(List);
end;

function ListCount(List: TList): Integer;
begin
  if Assigned(List) then Result := List.Count else Result := 0;
end;

procedure ListDestroyObjects(var List: TList;DestroyList:Boolean);
var
  I: Integer;
begin
if Assigned(List) then
  begin
      with List do
        for I := Count - 1 downto 0 do
          TObject(List^[I]).Free;
      if DestroyList then
         FreeAndNil(List)
      else
         List.Clear;
  end;
end;

procedure ListFreeMem(var List: TList;DestroyList:Boolean);
var
  I: Integer;
  P: Pointer;
begin
if Assigned(List) then
   begin
        with List do
          for I := 0 to Count - 1 do
          begin
            P := List^[I];
            FreeMem(P);
          end;
        if DestroyList then
           FreeAndNil(List)
        else
           List.Clear;
    end;
end;

function ListCheck(var List: TList): TList;
begin
  if not Assigned(List) then List := TList.Create;
  Result := List;
end;

procedure FreeObject(var Obj); assembler;
asm
  MOV     ECX, [EAX]
  TEST    ECX, ECX
  JE      @@exit
  PUSH    EAX
  MOV     EAX, ECX
  MOV     ECX, [EAX]
  MOV     DL,1
  CALL    dword ptr [ECX - 4] { vtDestroy }
  POP     EAX
  XOR     ECX, ECX
  MOV     [EAX], ECX
@@exit:
end;
end.