mmutils.pas

一套及时通讯的原码

end;

{=========================================================================}
function GetFromRegistry(_RootKey:HKEY;_Localkey,_Field:String;Value:Variant): Variant;
begin
   Result := Value;
   try
      with TRegistry.Create do
      try
         { default is  RootKey=HKEY_CURRENT_USER  }
         case _RootKey of
              HKEY_CLASSES_ROOT,
              HKEY_CURRENT_USER,
              HKEY_LOCAL_MACHINE,
              HKEY_USERS,
              HKEY_PERFORMANCE_DATA,
              HKEY_CURRENT_CONFIG,
              HKEY_DYN_DATA : RootKey := _RootKey;
         end;

         if OpenKey(_Localkey, False) then
         begin
            if ValueExists(_Field) then
            case VarType(Value) of
                varByte,
                varNull,
                varInteger,
                varSmallint: Result := ReadInteger(_Field);
                varSingle,
                varDouble  : Result := ReadFloat   (_Field);
                varCurrency: Result := ReadCurrency(_Field);
                varDate    : Result := ReadDateTime(_Field);
                varBoolean : Result := ReadBool    (_Field);
                varString,
                varOleStr  : Result := ReadString  (_Field);
            end;
            CloseKey;
         end;

      finally
         Free;
      end;
   except
   end;
end;

{=========================================================================}
function GetFromRegistryBinary(_RootKey:HKEY;_Localkey,_Field:string;var Buffer; BufSize: integer): integer;
begin
   Result := 0;
   try
      with TRegistry.Create do
      try
         { default is  RootKey=HKEY_CURRENT_USER  }
         case _RootKey of
             HKEY_CLASSES_ROOT,
             HKEY_CURRENT_USER,
             HKEY_LOCAL_MACHINE,
             HKEY_USERS,
             HKEY_PERFORMANCE_DATA,
             HKEY_CURRENT_CONFIG,
             HKEY_DYN_DATA : RootKey := _RootKey;
         end;

         if OpenKey(_Localkey, False) then
         begin
            if ValueExists(_Field) then
            begin
               if (BufSize = 0) then
                   Result := GetDataSize(_Field)
               else
                   Result := ReadBinaryData(_Field,Buffer,BufSize);
            end;
            CloseKey;
         end;

      finally
         Free;
      end;
   except
   end;
end;

{=========================================================================}
function GetCPUUsage: integer;
var
   TempKey: HKEY;
   DataType,BufSize,Dummy: integer;

begin
   Result := 0;
   if _WIN9x_ or _WINNT_NEW_ then
   begin
      TempKey := 0;
      { start measuring }
      if RegOpenKeyEx(HKEY_DYN_DATA, 'PerfStats\StartStat', 0,
                      KEY_ALL_ACCESS, TempKey) <> ERROR_SUCCESS then exit;

      DataType := REG_NONE;
      BufSize := sizeOf(integer);
      if RegQueryValueEx(TempKey, 'KERNEL\CPUUsage', nil, @DataType,
                         @Dummy, @BufSize) <> ERROR_SUCCESS then exit;

      RegCloseKey(TempKey);

      { get the value }
      if RegOpenKeyEx(HKEY_DYN_DATA, 'PerfStats\StatData', 0,
                      KEY_ALL_ACCESS, TempKey) <> ERROR_SUCCESS then exit;

      RegCloseKey(TempKey);

      DataType := REG_NONE;
      BufSize := sizeOf(integer);
      if RegQueryValueEx(TempKey, 'KERNEL\CPUUsage', nil, @DataType,
                         @Result, @BufSize) <> ERROR_SUCCESS then exit;

      RegCloseKey(TempKey);

      { stop measuring }
      if RegOpenKeyEx(HKEY_DYN_DATA, 'PerfStats\StopStat', 0,
                      KEY_ALL_ACCESS, TempKey) <> ERROR_SUCCESS then exit;

      DataType := REG_NONE;
      BufSize := sizeOf(integer);
      if RegQueryValueEx(TempKey, 'KERNEL\CPUUsage', nil, @DataType,
                         @Dummy, @BufSize) <> ERROR_SUCCESS then exit;

      RegCloseKey(TempKey);
   end;
