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