home *** CD-ROM | disk | FTP | other *** search
/ Chip 2000 July / Chip_2000-07_cd.bin / sharewar / prodelph / PROFINT.PAS < prev    next >
Pascal/Delphi Source File  |  2000-05-02  |  14KB  |  418 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 PomoExceStr     ( name   : pChar    );  external 'PROFMEAS.DLL';
  61. PROCEDURE PomoExce;
  62. PROCEDURE PomoExit        ( prozNr : SmallInt );  external 'PROFMEAS.DLL';
  63.  
  64. // Functions to interrupt and continue measurement for calls which could set the
  65. //  Process idle. Use these calls to implement own Non-measured Calls. If METHODS
  66. //  can set a process idle, the only possibility is, to put these calls into your
  67. //  sources (included by an IFDEF-statement).
  68. //  USE 2 or more spaces between IFDEF and PROFILE, otherwise it will be deleted
  69. //  by the ProDelphi. Example:
  70. //  {$IFDEF     PROFILE } StopCounting;     {$ENDIF }
  71. //    ObjectReference.MethodThatMightSetProcessIdle;
  72. //  {$IFDEF     PROFILE } ContinueCounting; {$ENDIF }
  73.  
  74. // Normal procedures that set the process idle can be handled like the Sleep-
  75. //  function in this unit.
  76. PROCEDURE StopCounting;                           external 'PROFMEAS.DLL';
  77. PROCEDURE ContinueCounting;                       external 'PROFMEAS.DLL';
  78.  
  79. // Delphi-Functions that set process idle
  80. PROCEDURE ShowMessage ( CONST Msg  : String );
  81. {$IFNDEF VER90 }
  82. PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
  83. {$ENDIF}
  84.           // If you need to compile the VCL, the next function must be deleted,
  85.           // Sorry ! The USES statement for Dialogs has to be moved to the
  86.           // Implementation part !!!
  87. function  MessageDlg( const Msg : string;         AType   : TMsgDlgType;
  88.                       AButtons  : TMsgDlgButtons; HelpCtx : Longint ) : Word;
  89.  
  90. // Delphi-TApplication-Functions that set process idle (handled in DLL)
  91. PROCEDURE ProcessMessages;                        external 'PROFMEAS.DLL';
  92. PROCEDURE HandleMessage;                          external 'PROFMEAS.DLL';
  93. {$IFDEF VER90 }
  94. FUNCTION  AMessageBox( Text, Caption  : PChar;
  95.                        Flags : Word ) : Integer;
  96. {$ELSE }
  97. FUNCTION  AMessageBox( Text, Caption   : PChar;
  98.                        Flags : Longint): Integer;
  99. {$ENDIF }
  100.  
  101. // Windows-Functions that set process idle
  102. FUNCTION  DispatchMessage(CONST lpMsg  : TMsg) : Longint;
  103. FUNCTION  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
  104.                      hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
  105. FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
  106.                              hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
  107. FUNCTION  MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
  108. FUNCTION  MessageBoxEx( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
  109. {$IFNDEF VER90 }
  110. FUNCTION  SignalObjectAndWait ( h1, h2 : THandle;
  111.                                 ms     : DWord;
  112.                                 al     : BOOL) : BOOL;
  113. {$ENDIF}
  114. FUNCTION  WaitForSingleObject ( h1     : THandle;
  115.                                 MS     : DWORD ) : DWORD;
  116. FUNCTION  WaitForSingleObjectEx ( h1   : THandle;
  117.                                   MS   : DWORD;
  118.                                   al   : BOOL ) : DWORD;
  119.  
  120. FUNCTION  WaitForMultipleObjects ( ct  : DWORD;
  121.                                    CONST pH : PWOHandleArray;
  122.                                    wait     : BOOL;
  123.                                    ms       : DWORD ) : DWORD;
  124. FUNCTION  WaitForMultipleObjectsEx ( ct  : DWORD;
  125.                                      CONST pH : PWOHandleArray;
  126.                                      wait     : BOOL;
  127.                                      ms       : DWORD;
  128.                                      al       : Boolean) : DWORD;
  129. FUNCTION  MsgWaitForMultipleObjects ( ct      : DWORD;
  130.                                       VAR pHandles;
  131.                                       wait    : BOOL;
  132.                                       ms      : DWORD;
  133.                                       wm      : DWORD ) : DWORD;
  134. {$IFNDEF VER90 }
  135. FUNCTION  MsgWaitForMultipleObjectsEx ( ct     : DWORD;
  136.                                         VAR pHandles;
  137.                                         ms     : DWORD;
  138.                                         wm     : DWORD;
  139.                                         fl     : DWORD ) : DWORD;
  140. {$ENDIF}
  141. PROCEDURE Sleep   (zeit : DWORD );
  142. PROCEDURE SleepEx (zeit : DWORD; alertable : BOOL );
  143. FUNCTION  WaitCommEvent ( hd  : THandle; VAR em : DWORD;
  144.                           lpo : POverlapped ) : BOOL;
  145. FUNCTION  WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
  146. FUNCTION  WaitMessage : BOOL;
  147. FUNCTION  WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;
  148. // Registration-Functions (internal Use only)
  149. PROCEDURE RegisterMessageBox( MBProc : TObjFunction );
  150.  
  151. IMPLEMENTATION
  152. USES
  153.   SysUtils;
  154.  
  155. // Profiler-Internal-Functions, DO NOT USE
  156. FUNCTION  ProfGlobalInit1 : Boolean;              external 'PROFMEAS.DLL';
  157. PROCEDURE ProfGlobalInit2 ( j : Integer );        external 'PROFMEAS.DLL';
  158. PROCEDURE ProfUnInitTimer;                        external 'PROFMEAS.DLL';
  159. FUNCTION  ProfIsInitialised : Integer;            external 'PROFMEAS.DLL';
  160. FUNCTION  ProfMustBeUnInitialised : Integer;      external 'PROFMEAS.DLL';
  161.  
  162. // Calibration - Function - DO NOT USE
  163. PROCEDURE CalcQPCTime80; external 'PROFCALI.DLL';
  164.  
  165. VAR
  166.   MessBox : TObjFunction;
  167.  
  168. // Check if CPU is intel-Compatible
  169. PROCEDURE PruefeKompatibilitaet;
  170. VAR
  171.   tsh, tsl : DWORD;
  172. BEGIN
  173.   Try
  174.     asm
  175.       DW 310FH;
  176.       mov tsh,edx
  177.       mov tsl,eax
  178.     end;
  179.   Except
  180.     Windows.MessageBox(0, 'This CPU is not Intel-Compatible', 'ProDelphi - ERROR', MB_OK);
  181.     halt(0);
  182.   End;
  183. END;
  184.  
  185. PROCEDURE ShowMessage ( CONST Msg  : String );
  186. BEGIN
  187.   StopCounting;
  188.   Dialogs.ShowMessage(Msg);
  189.   ContinueCounting;
  190. END;
  191.  
  192. PROCEDURE RegisterMessageBox( MBProc : TObjFunction );
  193. BEGIN
  194.   MessBox := MBProc;
  195. END;
  196.  
  197. {$IFNDEF VER90 }
  198. PROCEDURE ShowMessageFmt(const Msg : string; Params : array of const );
  199. BEGIN
  200.   StopCounting;
  201.   Dialogs.ShowMessageFmt(Msg, Params);
  202.   ContinueCounting;
  203. END;
  204.  
  205. FUNCTION AMessageBox( Text, Caption     : PChar;
  206.                       Flags : LongInt ) : Integer;
  207. BEGIN
  208.   StopCounting;
  209.   IF Assigned(MessBox) THEN
  210.     Result := MessBox(Text, Caption, Flags)
  211.   ELSE BEGIN
  212.     Result := Windows.MessageBox(0, Text, Caption, Flags);
  213.   END;
  214.   ContinueCounting;
  215. END;
  216.  
  217. {$ELSE }
  218.  
  219. FUNCTION AMessageBox( Text, Caption    : PChar;
  220.                       Flags : Word  )  : Integer;
  221. BEGIN
  222.   StopCounting;
  223.   IF Assigned(MessBox) THEN
  224.     Result := MessBox(Text, Caption, Flags)
  225.   ELSE BEGIN
  226.     Result := Windows.MessageBox(0, Text, Caption, Flags);
  227.   END;
  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  DialogBox( hInstance  : HINST; lpTemplate   : PChar;
  241.                      hWndParent : HWND;  lpDialogFunc : TFNDlgProc): Integer;
  242. BEGIN
  243.   StopCounting;
  244.   Result := Windows.DialogBox(hInstance, lpTemplate, hWndParent, lpDialogFunc);
  245.   ContinueCounting;
  246. END;
  247.  
  248. FUNCTION  DialogBoxIndirect( hInstance  : HINST; const lpDialogTemplate : TDlgTemplate;
  249.                              hWndParent : HWND;        lpDialogFunc     : TFNDlgProc): Integer;
  250. BEGIN
  251.   StopCounting;
  252.   Result := Windows.DialogBoxIndirect(hInstance, lpDialogTemplate, hWndParent, lpDialogFunc);
  253.   ContinueCounting;
  254. END;
  255.  
  256. FUNCTION MessageBox ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT ) : Integer;
  257. BEGIN
  258.   StopCounting;
  259.   Result := Windows.MessageBox(hWnd, lpText, lpCaption, uType);
  260.   ContinueCounting;
  261. END;
  262.  
  263. FUNCTION MessageBoxEx ( hWnd : HWND; lpText, lpCaption: PChar; uType : UINT; lang : Word ) : Integer;
  264. BEGIN
  265.   StopCounting;
  266.   Result := Windows.MessageBoxEx(hWnd, lpText, lpCaption, uType, lang);
  267.   ContinueCounting;
  268. END;
  269.  
  270. FUNCTION DispatchMessage( CONST lpMsg: TMsg ) : Longint;
  271. BEGIN
  272.   StopCounting;
  273.   Result := Windows.DispatchMessage(lpMsg);
  274.   ContinueCounting;
  275. END;
  276.  
  277. PROCEDURE Sleep( zeit : DWORD );
  278. BEGIN
  279.   StopCounting;
  280.   Windows.Sleep(zeit);
  281.   ContinueCounting;
  282. END;
  283.  
  284. PROCEDURE SleepEx( zeit : DWORD; alertable : BOOL );
  285. BEGIN
  286.   StopCounting;
  287.   Windows.SleepEx(zeit, alertable);
  288.   ContinueCounting;
  289. END;
  290. {$IFNDEF VER90 }
  291. FUNCTION SignalObjectAndWait ( h1, h2 : THandle;
  292.                                ms     : DWord;
  293.                                al     : BOOL) : BOOL;
  294. BEGIN
  295.   StopCounting;
  296.   Result := Windows.SignalObjectAndWait(h1, h2, ms, al);
  297.   ContinueCounting;
  298. END;
  299. {$ENDIF }
  300.  
  301. FUNCTION WaitForSingleObject ( h1     : THandle;
  302.                                MS     : DWORD ) : DWORD;
  303. BEGIN
  304.   StopCounting;
  305.   Result := Windows.WaitForSingleObject ( h1, MS );
  306.   ContinueCounting;
  307. END;
  308.  
  309. FUNCTION WaitForSingleObjectEx ( h1   : THandle;
  310.                                  MS   : DWORD;
  311.                                  al   : BOOL ) : DWORD;
  312. BEGIN
  313.   StopCounting;
  314.   Result := Windows.WaitForSingleObjectEx (h1, MS, al);
  315.   ContinueCounting;
  316. END;
  317.  
  318. FUNCTION WaitForMultipleObjects ( ct  : DWORD;
  319.                                   CONST pH : PWOHandleArray;
  320.                                   wait     : BOOL;
  321.                                   ms       : DWORD ) : DWORD;
  322. BEGIN
  323.   StopCounting;
  324.   Result := Windows.WaitForMultipleObjects(ct, pH, wait, ms);
  325.   ContinueCounting;
  326. END;
  327.  
  328. FUNCTION WaitForMultipleObjectsEx ( ct  : DWORD;
  329.                                     CONST pH : PWOHandleArray;
  330.                                     wait     : BOOL;
  331.                                     ms       : DWORD;
  332.                                     al       : Boolean ) : DWORD;
  333. BEGIN
  334.   StopCounting;
  335.   Result := Windows.WaitForMultipleObjectsEx(ct, pH, wait, ms, al);
  336.   ContinueCounting;
  337. END;
  338.  
  339. FUNCTION MsgWaitForMultipleObjects ( ct     : DWORD;
  340.                                      VAR pHandles;
  341.                                      wait   : BOOL;
  342.                                      ms     : DWORD;
  343.                                      wm     : DWORD ) : DWORD;
  344. BEGIN
  345.   StopCounting;
  346.   Result := Windows.MsgWaitForMultipleObjects(ct, pHandles, wait, ms, wm);
  347.   ContinueCounting;
  348. END;
  349.  
  350. {$IFNDEF VER90 }
  351. FUNCTION MsgWaitForMultipleObjectsEx ( ct     : DWORD;
  352.                                        VAR pHandles;
  353.                                        ms     : DWORD;
  354.                                        wm     : DWORD;
  355.                                        fl     : DWORD ) : DWORD;
  356. BEGIN
  357.   StopCounting;
  358.   Result := Windows.MsgWaitForMultipleObjectsEx(ct, pHandles, ms, wm, fl);
  359.   ContinueCounting;
  360. END;
  361. {$ENDIF}
  362. FUNCTION WaitCommEvent ( hd : THandle; VAR em : DWORD; lpo : POverlapped ) : BOOL;
  363. BEGIN
  364.   StopCounting;
  365.   Result := Windows.WaitCommEvent(hd, em, lpo);
  366.   ContinueCounting;
  367. END;
  368.  
  369. FUNCTION WaitForInputIdle ( hp : THandle; ms : DWORD ) : DWORD;
  370. BEGIN
  371.   StopCounting;
  372.   Result := Windows.WaitForInputIdle(hp, ms);
  373.   ContinueCounting;
  374. END;
  375.  
  376. FUNCTION WaitMessage : BOOL;
  377. BEGIN
  378.   StopCounting;
  379.   Result := Windows.WaitMessage;
  380.   ContinueCounting;
  381. END;
  382.  
  383. FUNCTION WaitNamedPipe ( np : PAnsiChar; ms : DWORD ) : BOOL;
  384. BEGIN
  385.   StopCounting;
  386.   Result := Windows.WaitNamedPipe(np, ms);
  387.   ContinueCounting;
  388. END;
  389.  
  390. PROCEDURE PomoExce;
  391. VAR
  392.   exname : Array[0..100] OF Char;
  393.   ExOb   : TObject;
  394. BEGIN
  395.   exname[0] := Char(0);
  396.   ExOb := ExceptObject;
  397.   IF Assigned(ExOb) THEN BEGIN
  398.     IF ExceptObject IS Exception THEN
  399.       StrPLCopy(exname, Exception(ExceptObject).Message, SizeOf(exname));
  400.   END;
  401.   PomoExceStr(exname);
  402. END;
  403.  
  404. INITIALIZATION
  405.   IF ProfIsInitialised = 1 THEN BEGIN
  406.     PruefeKompatibilitaet;
  407.     IF ProfGlobalInit1 = TRUE THEN
  408.       CalcQPCTime80;
  409.     ProfGlobalInit2(0);
  410.   END;
  411. FINALIZATION
  412.   IF ProfMustBeUnInitialised = 1 THEN BEGIN
  413.     ProfSetComment('At finishing application');
  414.     ProfAppendResults(TRUE);
  415.     ProfUnInitTimer;
  416.   END;
  417. end.
  418.