home *** CD-ROM | disk | FTP | other *** search
/ CD Actual 45 / cda45.iso / Share / Progra / ProDelphi76 / PROFINT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2000-03-25  |  13.0 KB  |  401 lines
  1. //PROFILE-NO
  2. {$O-}
  3. {$D-}
  4. {$B-}
  5. {$Q-}
  6. {$I-}
  7. {$R-}
  8. {$X+}
  9.  
  10. unit ProfInt;
  11.  
  12. interface
  13.  
  14. USES
  15.   Dialogs, Windows;
  16.  
  17. TYPE
  18.  
  19. {$IFDEF VER120 }
  20.   TMyComp  = Int64;
  21. {$ELSE }
  22.   {$IFDEF VER130 }
  23.     TMyComp  = Int64;
  24.   {$ELSE }
  25.     TMyComp  = Comp;
  26.   {$ENDIF }
  27. {$ENDIF }
  28.  
  29.   TMyLargeInteger = RECORD
  30.                     CASE Byte OF
  31.                      0 : ( LowPart  : DWORD; HighPart : LongInt );
  32.                      1 : ( QuadPart : TMyComp );
  33.                   END;
  34.   TPLargeInteger = ^TMyLargeInteger;
  35.  
  36. {$IFNDEF VER90}
  37.   {$IFDEF VER130}
  38.     TObjFunction = FUNCTION ( CONST Text, Caption : PChar;
  39.                               Flags : Longint ) : Integer OF Object;
  40.   {$ELSE }
  41.     TObjFunction = FUNCTION ( Text, Caption : PChar;
  42.                               Flags : Longint ) : Integer OF Object;
  43.   {$ENDIF }
  44. {$ELSE}
  45.   TObjFunction = FUNCTION ( Text, Caption : PChar;
  46.                             Flags : Word ) : Integer OF Object;
  47. {$ENDIF}
  48.  
  49. // Profiler-Measurement-Functions
  50. PROCEDURE ProfStop  ( l : DWord; h : Integer);    external 'PROFMEAS.DLL';
  51. FUNCTION  ProfEnter ( mptr : Pointer; prozNr : Integer ) : TPLargeInteger; external 'PROFMEAS.DLL';
  52. FUNCTION  ProfExit  ( lc   : DWORD;   hc : Integer; prozNr : Integer ) : TPLargeInteger; external 'PROFMEAS.DLL';
  53. PROCEDURE ProfActivate;     external 'PROFMEAS.DLL';
  54. PROCEDURE ProfDeActivate;   external 'PROFMEAS.DLL';
  55. PROCEDURE ProfSetComment  ( comm   : PChar );     external 'PROFMEAS.DLL';
  56. PROCEDURE ProfAppendResults ( progEnd : Boolean );external 'PROFMEAS.DLL';
  57.  
  58. // Post-Mortem-Review-Functions
  59. PROCEDURE PomoEnter       ( prozNr : SmallInt );  external 'PROFMEAS.DLL';
  60. PROCEDURE PomoExce;                               external 'PROFMEAS.DLL';
  61. PROCEDURE PomoExit        ( prozNr : SmallInt );  external 'PROFMEAS.DLL';
  62.  
  63. // Functions to interrupt and continue measurement for calls which could set the
  64. //  Process idle. Use these calls to implement own Non-measured Calls. If METHODS
  65. //  can set a process idle, the only possibility is, to put these calls into your
  66. //  sources (included by an IFDEF-statement).
  67. //  USE 2 or more spaces between IFDEF and PROFILE, otherwise it will be deleted
  68. //  by the ProDelphi. Example:
  69. //  {$IFDEF     PROFILE } StopCounting;     {$ENDIF }
  70. //    ObjectReference.MethodThatMightSetProcessIdle;
  71. //  {$IFDEF     PROFILE } ContinueCounting; {$ENDIF }
  72.  
  73. // Normal procedures that set the process idle can be handled like the Sleep-
  74. //  function in this unit.
  75. PROCEDURE StopCounting;                           external 'PROFMEAS.DLL';
  76. PROCEDURE ContinueCounting;                       external 'PROFMEAS.DLL';
  77.  
  78. // Delphi-Functions that set process idle
  79. PROCEDURE ShowMessage ( CONST Msg  : String );
  80. {$IFNDEF VER90 }
  81. PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
  82. {$ENDIF}
  83.           // If you need to compile the VCL, the next function must be deleted,
  84.           // Sorry ! The USES statement for Dialogs has to be moved to the
  85.           // Implementation part !!!
  86. function  MessageDlg( const Msg : string;         AType   : TMsgDlgType;
  87.                       AButtons  : TMsgDlgButtons; HelpCtx : Longint ) : Word;
  88.  
  89. // Delphi-TApplication-Functions that set process idle (handled in DLL)
  90. PROCEDURE ProcessMessages;                        external 'PROFMEAS.DLL';
  91. PROCEDURE HandleMessage;                          external 'PROFMEAS.DLL';
  92. {$IFDEF VER90 }
  93. FUNCTION  AMessageBox( Text, Caption  : PChar;
  94.                        Flags : Word ) : Integer;
  95. {$ELSE }
  96. FUNCTION  AMessageBox( Text, Caption   : PChar;
  97.                        Flags : Longint): Integer;
  98. {$ENDIF }
  99.  
  100. // Windows-Functions that set process idle
  101. FUNCTION  DispatchMessage(CONST lpMsg  : TMsg) : Longint;
  102. FUNCTION  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
  103.                      hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
  104. FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
  105.                              hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
  106. FUNCTION  MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
  107. FUNCTION  MessageBoxEx( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
  108. {$IFNDEF VER90 }
  109. FUNCTION  SignalObjectAndWait ( h1, h2 : THandle;
  110.                                 ms     : DWord;
  111.                                 al     : BOOL) : BOOL;
  112. {$ENDIF}
  113. FUNCTION  WaitForSingleObject ( h1     : THandle;
  114.                                 MS     : DWORD ) : DWORD;
  115. FUNCTION  WaitForSingleObjectEx ( h1   : THandle;
  116.                                   MS   : DWORD;
  117.                                   al   : BOOL ) : DWORD;
  118.  
  119. FUNCTION  WaitForMultipleObjects ( ct  : DWORD;
  120.                                    CONST pH : PWOHandleArray;
  121.                                    wait     : BOOL;
  122.                                    ms       : DWORD ) : DWORD;
  123. FUNCTION  WaitForMultipleObjectsEx ( ct  : DWORD;
  124.                                      CONST pH : PWOHandleArray;
  125.                                      wait     : BOOL;
  126.                                      ms       : DWORD;
  127.                                      al       : Boolean) : DWORD;
  128. FUNCTION  MsgWaitForMultipleObjects ( ct      : DWORD;
  129.                                       VAR pHandles;
  130.                                       wait    : BOOL;
  131.                                       ms      : DWORD;
  132.                                       wm      : DWORD ) : DWORD;
  133. {$IFNDEF VER90 }
  134. FUNCTION  MsgWaitForMultipleObjectsEx ( ct     : DWORD;
  135.                                         VAR pHandles;
  136.                                         ms     : DWORD;
  137.                                         wm     : DWORD;
  138.                                         fl     : DWORD ) : DWORD;
  139. {$ENDIF}
  140. PROCEDURE Sleep   (zeit : DWORD );
  141. PROCEDURE SleepEx (zeit : DWORD; alertable : BOOL );
  142. FUNCTION  WaitCommEvent ( hd  : THandle; VAR em : DWORD;
  143.                           lpo : POverlapped ) : BOOL;
  144. FUNCTION  WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
  145. FUNCTION  WaitMessage : BOOL;
  146. FUNCTION  WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;
  147. // Registration-Functions (internal Use only)
  148. PROCEDURE RegisterMessageBox( MBProc : TObjFunction );
  149.  
  150. IMPLEMENTATION
  151.  
  152. // Profiler-Internal-Functions, DO NOT USE
  153. FUNCTION  ProfGlobalInit1 : Boolean;              external 'PROFMEAS.DLL';
  154. PROCEDURE ProfGlobalInit2 ( j : Integer );        external 'PROFMEAS.DLL';
  155. PROCEDURE ProfUnInitTimer;                        external 'PROFMEAS.DLL';
  156. FUNCTION  ProfIsInitialised : Integer;            external 'PROFMEAS.DLL';
  157. FUNCTION  ProfMustBeUnInitialised : Integer;      external 'PROFMEAS.DLL';
  158.  
  159. // Calibration - Function - DO NOT USE
  160. PROCEDURE CalcQPCTime74; external 'PROFCALI.DLL';
  161.  
  162. VAR
  163.   MessBox : TObjFunction;
  164.  
  165. // Check if CPU is intel-Compatible
  166. PROCEDURE PruefeKompatibilitaet;
  167. VAR
  168.   tsh, tsl : DWORD;
  169. BEGIN
  170.   Try
  171.     asm
  172.       DW 310FH;
  173.       mov tsh,edx
  174.       mov tsl,eax
  175.     end;
  176.   Except
  177.     Windows.MessageBox(0, 'This CPU is not Intel-Compatible', 'ProDelphi - ERROR', MB_OK);
  178.     halt(0);
  179.   End;
  180. END;
  181.  
  182. PROCEDURE ShowMessage ( CONST Msg  : String );
  183. BEGIN
  184.   StopCounting;
  185.   Dialogs.ShowMessage(Msg);
  186.   ContinueCounting;
  187. END;
  188.  
  189. PROCEDURE RegisterMessageBox( MBProc : TObjFunction );
  190. BEGIN
  191.   MessBox := MBProc;
  192. END;
  193.  
  194. {$IFNDEF VER90 }
  195. PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
  196. BEGIN
  197.   StopCounting;
  198.   Dialogs.ShowMessageFmt(Msg, Params);
  199.   ContinueCounting;
  200. END;
  201.  
  202. FUNCTION AMessageBox( Text, Caption     : PChar;
  203.                       Flags : LongInt ) : Integer;
  204. BEGIN
  205.   StopCounting;
  206.   IF Assigned(MessBox) THEN
  207.     Result := MessBox(Text, Caption, Flags)
  208.   ELSE BEGIN
  209.     Result := Windows.MessageBox(0, Text, Caption, Flags);
  210.   END;
  211.   ContinueCounting;
  212. END;
  213.  
  214. {$ELSE }
  215.  
  216. FUNCTION AMessageBox( Text, Caption    : PChar;
  217.                       Flags : Word  )  : Integer;
  218. BEGIN
  219.   StopCounting;
  220.   IF Assigned(MessBox) THEN
  221.     Result := MessBox(Text, Caption, Flags)
  222.   ELSE BEGIN
  223.     Result := Windows.MessageBox(0, Text, Caption, Flags);
  224.   END;
  225.   ContinueCounting;
  226. END;
  227. {$ENDIF }
  228.  
  229. FUNCTION MessageDlg( const Msg : string;         AType   : TMsgDlgType;
  230.                      AButtons  : TMsgDlgButtons; HelpCtx : Longint ) : Word;
  231. BEGIN
  232.   StopCounting;
  233.   Result := Dialogs.MessageDlg(Msg, AType, AButtons, HelpCtx);
  234.   ContinueCounting;
  235. END;
  236.  
  237. FUNCTION  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
  238.                      hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
  239. BEGIN
  240.   StopCounting;
  241.   Result := Windows.DialogBox(hInstance, lpTemplate, hWndParent, lpDialogFunc);
  242.   ContinueCounting;
  243. END;
  244.  
  245. FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
  246.                              hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
  247. BEGIN
  248.   StopCounting;
  249.   Result := Windows.DialogBoxIndirect(hInstance, lpDialogTemplate, hWndParent, lpDialogFunc);
  250.   ContinueCounting;
  251. END;
  252.  
  253. FUNCTION MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
  254. BEGIN
  255.   StopCounting;
  256.   Result := Windows.MessageBox(hWnd, lpText, lpCaption, uType);
  257.   ContinueCounting;
  258. END;
  259.  
  260. FUNCTION MessageBoxEx ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
  261. BEGIN
  262.   StopCounting;
  263.   Result := Windows.MessageBoxEx(hWnd, lpText, lpCaption, uType, lang);
  264.   ContinueCounting;
  265. END;
  266.  
  267. FUNCTION DispatchMessage( CONST lpMsg: TMsg ) : Longint;
  268. BEGIN
  269.   StopCounting;
  270.   Result := Windows.DispatchMessage(lpMsg);
  271.   ContinueCounting;
  272. END;
  273.  
  274. PROCEDURE Sleep( zeit : DWORD );
  275. BEGIN
  276.   StopCounting;
  277.   Windows.Sleep(zeit);
  278.   ContinueCounting;
  279. END;
  280.  
  281. PROCEDURE SleepEx( zeit : DWORD; alertable : BOOL );
  282. BEGIN
  283.   StopCounting;
  284.   Windows.SleepEx(zeit, alertable);
  285.   ContinueCounting;
  286. END;
  287. {$IFNDEF VER90 }
  288. FUNCTION SignalObjectAndWait ( h1, h2 : THandle;
  289.                                ms     : DWord;
  290.                                al     : BOOL) : BOOL;
  291. BEGIN
  292.   StopCounting;
  293.   Result := Windows.SignalObjectAndWait(h1, h2, ms, al);
  294.   ContinueCounting;
  295. END;
  296. {$ENDIF }
  297.  
  298. FUNCTION WaitForSingleObject ( h1     : THandle;
  299.                                MS     : DWORD ) : DWORD;
  300. BEGIN
  301.   StopCounting;
  302.   Result := Windows.WaitForSingleObject ( h1, MS );
  303.   ContinueCounting;
  304. END;
  305.  
  306. FUNCTION WaitForSingleObjectEx ( h1   : THandle;
  307.                                  MS   : DWORD;
  308.                                  al   : BOOL ) : DWORD;
  309. BEGIN
  310.   StopCounting;
  311.   Result := Windows.WaitForSingleObjectEx (h1, MS, al);
  312.   ContinueCounting;
  313. END;
  314.  
  315. FUNCTION WaitForMultipleObjects ( ct  : DWORD;
  316.                                   CONST pH : PWOHandleArray;
  317.                                   wait     : BOOL;
  318.                                   ms       : DWORD ) : DWORD;
  319. BEGIN
  320.   StopCounting;
  321.   Result := Windows.WaitForMultipleObjects(ct, pH, wait, ms);
  322.   ContinueCounting;
  323. END;
  324.  
  325. FUNCTION WaitForMultipleObjectsEx ( ct  : DWORD;
  326.                                     CONST pH : PWOHandleArray;
  327.                                     wait     : BOOL;
  328.                                     ms       : DWORD;
  329.                                     al       : Boolean ) : DWORD;
  330. BEGIN
  331.   StopCounting;
  332.   Result := Windows.WaitForMultipleObjectsEx(ct, pH, wait, ms, al);
  333.   ContinueCounting;
  334. END;
  335.  
  336. FUNCTION MsgWaitForMultipleObjects ( ct     : DWORD;
  337.                                      VAR pHandles;
  338.                                      wait   : BOOL;
  339.                                      ms     : DWORD;
  340.                                      wm     : DWORD ) : DWORD;
  341. BEGIN
  342.   StopCounting;
  343.   Result := Windows.MsgWaitForMultipleObjects(ct, pHandles, wait, ms, wm);
  344.   ContinueCounting;
  345. END;
  346.  
  347. {$IFNDEF VER90 }
  348. FUNCTION MsgWaitForMultipleObjectsEx ( ct     : DWORD;
  349.                                        VAR pHandles;
  350.                                        ms     : DWORD;
  351.                                        wm     : DWORD;
  352.                                        fl     : DWORD ) : DWORD;
  353. BEGIN
  354.   StopCounting;
  355.   Result := Windows.MsgWaitForMultipleObjectsEx(ct, pHandles, ms, wm, fl);
  356.   ContinueCounting;
  357. END;
  358. {$ENDIF}
  359. FUNCTION WaitCommEvent ( hd : THandle; VAR em : DWORD; lpo : POverlapped ) : BOOL;
  360. BEGIN
  361.   StopCounting;
  362.   Result := Windows.WaitCommEvent(hd, em, lpo);
  363.   ContinueCounting;
  364. END;
  365.  
  366. FUNCTION WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
  367. BEGIN
  368.   StopCounting;
  369.   Result := Windows.WaitForInputIdle(hp, ms);
  370.   ContinueCounting;
  371. END;
  372.  
  373. FUNCTION WaitMessage : BOOL;
  374. BEGIN
  375.   StopCounting;
  376.   Result := Windows.WaitMessage;
  377.   ContinueCounting;
  378. END;
  379.  
  380. FUNCTION WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;
  381. BEGIN
  382.   StopCounting;
  383.   Result := Windows.WaitNamedPipe(np, ms);
  384.   ContinueCounting;
  385. END;
  386.  
  387. INITIALIZATION
  388.   IF ProfIsInitialised = 1 THEN BEGIN
  389.     PruefeKompatibilitaet;
  390.     IF ProfGlobalInit1 = TRUE THEN
  391.       CalcQPCTime74;
  392.     ProfGlobalInit2(0);
  393.   END;
  394. FINALIZATION
  395.   IF ProfMustBeUnInitialised = 1 THEN BEGIN
  396.     ProfSetComment('At finishing application');
  397.     ProfAppendResults(TRUE);
  398.     ProfUnInitTimer;
  399.   END;
  400. end.
  401.