//PROFILE-NO
{$O-}
{$D-}
{$B-}
{$Q-}
{$I-}
{$R-}
{$X+}
{$WARNINGS OFF}

unit Profintc;

interface

USES
  QForms,
  QDialogs, Windows, QGraphics, Types;

TYPE
  TMyComp  = Int64;

  TMyLargeInteger = RECORD
                    CASE Byte OF
                     0 : ( LowPart  : DWord; HighPart : LongInt );
                     1 : ( QuadPart : TMyComp );
                  END;
  TPLargeInteger = ^TMyLargeInteger;

  TObjFunction = FUNCTION ( CONST Text, Caption : PChar;
                            Flags : Longint ) : Integer OF Object;

// Profiler-Measurement-Functions
PROCEDURE ProfStop  ( l : DWord; h : Integer);    external 'PROFMEAS.DLL';
FUNCTION  ProfEnter ( mptr : Pointer; prozNr : Integer ) : TPLargeInteger; external 'PROFMEAS.DLL';
FUNCTION  ProfExit  ( lc   : DWord;   hc : Integer; prozNr : Integer ) : TPLargeInteger; external 'PROFMEAS.DLL';
PROCEDURE ProfActivate;     external 'PROFMEAS.DLL';
PROCEDURE ProfDeActivate;   external 'PROFMEAS.DLL';
PROCEDURE ProfSetComment  ( comm   : PChar );     external 'PROFMEAS.DLL';
PROCEDURE ProfAppendResults ( progEnd : Boolean );external 'PROFMEAS.DLL';

// Post-Mortem-Review-Functions
PROCEDURE PomoEnter       ( prozNr : SmallInt );  external 'PROFMEAS.DLL';
PROCEDURE PomoExceStr     ( name   : pChar    );  external 'PROFMEAS.DLL';
PROCEDURE PomoExce;
PROCEDURE PomoExit        ( prozNr : SmallInt );  external 'PROFMEAS.DLL';

// Functions to interrupt and continue measurement for calls which could set the
//  Process idle. Use these calls to implement own Non-measured Calls. If METHODS
//  can set a process idle, the only possibility is, to put these calls into your
//  sources (included by an IFDEF-statement).
//  USE 2 or more spaces between IFDEF and PROFILE, otherwise it will be deleted
//  by the ProDelphi. Example:
//  {$IFDEF     PROFILE } StopCounting;     {$ENDIF }
//    ObjectReference.MethodThatMightSetProcessIdle;
//  {$IFDEF     PROFILE } ContinueCounting; {$ENDIF }

// Normal procedures that set the process idle can be handled like the Sleep-
//  function in this unit.
PROCEDURE StopCounting;                           external 'PROFMEAS.DLL';
PROCEDURE ContinueCounting;                       external 'PROFMEAS.DLL';

// Delphi-Functions that set process idle
procedure ShowMessage(const Msg : AnsiString); overload;

procedure ShowMessage(const Msg : ShortString); overload;

procedure ShowMessage(const Msg : AnsiString; Params : array of const); overload;

procedure ShowMessage(const Msg : ShortString; Params : array of const); overload;

PROCEDURE ShowMessageFmt(const Msg : WideString; Params : array of const );
          // If you need to compile the CLX-Lib, the next functions must be deleted,
          // Sorry ! The USES statement for QDialogs has to be moved to the
          // Implementation part !!!

procedure ShowMessagePos(const Msg : WideString; X, Y : Integer);

// CLX-Functions
function MessageDlg(const Msg        : AnsiString;     DlgType : TMsgDlgType;
                          Buttons    : TMsgDlgButtons; HelpCtx : Longint;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = NIL) : Integer; overload;

function MessageDlg(const Msg        : ShortString;     DlgType : TMsgDlgType;
                          Buttons    : TMsgDlgButtons; HelpCtx : Longint;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = NIL) : Integer; overload;