end;

{=========================================================================}
function GetShortFileName(Name: TFileName): String;
var
   SearchRec: TSearchRec;

begin
   Result := '';
   Name := ExpandUNCFileName(Name);
   if (Name <> '') and FileExists(Name) then
   begin
      if (FindFirst(Name,faAnyFile,SearchRec) = 0) and
          Equal(SearchRec.Name, ExtractFileName(Name)) then
      try
         if SearchRec.FindData.cAlternateFileName[0] <> #0 then
            Result := StrPas(SearchRec.FindData.cAlternateFileName)
         else
            Result := StrPas(SearchRec.FindData.cFileName);

      finally
         FindClose(SearchRec);
      end;
   end;
end;

{=========================================================================}
{ Returns:                                                                }
{  0 = 8086/88,80286,80386,80486                                          }
{  1 = Pentium(R) Processor                                               }
{  2 = PentiumPro(R) Processor                                            }
{  3 or higher = Processor beyond the PentiumPro(R) Processor            }
{                                                                         }
{=========================================================================}
function GetCPUType: integer;
var
   stepping: Byte;
   model: Byte;

begin
   Result := 0;
{$IFDEF WIN32}
   asm
      pushad
      pushfd

      { look if cpuid is supported }
      pushfd			// Get original EFLAGS
      pop    eax

      mov    ecx, eax
      xor    eax, 200000h	// Flip ID bit in EFLAGS
      push   eax		// Save new EFLAGS value on
      				//   stack
      popfd			// Replace current EFLAGS value

      pushfd			// Get new EFLAGS
      pop     eax		// Store new EFLAGS in EAX

      xor     eax, ecx		// Can not toggle ID bit,
      jz      @@exit		// Processor=80486

      mov     eax, 1

      db      $0F
      db      $a2		// Get family/model/stepping/
        			//   features
      mov     stepping, al
      and     stepping, $F

      and     al, $F0
      shr     al, 4
      mov     model, al

      and     eax, $F00
      shr     eax, 8		// Isolate family
      and     eax, $F
      sub     eax, 4
      mov     Result, eax	// Set _cpu_type with family

   @@exit:

      popfd
      popad
   end;
{$ENDIF}
end;

{=========================================================================}
function Min64(a, b: int64): int64;
begin
   if a > b then Result := b
   else Result := a;
end;

{=========================================================================}
function Max64(a, b: int64): int64;
begin
   if a > b then Result := a
   else Result := b;
end;

{=========================================================================}
function MinMax64(X, Min, Max: int64): int64;
begin
   if (X < Min) then X := Min
   else if (X > Max) then X := Max;
   Result := X;
end;

{=========================================================================}
function InMinMax64(X,Min,Max: int64): Boolean;
begin
   { if Min > Max then Result is never true }
   if (X < Min) then Result := False
   else if (X > Max) then Result := False
   else Result := True;
end;

{=========================================================================}
function Sign(Value: Longint): Longint;
begin
   if (Value > 0) then
       Result := 1
   else if (Value < 0) then
       Result := -1
   else
       Result := Value;
end;

