home *** CD-ROM | disk | FTP | other *** search
- //PROFILE-NO
- {$O-}
- {$D-}
- {$B-}
- {$Q-}
- {$I-}
- {$R-}
- {$X+}
-
- 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 );
- PROCEDURE SleepEx (zeit : DWORD; alertable : BOOL );
- 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;
-
- PROCEDURE SleepEx( zeit : DWORD; alertable : BOOL );
- BEGIN
- StopCounting;
- 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);
- END;
- FINALIZATION
- IF ProfMustBeUnInitialised = 1 THEN BEGIN
- ProfSetComment('At finishing application');
- ProfAppendResults(TRUE);
- ProfUnInitTimer;
- END;
- end.
-