mmutils.pas

一套及时通讯的原码

                                                            CyclesMax/Scale,
                                                            (CyclesAvg/CycleCount)/Scale]);
end;
{$ENDIF}

const
     Freq: Longint = 0;

{=========================================================================}
function TimeGetExactTime: int64;
{$IFDEF WIN32}
var
   {$IFDEF DELPHI4}
   CurTime: int64;
   {$ELSE}
   CurTime: MMLARGE_INTEGER;
   {$ENDIF}
{$ENDIF}

begin
   { returns system time in micro second }
{$IFDEF WIN32}
   if (Freq = 0) then
   begin
      QueryPerformanceFrequency(CurTime);           { determine timer frequency }
      {$IFDEF DELPHI4}
      if (Curtime shr 32 > 0) then
          Freq := 1                                 { timer is too fast }
      else
          Freq := CurTime and $FFFFFFFF;            { ticks per second }
      {$ELSE}
      if (Curtime.HighPart > 0) then
          Freq := 1                                 { timer is too fast }
      else
          Freq := CurTime.LowPart;                  { ticks per second }
      {$ENDIF}
   end;

   if (Freq > 1) then
   begin
      QueryPerformanceCounter(CurTime);
      {$IFDEF DELPHI4}
      Result := (1000000 * CurTime) div Freq;
      {$ELSE}
      Result := 1000000;
      Result := (Result * CurTime.QuadPart)/Freq;
      {$ENDIF}
   end
   else
{$ENDIF}
   begin
      { on Win16 we must return the time in a 1000 micro second raster }
      Result := 1000;
      Result := Result * TimeGetTime;
   end;
end;

{=========================================================================}
function HaveWin95: Boolean;
{$IFDEF WIN32}
var
   OS: TOSVERSIONINFO;
begin
   OS.dwOSVersionInfoSize := sizeOf(OS);
   GetVersionEx(OS);
   Result := (OS.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) and
             (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 0);
{$ELSE}
begin
   Result:=(GetVersion and $FF = 3)and((GetVersion shr 8)and $FF=95);
{$ENDIF}
end;

{=========================================================================}
function HaveWin98: Boolean;
{$IFDEF WIN32}
var
   OS: TOSVERSIONINFO;
begin
   OS.dwOSVersionInfoSize := sizeOf(OS);
   GetVersionEx(OS);
   Result := (OS.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) and
             (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 10);
{$ELSE}
begin
   Result:=(GetVersion and $FF = 3)and((GetVersion shr 8)and $FF=95);
{$ENDIF}
end;

{=========================================================================}
function HaveWinME: Boolean;
{$IFDEF WIN32}
var
   OS: TOSVERSIONINFO;
begin
   OS.dwOSVersionInfoSize := sizeOf(OS);
   GetVersionEx(OS);
   Result := (OS.dwPlatformID = VER_PLATFORM_WIN32_WINDOWS) and
             (OS.dwMajorVersion = 4) and (OS.dwMinorVersion = 90);
{$ELSE}
begin
   Result:=(GetVersion and $FF = 3)and((GetVersion shr 8)and $FF=95);
{$ENDIF}
end;

{=========================================================================}
function HaveWinNT: Boolean;
{$IFDEF WIN32}
var
   OS: TOSVERSIONINFO;
begin
   OS.dwOSVersionInfoSize := sizeOf(OS);
   GetVersionEx(OS);
   Result := (OS.dwPlatformID = VER_PLATFORM_WIN32_NT) and
             (OS.dwMajorVersion = 3);
{$ELSE}
begin
   Result := (GetWinFlags and $4000) <> 0;
{$ENDIF}
end;

{=========================================================================}
function HaveWinNT4: Boolean;
{$IFDEF WIN32}
var
   OS: TOSVERSIONINFO;
begin
   OS.dwOSVersionInfoSize := sizeOf(OS);
   GetVersionEx(OS);
   Result := (OS.dwPlatformID = VER_PLATFORM_WIN32_NT) and
             (OS.dwMajorVersion >= 4);
{$ELSE}
begin
   Result := (GetWinFlags and $4000) <> 0;
{$ENDIF}
end;

{=========================================================================}
function HaveWin2K: Boolean;
{$IFDEF WIN32}
var
   OS: TOSVERSIONINFO;
begin
   OS.dwOSVersionInfoSize := sizeOf(OS);
   GetVersionEx(OS);
   Result := (OS.dwPlatformID = VER_PLATFORM_WIN32_NT) and
             (OS.dwMajorVersion >= 5);
{$ELSE}
begin
   Result := (GetWinFlags and $4000) <> 0;
{$ENDIF}
end;

{=========================================================================}
function HaveWinXP: Boolean;
{$IFDEF WIN32}
var
   OS: TOSVERSIONINFO;
begin
   OS.dwOSVersionInfoSize := sizeOf(OS);
   GetVersionEx(OS);
   Result := (OS.dwPlatformID = VER_PLATFORM_WIN32_NT) and
             (OS.dwMajorVersion >= 5) and (OS.dwMinorVersion = 1);
{$ELSE}
begin
   Result := (GetWinFlags and $4000) <> 0;
{$ENDIF}
end;

{=========================================================================}
procedure Delay(ms: DWORD; ProcessMessages: Boolean);
Var
   Time: DWORD;
begin
  if ms > 0 then
  begin
{$IFDEF WIN32}
    if ProcessMessages then
    begin
      Time := GetTickCount;
      repeat
        case MsgWaitForMultipleObjects(0, nil^, True, Time - GetTickCount + ms, QS_ALLEVENTS) of
          WAIT_OBJECT_0:
          begin
            Application.ProcessMessages;
            if GetTickCount-Time >= ms then break;
          end;
          WAIT_TIMEOUT:
            break;
        end
      until csDestroying in Application.ComponentState
    end
    else Sleep(ms);
{$ELSE}
    Time := GetTickCount;
    repeat
      if ProcessMessages then Application.ProcessMessages;
    until GetTickCount-Time >= ms;
{$ENDIF}
  end;