{=========================================================================}
{ Current flag assignment is as follows:                                  }
{                                                                         }
{		bit23=1     CPU has MMX extension                         }
{		bit15=1     CMOV instruction supported                    }
{		bit9 =1     CPU contains a local APIC (iPentium-3V)       }
{		bit8 =1     CMPXCHG8B instruction supported               }
{		bit7 =1     machine check exception supported             }
{		bit6 =0     reserved (36bit-addressing & 2MB-paging)      }
{		bit5 =1     iPentium-style MSRs supported                 }
{		bit4 =1     time stamp counter TSC supported              }
{		bit3 =1     page size extensions supported                }
{		bit2 =1     I/O breakpoints supported                     }
{		bit1 =1     enhanced virtual 8086 mode supported          }
{		bit0 =1     CPU contains a floating-point unit (FPU)      }
{=========================================================================}
function GetCPUFeatures: Longint;
begin
   Result := 0;
{$IFDEF WIN32}
   asm
      pushad
      pushfd

      { look if cpuid is supported }
      pushfd			// Get original EFLAGS
      pop    eax
      mov    ecx, eax
      xor    eax, 200000h	// Flip ID bit in EFLAGS
      push   eax		// Save new EFLAGS value on
      				//   stack
      popfd			// Replace current EFLAGS value
      pushfd			// Get new EFLAGS
      pop     eax		// Store new EFLAGS in EAX
      xor     eax, ecx		// Can not toggle ID bit,
      jz      @@exit		// Processor=80486

      mov     eax, 1

      db      $0F
      db      $a2		// Get family/model/stepping/
        			//   features
      mov     Result, edx

   @@exit:

      popfd
      popad
   end;
{$ENDIF}
end;

{=========================================================================}
{ Returns:                                                                }
{  0 = Pentium(R) Processor                                               }
{  1 = PentiumPro(R) Processor                                            }
{  2 = MMX Extension                                                      }
{=========================================================================}
function GetCPUMode: integer;
begin
   if _USECPUEXT_ then
   begin
      if _MMX_ then
         Result := 2
      else if _CPU_ > PENTIUM then
         Result := 1
      else
         Result := 0;
   end
   else Result := 0;
end;

{=========================================================================}
function GetCPUCycles: int64;
asm
{$IFDEF WIN32}
      db      00fh              //RDTSC
      db      031h
      {$IFNDEF DELPHI4}
      mov     TLargeInteger(Result).HighPart,edx
      mov     TLargeInteger(Result).LowPart,eax
      {$ENDIF}
{$ENDIF}
end;

var
   TimeCount: Longint;
   OldTime,TimeMin,TimeMax,TimeAvg: int64;

{=========================================================================}
procedure InitTimeMeasure;
begin
   TimeCount:= 0;
   TimeMin  := MAXLONGINT;
   TimeMax  := 0;
   TimeAvg  := 0;
end;

{=========================================================================}
procedure StartTimeMeasure;
begin
   inc(TimeCount);
   OldTime := TimeGetExactTime;
end;

{=========================================================================}
function StopTimeMeasure(Scale: integer): string;
var
   CurTime: int64;
begin
   CurTime := TimeGetExactTime-OldTime;

   if (CurTime < TimeMin) then TimeMin := CurTime;
   if (CurTime > TimeMax) then TimeMax := CurTime;
   TimeAvg := TimeAvg+CurTime;

   if Scale < 1 then Scale := 1;

   Result := Format('Time:  Cur: %f  Min: %f  Max: %f  Avg: %f',[CurTime,
                                                                 TimeMin/Scale,
                                                                 TimeMax/Scale,
                                                                 (TimeAvg/TimeCount)/Scale]);
end;

var
   CycleCount: Longint;
   OldCycles,CyclesMin,CyclesMax,CyclesAvg: int64;

{=========================================================================}
procedure InitCyclesMeasure;
begin
   CycleCount := 0;
   CyclesMin  := MAXLONGINT;
   CyclesMax  := 0;
   CyclesAvg  := 0;
end;

{=========================================================================}
procedure StartCyclesMeasure;
begin
   inc(CycleCount);
   OldCycles := GetCPUCycles;
end;

{=========================================================================}
function StopCyclesMeasure(Scale: integer): string;
var
   CurCycles: int64;
begin
   CurCycles := GetCPUCycles-OldCycles;

   if (CurCycles < CyclesMin) then CurCycles := CyclesMin;
   if (CurCycles > CyclesMax) then CurCycles := CyclesMax;
   CyclesAvg := CyclesAvg+CurCycles;

   if Scale < 1 then Scale := 1;

   Result := Format('CPU-Cycles:  Min: %f Max: %f Avg: %f',[CyclesMin/Scale,