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