home *** CD-ROM | disk | FTP | other *** search
- //PROFILE-NO
- {$O-}
- {$D-}
- {$B-}
- {$Q-}
- {$I-}
- {$R-}
- {$X+}
-
- unit Profint;
-
- interface
-
- USES
- Dialogs, Windows;
-
- TYPE
-
- {$IFDEF VER90 }
- TMyComp = Comp;
- {$ELSE }
- {$IFDEF VER100 }
- TMyComp = Comp;
- {$ELSE }
- TMyComp = Int64;
- {$ENDIF }
- {$ENDIF }
-
- TMyLargeInteger = RECORD
- CASE Byte OF
- 0 : ( LowPart : DWord; HighPart : LongInt );
- 1 : ( QuadPart : TMyComp );
- END;
- TPLargeInteger = ^TMyLargeInteger;
-
- {$IFDEF VER100} {$DEFINE PROFD3ORD4} {$ENDIF }
- {$IFDEF VER120} {$DEFINE PROFD3ORD4} {$ENDIF }
- {$IFDEF VER90} { Delphi 2 }
- TObjFunction = FUNCTION ( Text, Caption : PChar;
- Flags : Word ) : Integer OF Object;
- {$ELSE}
- {$IFDEF PROFD3ORD4} { Delphi 3 or 4 }
- TObjFunction = FUNCTION ( Text, Caption : PChar;
- Flags : Longint ) : Integer OF Object;
- {$ELSE } { Delphi 5 OR Better }
- TObjFunction = FUNCTION ( CONST Text, Caption : PChar;
- Flags : Longint ) : Integer OF Object;
- {$ENDIF}
- {$ENDIF}
-
- // 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 : String );
- {$IFNDEF VER90 }
- PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
- {$ENDIF}
- // If you need to compile the VCL, the next function must be deleted,
- // Sorry ! The USES statement for Dialogs has to be moved to the
- // Implementation part !!!
- function MessageDlg( const Msg : string; AType : TMsgDlgType;
- AButtons : TMsgDlgButtons; HelpCtx : Longint ) : Word;
-
- function MessageDlgPos( const Msg : string; DlgType : TMsgDlgType;
- Buttons : TMsgDlgButtons; HelpCtx: Longint;
- X, Y : Integer) : Word;
-
- {$IFNDEF VER90} { Delphi 2 }
- function MessageDlgPosHelp( const Msg : string; DlgType : TMsgDlgType;
- Buttons : TMsgDlgButtons; HelpCtx : Longint;
- X, Y : Integer; const HelpFileName : string)
- : Integer;
- {$ENDIF}
-
- // Delphi-TApplication-Functions that set process idle (handled in DLL)
- PROCEDURE ProcessMessages;
- PROCEDURE HandleMessage;
- {$IFDEF VER90 }
- FUNCTION AMessageBox( Text, Caption : PChar;
- Flags : Word ) : Integer;
- {$ELSE }
- FUNCTION AMessageBox( Text, Caption : PChar;
- Flags : Longint): Integer;
- {$ENDIF }
-
- // 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;
- {$IFNDEF VER90 }
- FUNCTION SignalObjectAndWait ( h1, h2 : THandle;
- ms : DWord;
- al : BOOL) : BOOL;
- {$ENDIF}
- 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;
- {$IFNDEF VER90 }
- FUNCTION MsgWaitForMultipleObjectsEx ( ct : DWORD;
- VAR pHandles;
- ms : DWORD;
- wm : DWORD;
- fl : DWORD ) : DWORD;
- {$ENDIF}
- 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
- Forms,
- 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;
-
- PROCEDURE ShowMessage ( CONST Msg : String );
- BEGIN
- StopCounting;
- Dialogs.ShowMessage(Msg);
- ContinueCounting;
- END;
-
- {$IFNDEF VER90 }
- PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
- BEGIN
- StopCounting;
- Dialogs.ShowMessageFmt(Msg, Params);
- ContinueCounting;
- END;
-
- FUNCTION AMessageBox( Text, Caption : PChar;
- Flags : LongInt ) : Integer;
- BEGIN
- StopCounting;
- Result := Application.MessageBox(Text, Caption,Flags);
- ContinueCounting;
- END;
-
- {$ELSE }
-
- FUNCTION AMessageBox( Text, Caption : PChar;
- Flags : Word ) : Integer;
- BEGIN
- StopCounting;
- Result := Application.MessageBox(Text, Caption,Flags);
- ContinueCounting;
- END;
- {$ENDIF }
-
- FUNCTION MessageDlg( const Msg : string; AType : TMsgDlgType;
- AButtons : TMsgDlgButtons; HelpCtx : Longint ) : Word;
- BEGIN
- StopCounting;
- Result := Dialogs.MessageDlg(Msg, AType, AButtons, HelpCtx);
- ContinueCounting;
- END;
-
- FUNCTION MessageDlgPos( const Msg : string; DlgType : TMsgDlgType;
- Buttons : TMsgDlgButtons; HelpCtx: Longint;
- X, Y : Integer) : Word;
- BEGIN
- StopCounting;
- Result := Dialogs.MessageDlgPos(Msg, DlgType, Buttons, HelpCtx, X, Y);
- ContinueCounting;
- END;
-
- {$IFNDEF VER90} { Delphi 2 }
- function MessageDlgPosHelp( const Msg : string; DlgType : TMsgDlgType;
- Buttons : TMsgDlgButtons; HelpCtx : Longint;
- X, Y : Integer; const HelpFileName : string)
- : Integer;
- BEGIN
- StopCounting;
- Result := Dialogs.MessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx,
- X, Y, HelpFileName);
- ContinueCounting;
- END;
- {$ENDIF }
-
- 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;
- {$IFNDEF VER90 }
- FUNCTION SignalObjectAndWait ( h1, h2 : THandle;
- ms : DWord;
- al : BOOL) : BOOL;
- BEGIN
- StopCounting;
- Result := Windows.SignalObjectAndWait(h1, h2, ms, al);
- ContinueCounting;
- END;
- {$ENDIF }
-
- 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;
-
- {$IFNDEF VER90 }
- 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;
- {$ENDIF}
- 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 VER90 }
- ProfSetDelphiVersion( 2 );
- {$ELSE }
- {$IFDEF VER100 }
- ProfSetDelphiVersion( 3 );
- {$ELSE }
- {$IFDEF VER120 }
- ProfSetDelphiVersion( 4 );
- {$ELSE }
- {$IFDEF VER130 }
- ProfSetDelphiVersion( 5 );
- {$ELSE }
- {$IFDEF VER140 }
- ProfSetDelphiVersion( 6 );
- {$ELSE }
- {$IFDEF VER150 }
- ProfSetDelphiVersion( 7 );
- {$ELSE }
- ProfSetDelphiVersion( 8 );
- {$ENDIF }
- {$ENDIF }
- {$ENDIF }
- {$ENDIF }
- {$ENDIF }
- {$ENDIF }
- CalcQPCTime802;
- END;
- ProfGlobalInit2(0);
- END;
- FINALIZATION
- IF ProfMustBeUnInitialised = 1 THEN BEGIN
- ProfSetComment('At finishing application');
- ProfAppendResults(TRUE);
- ProfUnInitTimer;
- END;
- end.
-