home *** CD-ROM | disk | FTP | other *** search
/ Chip 2002 June / Chip_2002-06_cd1.bin / zkuste / delphi / nastroje / d23456 / PRODEL.ZIP / PROFINT.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  2002-04-03  |  15.3 KB  |  481 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 VER90 }
  20.   TMyComp  = Comp;
  21. {$ELSE }
  22.   {$IFDEF VER100 }
  23.     TMyComp  = Comp;
  24.   {$ELSE }
  25.     TMyComp  = Int64;
  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. {$IFDEF VER100} {$DEFINE PROFD3ORD4} {$ENDIF }
  37. {$IFDEF VER120} {$DEFINE PROFD3ORD4} {$ENDIF }
  38. {$IFDEF VER90}  { Delphi 2 }
  39.   TObjFunction = FUNCTION ( Text, Caption : PChar;
  40.                             Flags : Word ) : Integer OF Object;
  41. {$ELSE}
  42.   {$IFDEF PROFD3ORD4} { Delphi 3 or 4 }
  43.     TObjFunction = FUNCTION ( Text, Caption : PChar;
  44.                                 Flags : Longint ) : Integer OF Object;
  45.   {$ELSE }  { Delphi 5 OR Better }
  46.      TObjFunction = FUNCTION ( CONST Text, Caption : PChar;
  47.                                 Flags : Longint ) : Integer OF Object;
  48.   {$ENDIF}
  49. {$ENDIF}
  50.  
  51. // Profiler-Measurement-Functions
  52. PROCEDURE ProfStop  ( l : DWord; h : Integer);    external 'PROFMEAS.DLL';
  53. FUNCTION  ProfEnter ( mptr : Pointer; prozNr : Integer ) : TPLargeInteger; external 'PROFMEAS.DLL';
  54. FUNCTION  ProfExit  ( lc   : DWord;   hc : Integer; prozNr : Integer ) : TPLargeInteger; external 'PROFMEAS.DLL';
  55. PROCEDURE ProfActivate;     external 'PROFMEAS.DLL';
  56. PROCEDURE ProfDeActivate;   external 'PROFMEAS.DLL';
  57. PROCEDURE ProfSetComment  ( comm   : PChar );     external 'PROFMEAS.DLL';
  58. PROCEDURE ProfAppendResults ( progEnd : Boolean );external 'PROFMEAS.DLL';
  59.  
  60. // Post-Mortem-Review-Functions
  61. PROCEDURE PomoEnter       ( prozNr : SmallInt );  external 'PROFMEAS.DLL';
  62. PROCEDURE PomoExceStr     ( name   : pChar    );  external 'PROFMEAS.DLL';
  63. PROCEDURE PomoExce;
  64. PROCEDURE PomoExit        ( prozNr : SmallInt );  external 'PROFMEAS.DLL';
  65.  
  66. // Functions to interrupt and continue measurement for calls which could set the
  67. //  Process idle. Use these calls to implement own Non-measured Calls. If METHODS
  68. //  can set a process idle, the only possibility is, to put these calls into your
  69. //  sources (included by an IFDEF-statement).
  70. //  USE 2 or more spaces between IFDEF and PROFILE, otherwise it will be deleted
  71. //  by the ProDelphi. Example:
  72. //  {$IFDEF     PROFILE } StopCounting;     {$ENDIF }
  73. //    ObjectReference.MethodThatMightSetProcessIdle;
  74. //  {$IFDEF     PROFILE } ContinueCounting; {$ENDIF }
  75.  
  76. // Normal procedures that set the process idle can be handled like the Sleep-
  77. //  function in this unit.
  78. PROCEDURE StopCounting;                           external 'PROFMEAS.DLL';
  79. PROCEDURE ContinueCounting;                       external 'PROFMEAS.DLL';
  80.  
  81. // Delphi-Functions that set process idle
  82. PROCEDURE ShowMessage ( CONST Msg  : String );
  83. {$IFNDEF VER90 }
  84. PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
  85. {$ENDIF}
  86.           // If you need to compile the VCL, the next function must be deleted,
  87.           // Sorry ! The USES statement for Dialogs has to be moved to the
  88.           // Implementation part !!!
  89. function  MessageDlg( const Msg : string;         AType   : TMsgDlgType;
  90.                       AButtons  : TMsgDlgButtons; HelpCtx : Longint ) : Word;
  91.  
  92. function  MessageDlgPos( const Msg : string;         DlgType : TMsgDlgType;
  93.                          Buttons   : TMsgDlgButtons; HelpCtx: Longint;
  94.                          X, Y      : Integer) : Word;
  95.  
  96. {$IFNDEF VER90}  { Delphi 2 }
  97. function MessageDlgPosHelp( const Msg : string;         DlgType : TMsgDlgType;
  98.                             Buttons   : TMsgDlgButtons; HelpCtx : Longint;
  99.                             X, Y      : Integer;        const HelpFileName : string)
  100.                            : Integer;
  101. {$ENDIF}
  102.  
  103. // Delphi-TApplication-Functions that set process idle (handled in DLL)
  104. PROCEDURE ProcessMessages;
  105. PROCEDURE HandleMessage;
  106. {$IFDEF VER90 }
  107. FUNCTION  AMessageBox( Text, Caption  : PChar;
  108.                        Flags : Word ) : Integer;
  109. {$ELSE }
  110. FUNCTION  AMessageBox( Text, Caption   : PChar;
  111.                        Flags : Longint): Integer;
  112. {$ENDIF }
  113.  
  114. // Windows-Functions that set process idle
  115. FUNCTION  DispatchMessage(CONST lpMsg  : TMsg) : Longint;
  116. FUNCTION  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
  117.                      hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
  118. FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
  119.                              hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
  120. FUNCTION  MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
  121. FUNCTION  MessageBoxEx( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
  122. {$IFNDEF VER90 }
  123. FUNCTION  SignalObjectAndWait ( h1, h2 : THandle;
  124.                                 ms     : DWord;
  125.                                 al     : BOOL) : BOOL;
  126. {$ENDIF}
  127. FUNCTION  WaitForSingleObject ( h1     : THandle;
  128.                                 MS     : DWORD ) : DWORD;
  129. FUNCTION  WaitForSingleObjectEx ( h1   : THandle;
  130.                                   MS   : DWORD;
  131.                                   al   : BOOL ) : DWORD;
  132.  
  133. FUNCTION  WaitForMultipleObjects ( ct  : DWORD;
  134.                                    CONST pH : PWOHandleArray;
  135.                                    wait     : BOOL;
  136.                                    ms       : DWORD ) : DWORD;
  137. FUNCTION  WaitForMultipleObjectsEx ( ct  : DWORD;
  138.                                      CONST pH : PWOHandleArray;
  139.                                      wait     : BOOL;
  140.                                      ms       : DWORD;
  141.                                      al       : Boolean) : DWORD;
  142. FUNCTION  MsgWaitForMultipleObjects ( ct      : DWORD;
  143.                                       VAR pHandles;
  144.                                       wait    : BOOL;
  145.                                       ms      : DWORD;
  146.                                       wm      : DWORD ) : DWORD;
  147. {$IFNDEF VER90 }
  148. FUNCTION  MsgWaitForMultipleObjectsEx ( ct     : DWORD;
  149.                                         VAR pHandles;
  150.                                         ms     : DWORD;
  151.                                         wm     : DWORD;
  152.                                         fl     : DWORD ) : DWORD;
  153. {$ENDIF}
  154. PROCEDURE Sleep   (zeit : DWORD );
  155. PROCEDURE SleepEx (zeit : DWORD; alertable : BOOL );
  156. FUNCTION  WaitCommEvent ( hd  : THandle; VAR em : DWORD;
  157.                           lpo : POverlapped ) : BOOL;
  158. FUNCTION  WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
  159. FUNCTION  WaitMessage : BOOL;
  160. FUNCTION  WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;
  161.  
  162. IMPLEMENTATION
  163. USES
  164.   Forms,
  165.   SysUtils;
  166.  
  167. TYPE
  168.   TObjProzedur = PROCEDURE OF Object;
  169.  
  170. // Profiler-Internal-Functions, DO NOT USE
  171. FUNCTION  ProfGlobalInit1 : Boolean;              external 'PROFMEAS.DLL';
  172. PROCEDURE ProfGlobalInit2 ( j : Integer );        external 'PROFMEAS.DLL';
  173. PROCEDURE ProfUnInitTimer;                        external 'PROFMEAS.DLL';
  174. FUNCTION  ProfIsInitialised : Integer;            external 'PROFMEAS.DLL';
  175. FUNCTION  ProfMustBeUnInitialised : Integer;      external 'PROFMEAS.DLL';
  176.  
  177. // Calibration - Function - DO NOT USE
  178. PROCEDURE CalcQPCTime802; external 'PROFCALI.DLL';
  179. PROCEDURE ProfSetDelphiVersion ( vers : Integer ); external 'PROFCALI.DLL';
  180.  
  181. // Check if CPU is intel-Compatible
  182. PROCEDURE PruefeKompatibilitaet;
  183. VAR
  184.   tsh, tsl : DWORD;
  185. BEGIN
  186.   Try
  187.     asm
  188.       DW 310FH;
  189.       mov tsh,edx
  190.       mov tsl,eax
  191.     end;
  192.   Except
  193.     Windows.MessageBox(0, 'This CPU is not Intel-Compatible', 'ProDelphi - ERROR', MB_OK);
  194.     halt(0);
  195.   End;
  196. END;
  197.  
  198. PROCEDURE ShowMessage ( CONST Msg  : String );
  199. BEGIN
  200.   StopCounting;
  201.   Dialogs.ShowMessage(Msg);
  202.   ContinueCounting;
  203. END;
  204.  
  205. {$IFNDEF VER90 }
  206. PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
  207. BEGIN
  208.   StopCounting;
  209.   Dialogs.ShowMessageFmt(Msg, Params);
  210.   ContinueCounting;
  211. END;
  212.  
  213. FUNCTION AMessageBox( Text, Caption     : PChar;
  214.                       Flags : LongInt ) : Integer;
  215. BEGIN
  216.   StopCounting;
  217.   Result := Application.MessageBox(Text, Caption,Flags);
  218.   ContinueCounting;
  219. END;
  220.  
  221. {$ELSE }
  222.  
  223. FUNCTION AMessageBox( Text, Caption    : PChar;
  224.                       Flags : Word  )  : Integer;
  225. BEGIN
  226.   StopCounting;
  227.   Result := Application.MessageBox(Text, Caption,Flags);
  228.   ContinueCounting;
  229. END;
  230. {$ENDIF }
  231.  
  232. FUNCTION MessageDlg( const Msg : string;         AType   : TMsgDlgType;
  233.                      AButtons  : TMsgDlgButtons; HelpCtx : Longint ) : Word;
  234. BEGIN
  235.   StopCounting;
  236.   Result := Dialogs.MessageDlg(Msg, AType, AButtons, HelpCtx);
  237.   ContinueCounting;
  238. END;
  239.  
  240. FUNCTION MessageDlgPos( const Msg : string;         DlgType : TMsgDlgType;
  241.                         Buttons   : TMsgDlgButtons; HelpCtx: Longint;
  242.                         X, Y      : Integer) : Word;
  243. BEGIN
  244.   StopCounting;
  245.   Result := Dialogs.MessageDlgPos(Msg, DlgType, Buttons, HelpCtx, X, Y);
  246.   ContinueCounting;
  247. END;
  248.  
  249. {$IFNDEF VER90}  { Delphi 2 }
  250. function MessageDlgPosHelp( const Msg : string;         DlgType : TMsgDlgType;
  251.                             Buttons   : TMsgDlgButtons; HelpCtx : Longint;
  252.                             X, Y      : Integer;        const HelpFileName : string)
  253.                            : Integer;
  254. BEGIN
  255.   StopCounting;
  256.   Result := Dialogs.MessageDlgPosHelp(Msg, DlgType, Buttons, HelpCtx,
  257.                                       X, Y, HelpFileName);
  258.   ContinueCounting;
  259. END;
  260. {$ENDIF }
  261.  
  262. FUNCTION  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
  263.                      hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
  264. BEGIN
  265.   StopCounting;
  266.   Result := Windows.DialogBox(hInstance, lpTemplate, hWndParent, lpDialogFunc);
  267.   ContinueCounting;
  268. END;
  269.  
  270. FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
  271.                              hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
  272. BEGIN
  273.   StopCounting;
  274.   Result := Windows.DialogBoxIndirect(hInstance, lpDialogTemplate, hWndParent, lpDialogFunc);
  275.   ContinueCounting;
  276. END;
  277.  
  278. FUNCTION MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
  279. BEGIN
  280.   StopCounting;
  281.   Result := Windows.MessageBox(hWnd, lpText, lpCaption, uType);
  282.   ContinueCounting;
  283. END;
  284.  
  285. FUNCTION MessageBoxEx ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
  286. BEGIN
  287.   StopCounting;
  288.   Result := Windows.MessageBoxEx(hWnd, lpText, lpCaption, uType, lang);
  289.   ContinueCounting;
  290. END;
  291.  
  292. FUNCTION DispatchMessage( CONST lpMsg: TMsg ) : Longint;
  293. BEGIN
  294.   StopCounting;
  295.   Result := Windows.DispatchMessage(lpMsg);
  296.   ContinueCounting;
  297. END;
  298.  
  299. PROCEDURE HandleMessage;
  300. BEGIN
  301.   StopCounting;
  302.   Application.HandleMessage;
  303.   ContinueCounting;
  304. END;
  305.  
  306. PROCEDURE ProcessMessages;
  307. BEGIN
  308.   StopCounting;
  309.   Application.ProcessMessages;
  310.   ContinueCounting;
  311. END;
  312.  
  313. PROCEDURE Sleep( zeit : DWORD );
  314. BEGIN
  315.   StopCounting;
  316.   Windows.Sleep(zeit);
  317.   ContinueCounting;
  318. END;
  319.  
  320. PROCEDURE SleepEx( zeit : DWORD; alertable : BOOL );
  321. BEGIN
  322.   StopCounting;
  323.   Windows.SleepEx(zeit, alertable);
  324.   ContinueCounting;
  325. END;
  326. {$IFNDEF VER90 }
  327. FUNCTION SignalObjectAndWait ( h1, h2 : THandle;
  328.                                ms     : DWord;
  329.                                al     : BOOL) : BOOL;
  330. BEGIN
  331.   StopCounting;
  332.   Result := Windows.SignalObjectAndWait(h1, h2, ms, al);
  333.   ContinueCounting;
  334. END;
  335. {$ENDIF }
  336.  
  337. FUNCTION WaitForSingleObject ( h1     : THandle;
  338.                                MS     : DWORD ) : DWORD;
  339. BEGIN
  340.   StopCounting;
  341.   Result := Windows.WaitForSingleObject ( h1, MS );
  342.   ContinueCounting;
  343. END;
  344.  
  345. FUNCTION WaitForSingleObjectEx ( h1   : THandle;
  346.                                  MS   : DWORD;
  347.                                  al   : BOOL ) : DWORD;
  348. BEGIN
  349.   StopCounting;
  350.   Result := Windows.WaitForSingleObjectEx (h1, MS, al);
  351.   ContinueCounting;
  352. END;
  353.  
  354. FUNCTION WaitForMultipleObjects ( ct  : DWORD;
  355.                                   CONST pH : PWOHandleArray;
  356.                                   wait     : BOOL;
  357.                                   ms       : DWORD ) : DWORD;
  358. BEGIN
  359.   StopCounting;
  360.   Result := Windows.WaitForMultipleObjects(ct, pH, wait, ms);
  361.   ContinueCounting;
  362. END;
  363.  
  364. FUNCTION WaitForMultipleObjectsEx ( ct  : DWORD;
  365.                                     CONST pH : PWOHandleArray;
  366.                                     wait     : BOOL;
  367.                                     ms       : DWORD;
  368.                                     al       : Boolean ) : DWORD;
  369. BEGIN
  370.   StopCounting;
  371.   Result := Windows.WaitForMultipleObjectsEx(ct, pH, wait, ms, al);
  372.   ContinueCounting;
  373. END;
  374.  
  375. FUNCTION MsgWaitForMultipleObjects ( ct     : DWORD;
  376.                                      VAR pHandles;
  377.                                      wait   : BOOL;
  378.                                      ms     : DWORD;
  379.                                      wm     : DWORD ) : DWORD;
  380. BEGIN
  381.   StopCounting;
  382.   Result := Windows.MsgWaitForMultipleObjects(ct, pHandles, wait, ms, wm);
  383.   ContinueCounting;
  384. END;
  385.  
  386. {$IFNDEF VER90 }
  387. FUNCTION MsgWaitForMultipleObjectsEx ( ct     : DWORD;
  388.                                        VAR pHandles;
  389.                                        ms     : DWORD;
  390.                                        wm     : DWORD;
  391.                                        fl     : DWORD ) : DWORD;
  392. BEGIN
  393.   StopCounting;
  394.   Result := Windows.MsgWaitForMultipleObjectsEx(ct, pHandles, ms, wm, fl);
  395.   ContinueCounting;
  396. END;
  397. {$ENDIF}
  398. FUNCTION WaitCommEvent ( hd : THandle; VAR em : DWORD; lpo : POverlapped ) : BOOL;
  399. BEGIN
  400.   StopCounting;
  401.   Result := Windows.WaitCommEvent(hd, em, lpo);
  402.   ContinueCounting;
  403. END;
  404.  
  405. FUNCTION WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
  406. BEGIN
  407.   StopCounting;
  408.   Result := Windows.WaitForInputIdle(hp, ms);
  409.   ContinueCounting;
  410. END;
  411.  
  412. FUNCTION WaitMessage : BOOL;
  413. BEGIN
  414.   StopCounting;
  415.   Result := Windows.WaitMessage;
  416.   ContinueCounting;
  417. END;
  418.  
  419. FUNCTION WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;
  420. BEGIN
  421.   StopCounting;
  422.   Result := Windows.WaitNamedPipe(np, ms);
  423.   ContinueCounting;
  424. END;
  425.  
  426. PROCEDURE PomoExce;
  427. VAR
  428.   exname : Array[0..100] OF Char;
  429.   ExOb   : TObject;
  430. BEGIN
  431.   exname[0] := Char(0);
  432.   ExOb := ExceptObject;
  433.   IF Assigned(ExOb) THEN BEGIN
  434.     IF ExceptObject IS Exception THEN
  435.       StrPLCopy(exname, Exception(ExceptObject).Message, SizeOf(exname));
  436.   END;
  437.   PomoExceStr(exname);
  438. END;
  439.  
  440. INITIALIZATION
  441.   IF ProfIsInitialised = 1 THEN BEGIN
  442.     PruefeKompatibilitaet;
  443.     IF ProfGlobalInit1 = TRUE THEN BEGIN
  444. {$IFDEF VER90 }
  445.       ProfSetDelphiVersion( 2 );
  446. {$ELSE }
  447.   {$IFDEF VER100 }
  448.       ProfSetDelphiVersion( 3 );
  449.   {$ELSE }
  450.     {$IFDEF VER120 }
  451.       ProfSetDelphiVersion( 4 );
  452.     {$ELSE }
  453.       {$IFDEF VER130 }
  454.         ProfSetDelphiVersion( 5 );
  455.       {$ELSE }
  456.         {$IFDEF VER140 }
  457.           ProfSetDelphiVersion( 6 );
  458.         {$ELSE }
  459.           {$IFDEF VER150 }
  460.             ProfSetDelphiVersion( 7 );
  461.           {$ELSE }
  462.             ProfSetDelphiVersion( 8 );
  463.           {$ENDIF }
  464.         {$ENDIF }
  465.       {$ENDIF }
  466.     {$ENDIF }
  467.   {$ENDIF }
  468. {$ENDIF }
  469.       CalcQPCTime802;
  470.     END;
  471.     ProfGlobalInit2(0);
  472.   END;
  473. FINALIZATION
  474.   IF ProfMustBeUnInitialised = 1 THEN BEGIN
  475.     ProfSetComment('At finishing application');
  476.     ProfAppendResults(TRUE);
  477.     ProfUnInitTimer;
  478.   END;
  479. end.
  480.  
  481.