end;

{=========================================================================}
function ClientToClient(Destination, Source: TControl; P: TPoint): TPoint;
begin
   Result := Destination.ScreenToClient(Source.ClientToScreen(P));
end;

{=========================================================================}
function NonClientHeight: integer;
begin
   { returns the full CaptionBar height }
   Result := GetSystemMetrics(SM_CYCAPTION)+2*GetSystemMetrics(SM_CYFRAME);
end;

{=========================================================================}
function MenuHeight: integer;
begin
   { returns the full Menu height }
   Result := GetSystemMetrics(SM_CYMENU	);
end;

{=========================================================================}
function BitsPerPixel: integer;
var
   DC: HDC;

begin
   { returns "Bits Per Pixel" for the actual display
     1     = 16 Color
     8     = 256 Color,
     15/16 = HiColor
     24/32 = TrueColor }

   DC := CreateDC('DISPLAY',nil,nil,nil);
   Result := GetDeviceCaps(DC,BITSPIXEL);
   DeleteDC(DC);
end;

{=========================================================================}
function CheckPath(Path: string; Flag: Boolean): String;
{Funktion pr黤t, ob letztes Zeichen in Pfadangabe ein '\' ist
 Flag:
        TRUE - '\' Zeichen erw黱scht
        FALSE - '\' Zeichen unerw黱scht}

begin
     if (Path <> '') then
     begin
        if (Flag = True) then
        begin
           if Path[Length(Path)] <> '\' then
              Path := Path + '\'
        end
        else
        begin
           if Path[Length(Path)] = '\' then
              Path := Copy(Path,1,Length(Path)-1);
        end;
     end;

     Result := Path;
end;

{=========================================================================}
function CheckFileName(S: String): string;
var
   i: integer;
   FName: string;
begin
   for i := 1 to Length(S) do
   begin
      if (S[i] in ['/','*','?','"','<','>','|',',']) or ((S[i] = ':') and (S[i+1] <> '\')) then
          S[i] := '_';
   end;
   FName := ChangeFileExt(ExtractFileName(S),'');
   for i := 1 to Length(FName) do
   begin
      if (FName[i] in ['\','.']) then
          FName[i] := '_';
   end;
   Result := CheckPath(ExtractFilePath(S),True)+FName+ExtractFileExt(S);
end;

{==============================================================================}
function int64shl32(V: int64; Shift: Byte): MMLarge_Integer;
var
   R: MMLarge_Integer;
begin
   asm
     {$IFDEF WIN32}
      mov   cl, Shift
      mov   eax, dword ptr V[0]
      mov   edx, dword ptr V[4]
      shld  edx, eax, cl
      shl   eax, cl
      mov   dword ptr R.HighPart, edx
      mov   dword ptr R.LowPart, eax

      {$ELSE}

      mov   cl, Shift

      db    66h
      mov   ax, word ptr V[0]

      db    66h
      mov   dx, word ptr V[4]

      db    66h      { shld  edx, eax, cl }
      db    0Fh
      db    0A5h
      db    0C2h

      db    66h
      shl   ax, cl

      db    66h
      mov   word ptr R.HighPart, dx

      db    66h
      mov   word ptr R.LowPart, ax
      {$ENDIF}
   end;
   Result := R;
end;

{$IFDEF WIN32}
{=========================================================================}
function GetTempFile: string;
var
   aBuf: array[0..MAX_PATH] of Char;
begin
   GetTempPath(sizeOf(aBuf)-1,aBuf);
   GetTempFileName(aBuf,'w'#0,Random(256)+1,aBuf);
   Result := StrPas(aBuf);
end;

{=========================================================================}
function CreateFullDir(Dir: string): Boolean;
var
   Drive,Path,S: string;
   idx: integer;

   function ExtractPathTotken(idx: integer; S: string): string;
   var
      x,p: integer;
   begin
      Result := '';
      x := -1;
      while (x < idx) do
      begin
         p := Pos('\',S);
         if (p <= 0) then
         begin
            Result := '';
            exit;
         end;
         Result := Result+Copy(S,1,p);
         Delete(S,1,p);
         inc(x);
      end;
   end;

begin
   Result := False;

   Dir := CheckPath(Dir,True);

   Drive := CheckPath(ExtractFileDrive(Dir),True);
   Path  := CheckPath(Copy(ExtractFilePath(Dir),Length(Drive)+1,Length(Dir)),True);

   if (Drive = '') or (Path = '') then exit;

   idx := 0;
   repeat
      S := ExtractPathTotken(idx,Path);
      if (S <> '') then
      begin
         if not DirectoryExists(Drive+S) then
         begin
            if not CreateDir(Drive+S) then
            begin
               Result := False;
               exit;
            end;
         end;
         inc(idx);
      end;
   until (S = '');

   Result := True;
end;

{=========================================================================}
procedure DeleteDir(Dir: string);
var
   Result: integer;
   SearchRec: TSearchRec;
begin
   Dir := CheckPath(Dir,True);
   Result := FindFirst(Dir+'*.*',faAnyFile,SearchRec);
   try
      while (Result = 0) do
      begin
         if (SearchRec.Name <> '.') and (SearchRec.Name <> '..') then
             DeleteFile(Dir+SearchRec.Name);
         Result := FindNext(SearchRec);
      end;
   finally
      FindClose(SearchRec);
   end;
   RemoveDir(Dir);
end;
{$ENDIF}

{=========================================================================}