function MessageDlg(const Caption    : AnsiString;   const Msg  : AnsiString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer; overload;

function MessageDlg(const Caption    : ShortString;   const Msg  : ShortString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer; overload;

function MessageDlg(const Caption    : AnsiString;   const Msg  : AnsiString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      X, Y       : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer; overload;

function MessageDlg(const Caption    : ShortString;   const Msg  : ShortString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      X, Y       : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer; overload;

function MessageDlg(const Caption    : AnsiString;   const Msg  : AnsiString;
                          DlgType    : TMsgDlgType;
                          Button1, Button2, Button3   : TMsgDlgBtn;
                          HelpCtx    : Longint;      X, Y       : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer; overload;

function MessageDlg(const Caption    : ShortString;   const Msg  : ShortString;
                          DlgType    : TMsgDlgType;
                          Button1, Button2, Button3   : TMsgDlgBtn;
                          HelpCtx    : Longint;      X, Y       : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer; overload;

function MessageDlgPos(const Msg         : WideString;     DlgType    : TMsgDlgType;
                             Buttons     : TMsgDlgButtons; HelpCtx    : Longint;
                             X, Y        : Integer;
                             DefaultBtn  : TMsgDlgBtn = mbNone;
                             Bitmap      : TBitmap = nil) : Integer;

//
// Delphi-TApplication-Functions that set process idle (handled in DLL)
PROCEDURE ProcessMessages;
PROCEDURE HandleMessage;

FUNCTION  AMessageBox ( CONST Text : WideString; Caption : WideString = '';
                        Buttons : TMessageButtons = [smbOK];
                        Style   : TMessageStyle   = smsInformation;
                        Default : TMessageButton  = smbOK;
                        Escape  : TMessageButton  = smbCancel) : TMessageButton;


// Windows-Functions that set process idle
FUNCTION  DispatchMessage(CONST lpMsg  : TMsg) : Longint;
FUNCTION  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
                     hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
                             hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
FUNCTION  MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
FUNCTION  MessageBoxEx( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
FUNCTION  SignalObjectAndWait ( h1, h2 : THandle;
                                ms     : DWord;
                                al     : BOOL) : BOOL;
FUNCTION  WaitForSingleObject ( h1     : THandle;
                                MS     : DWORD ) : DWORD;
FUNCTION  WaitForSingleObjectEx ( h1   : THandle;
                                  MS   : DWORD;
                                  al   : BOOL ) : DWORD;

FUNCTION  WaitForMultipleObjects ( ct  : DWORD;
                                   CONST pH : PWOHandleArray;
                                   wait     : BOOL;
                                   ms       : DWORD ) : DWORD;
FUNCTION  WaitForMultipleObjectsEx ( ct  : DWORD;
                                     CONST pH : PWOHandleArray;
                                     wait     : BOOL;
                                     ms       : DWORD;
                                     al       : Boolean) : DWORD;
FUNCTION  MsgWaitForMultipleObjects ( ct      : DWORD;
                                      VAR pHandles;
                                      wait    : BOOL;
                                      ms      : DWORD;
                                      wm      : DWORD ) : DWORD;
FUNCTION  MsgWaitForMultipleObjectsEx ( ct     : DWORD;
                                        VAR pHandles;
                                        ms     : DWORD;
                                        wm     : DWORD;
                                        fl     : DWORD ) : DWORD;
PROCEDURE Sleep   (zeit : DWORD );
FUNCTION  SleepEx( zeit : DWORD; alertable : BOOL ) : DWORD;
FUNCTION  WaitCommEvent ( hd  : THandle; VAR em : DWORD;
                          lpo : POverlapped ) : BOOL;
FUNCTION  WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
FUNCTION  WaitMessage : BOOL;
FUNCTION  WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;

IMPLEMENTATION
USES
  SysUtils;

TYPE
  TObjProzedur = PROCEDURE OF Object;

// Profiler-Internal-Functions, DO NOT USE
FUNCTION  ProfGlobalInit1 : Boolean;              external 'PROFMEAS.DLL';
PROCEDURE ProfGlobalInit2 ( j : Integer );        external 'PROFMEAS.DLL';
PROCEDURE ProfUnInitTimer;                        external 'PROFMEAS.DLL';
FUNCTION  ProfIsInitialised : Integer;            external 'PROFMEAS.DLL';
FUNCTION  ProfMustBeUnInitialised : Integer;      external 'PROFMEAS.DLL';

// Calibration - Function - DO NOT USE
PROCEDURE CalcQPCTime802; external 'PROFCALI.DLL';
PROCEDURE ProfSetDelphiVersion ( vers : Integer ); external 'PROFCALI.DLL';

// Check if CPU is intel-Compatible
PROCEDURE PruefeKompatibilitaet;
VAR
  tsh, tsl : DWORD;
BEGIN
  Try
    asm
      DW 310FH;
      mov tsh,edx
      mov tsl,eax
    end;
  Except
    Windows.MessageBox(0, 'This CPU is not Intel-Compatible', 'ProDelphi - ERROR', MB_OK);
    halt(0);
  End;
END;

FUNCTION  AMessageBox ( CONST Text : WideString; Caption : WideString = '';
                        Buttons : TMessageButtons = [smbOK];
                        Style   : TMessageStyle   = smsInformation;
                        Default : TMessageButton  = smbOK;
                        Escape  : TMessageButton  = smbCancel) : TMessageButton;
BEGIN
  StopCounting;
  Result := Application.MessageBox(Text,Caption,Buttons,Style,Default,Escape);
  ContinueCounting;
END;

procedure ShowMessage(const Msg : AnsiString);
BEGIN
  StopCounting;
  QDialogs.ShowMessage(Msg);
  ContinueCounting;
END;

procedure ShowMessage(const Msg : ShortString);
BEGIN
  StopCounting;
  QDialogs.ShowMessage(Msg);
  ContinueCounting;
END;

procedure ShowMessage(const Msg : AnsiString; Params : array of const);
BEGIN
  StopCounting;
  QDialogs.ShowMessage(Msg, Params);
  ContinueCounting;
END;

procedure ShowMessage(const Msg : ShortString; Params : array of const);
BEGIN
  StopCounting;
  QDialogs.ShowMessage(Msg, Params);
  ContinueCounting;
END;

procedure ShowMessagePos(const Msg : WideString; X, Y : Integer);
BEGIN
  StopCounting;
  QDialogs.ShowMessagePos(Msg, X, Y);
  ContinueCounting;
END;

PROCEDURE ShowMessageFmt(const Msg : WideString; Params : array of const );
BEGIN
  StopCounting;
  QDialogs.ShowMessageFmt(Msg, Params);
  ContinueCounting;
END;

function MessageDlg(const Msg        : AnsiString;     DlgType : TMsgDlgType;
                          Buttons    : TMsgDlgButtons; HelpCtx : Longint;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Msg, DlgType, Buttons, HelpCtx, DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlg(const Msg        : ShortString;     DlgType : TMsgDlgType;
                          Buttons    : TMsgDlgButtons; HelpCtx : Longint;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Msg, DlgType, Buttons, HelpCtx, DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlg(const Caption    : AnsiString;   const Msg  : AnsiString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Caption, Msg, DlgType, Buttons, HelpCtx,
                                DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlg(const Caption    : ShortString;   const Msg  : ShortString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Caption, Msg, DlgType, Buttons, HelpCtx,
                                DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlg(const Caption    : AnsiString;   const Msg  : AnsiString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      X, Y       : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Caption, Msg, DlgType, Buttons, HelpCtx, X, Y,
                                DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlg(const Caption    : ShortString;   const Msg  : ShortString;
                          DlgType    : TMsgDlgType;  Buttons    : TMsgDlgButtons;
                          HelpCtx    : Longint;      X, Y       : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Caption, Msg, DlgType, Buttons, HelpCtx, X, Y,
                                DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlg(const Caption    : AnsiString;    const Msg : AnsiString;
                          DlgType    : TMsgDlgType;
                          Button1, Button2, Button3             : TMsgDlgBtn;
                          HelpCtx    : Longint;       X, Y      : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Caption, Msg, DlgType,
                                Button1, Button2, Button3, HelpCtx, X, Y,
                                DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlg(const Caption    : ShortString;    const Msg : ShortString;
                          DlgType    : TMsgDlgType;
                          Button1, Button2, Button3             : TMsgDlgBtn;
                          HelpCtx    : Longint;       X, Y      : Integer;
                          DefaultBtn : TMsgDlgBtn = mbNone;
                          Bitmap     : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlg(Caption, Msg, DlgType,
                                Button1, Button2, Button3, HelpCtx, X, Y,
                                DefaultBtn, Bitmap);
  ContinueCounting;
END;

function MessageDlgPos(const Msg         : WideString;     DlgType    : TMsgDlgType;
                             Buttons     : TMsgDlgButtons; HelpCtx    : Longint;
                             X, Y        : Integer;
                             DefaultBtn  : TMsgDlgBtn = mbNone;
                             Bitmap      : TBitmap = nil) : Integer;
BEGIN
  StopCounting;
  Result := QDialogs.MessageDlgPos(Msg, DlgType, Buttons, HelpCtx, X, Y, DefaultBtn, Bitmap);
  ContinueCounting;
END;

FUNCTION  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
                     hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
BEGIN
  StopCounting;
  Result := Windows.DialogBox(hInstance, lpTemplate, hWndParent, lpDialogFunc);
  ContinueCounting;
END;

FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
                             hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
BEGIN
  StopCounting;
  Result := Windows.DialogBoxIndirect(hInstance, lpDialogTemplate, hWndParent, lpDialogFunc);
  ContinueCounting;
END;

FUNCTION MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
BEGIN
  StopCounting;
  Result := Windows.MessageBox(hWnd, lpText, lpCaption, uType);
  ContinueCounting;
END;

FUNCTION MessageBoxEx ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
BEGIN
  StopCounting;
  Result := Windows.MessageBoxEx(hWnd, lpText, lpCaption, uType, lang);
  ContinueCounting;
END;

FUNCTION DispatchMessage( CONST lpMsg: TMsg ) : Longint;
BEGIN
  StopCounting;
  Result := Windows.DispatchMessage(lpMsg);
  ContinueCounting;
END;

PROCEDURE HandleMessage;
BEGIN
  StopCounting;
  Application.HandleMessage;
  ContinueCounting;
END;

PROCEDURE ProcessMessages;
BEGIN
  StopCounting;
  Application.ProcessMessages;
  ContinueCounting;
END;

PROCEDURE Sleep( zeit : DWORD );
BEGIN
  StopCounting;
  Windows.Sleep(zeit);
  ContinueCounting;
END;

FUNCTION SleepEx( zeit : DWORD; alertable : BOOL ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.SleepEx(zeit, alertable);
  ContinueCounting;
END;

FUNCTION SignalObjectAndWait ( h1, h2 : THandle;
                               ms     : DWord;
                               al     : BOOL) : BOOL;
BEGIN
  StopCounting;
  Result := Windows.SignalObjectAndWait(h1, h2, ms, al);
  ContinueCounting;
END;

FUNCTION WaitForSingleObject ( h1     : THandle;
                               MS     : DWORD ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.WaitForSingleObject ( h1, MS );
  ContinueCounting;
END;

FUNCTION WaitForSingleObjectEx ( h1   : THandle;
                                 MS   : DWORD;
                                 al   : BOOL ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.WaitForSingleObjectEx (h1, MS, al);
  ContinueCounting;
END;

FUNCTION WaitForMultipleObjects ( ct  : DWORD;
                                  CONST pH : PWOHandleArray;
                                  wait     : BOOL;
                                  ms       : DWORD ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.WaitForMultipleObjects(ct, pH, wait, ms);
  ContinueCounting;
END;

FUNCTION WaitForMultipleObjectsEx ( ct  : DWORD;
                                    CONST pH : PWOHandleArray;
                                    wait     : BOOL;
                                    ms       : DWORD;
                                    al       : Boolean ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.WaitForMultipleObjectsEx(ct, pH, wait, ms, al);
  ContinueCounting;
END;

FUNCTION MsgWaitForMultipleObjects ( ct     : DWORD;
                                     VAR pHandles;
                                     wait   : BOOL;
                                     ms     : DWORD;
                                     wm     : DWORD ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.MsgWaitForMultipleObjects(ct, pHandles, wait, ms, wm);
  ContinueCounting;
END;

FUNCTION MsgWaitForMultipleObjectsEx ( ct     : DWORD;
                                       VAR pHandles;
                                       ms     : DWORD;
                                       wm     : DWORD;
                                       fl     : DWORD ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.MsgWaitForMultipleObjectsEx(ct, pHandles, ms, wm, fl);
  ContinueCounting;
END;

FUNCTION WaitCommEvent ( hd : THandle; VAR em : DWORD; lpo : POverlapped ) : BOOL;
BEGIN
  StopCounting;
  Result := Windows.WaitCommEvent(hd, em, lpo);
  ContinueCounting;
END;

FUNCTION WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
BEGIN
  StopCounting;
  Result := Windows.WaitForInputIdle(hp, ms);
  ContinueCounting;
END;

FUNCTION WaitMessage : BOOL;
BEGIN
  StopCounting;
  Result := Windows.WaitMessage;
  ContinueCounting;
END;

FUNCTION WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;
BEGIN
  StopCounting;
  Result := Windows.WaitNamedPipe(np, ms);
  ContinueCounting;
END;

PROCEDURE PomoExce;
VAR
  exname : Array[0..100] OF Char;
  ExOb   : TObject;
BEGIN
  exname[0] := Char(0);
  ExOb := ExceptObject;
  IF Assigned(ExOb) THEN BEGIN
    IF ExceptObject IS Exception THEN
      StrPLCopy(exname, Exception(ExceptObject).Message, SizeOf(exname));
  END;
  PomoExceStr(exname);
END;

INITIALIZATION
  IF ProfIsInitialised = 1 THEN BEGIN
    PruefeKompatibilitaet;
    IF ProfGlobalInit1 = TRUE THEN BEGIN
{$IFDEF VER140 }
      ProfSetDelphiVersion( 6 );
{$ELSE }
   {$IFDEF VER150 }
        ProfSetDelphiVersion( 7 );
   {$ELSE }
        ProfSetDelphiVersion( 8 );
   {$ENDIF }
{$ENDIF }
      CalcQPCTime802;
    END;
    ProfGlobalInit2(0);
    ProfSetComment('None');
  END;
FINALIZATION
  IF ProfMustBeUnInitialised = 1 THEN BEGIN
    ProfSetComment('At finishing application');
    ProfAppendResults(TRUE);
    ProfUnInitTimer;
  END;
end.

