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