home *** CD-ROM | disk | FTP | other *** search
/ Turbo Toolbox / Turbo_Toolbox.iso / dtx9303 / alcheck / alcheck.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1993-04-05  |  19.4 KB  |  636 lines
  1. {$define RETAIL_VERSION}
  2. {!$define WIN32}
  3. {***************************************************************************
  4.   Source File Name     :  ALCHECK.PAS
  5.   Autor                :  Mario M. Westphal
  6.   Erstellt am          :  10.07.1992
  7.  
  8.   Compiler             :  Turbo Pascal for Windows 1.5
  9.   Betriebssystem       :  DOS 5.0, Windows 3.x
  10.   Compiler-Schalter    :  -
  11.  
  12.   Bemerkungen          :  -
  13.  
  14.   Beschreibung         :  AlCheck dient zum ▄berprⁿfen von Programmen auf
  15.                           den Verbrauch folgender Ressourcen:
  16.                             -Globaler Heap
  17.                             -USER Heap
  18.                             -GDI Heap
  19.                             -Filehandles
  20.  
  21.   Revisionen           :  1.00 10.07.1992 created (MW)
  22.                           1.10 07.04.1993 revisited (MW)
  23. ****************************************************************************}
  24. {$M 8192,8192}
  25. {$A+,B-,D+,F-,G+,I-,L+,N-,R+,S+,V+,W-,X+,Q+}
  26.  
  27. {$ifdef RETAIL_VERSION}
  28.   {$D-,L-,S-,R-,Q-}
  29. {$endif}
  30.  
  31. program AllocationChecker;
  32. {$R ALCHECK.RES}
  33.  
  34. uses
  35.   WinTypes,
  36.   WinProcs,
  37.   Objects,
  38.   OMemory,
  39.   OWindows,
  40.   ODialogs,
  41.   Win31,
  42.   Strings,
  43.   MMSystem,
  44.   BWCC,
  45.   WinDos,
  46.   ToolHelp,
  47.   Stress,
  48.   Validate,
  49.   SysTools,
  50.   ExDlg;
  51.  
  52.  
  53. {$I ALCHECK.IDS : Stringtabellen-IDs }
  54.  
  55. const
  56.     APPNAME         = 'Allocation Checker';
  57.   INIFILENAME     = 'ALCHECK.INI';
  58.  
  59.   { Schalter }
  60.   iddlg_BtnFix    = 200;
  61.   iddlg_BtnCheck  = 201;
  62.   iddlg_BtnStart  = 202;
  63.  
  64.   { Fixiert }
  65.   iddlg_GlobalF   = 101;
  66.   iddlg_UserF     = 102;
  67.   iddlg_GDIF      = 103;
  68.   iddlg_HandlesF  = 104;
  69.  
  70.   { Aktuell }
  71.   iddlg_GlobalA   = 110;
  72.   iddlg_UserA     = 111;
  73.   iddlg_GDIA      = 112;
  74.   iddlg_HandlesA  = 113;
  75.  
  76.   { Steuerelemente }
  77.   iddlg_Interval  = 121;  { Interval Edit }
  78.   iddlg_HandleUpd = 122;  { Handles aktualisieren }
  79.   iddlg_OnTop     = 123;  { Immer Oben }
  80.   iddlg_Logging   = 124;  { Logfile mitfⁿhren }
  81.   iddlg_Message   = 130;  { Messagefeld }
  82.  
  83.   { Sytemmenⁿ }
  84.   idmsys_About    = 999;  { "About"-Kommando im Systemmenⁿ }
  85.  
  86.  
  87. type
  88.   { Struktur fⁿr die ⁿberwachten Ressourcen }
  89.   TCheckRec = record
  90.     lGlobalMem : LongInt;
  91.     lUserMem   : LongInt;
  92.     lGDIMem    : LongInt;
  93.     iHandles   : Integer;
  94.   end;
  95.  
  96. type
  97.   { Spalte Fixiert und Aktuell }
  98.   TDlgRec = record
  99.     FixRec : TCheckRec;
  100.     CurRec : TCheckRec;
  101.   end;
  102.  
  103. type
  104.   { Ableitung mit neuen Eigenschaften. Die Methode Error gibt einen aus der Stringtabelle }
  105.   { geladenen Text aus. Im Feld Parent wird das Elternfenster gespeichert. Dieses wird    }
  106.   { fⁿr die MessageBox ben÷tigt, da der Hauptfenster-Dialog durch den Stil HWND_TOPMOST   }
  107.   { die MessageBox sonst ⁿberdecken wⁿrde. ▄ber dieses Handle kann bei einem Fehler der   }
  108.   { Fokus wieder auf das Eltern (Edit) - Fenster gesetzt werden.                          }
  109.   PRangeVal = ^TRangeVal;
  110.   TRangeVal = object(TRangeValidator)
  111.       Parent : PEdit;
  112.     constructor Init(AParent: PEdit; AMin, AMax: Longint);
  113.     procedure Error; virtual;
  114.   end;
  115.  
  116.   {-------------------------------------------------------------------------------
  117.     Setzt das Feld Parent auf AParent und ruft den Konstruktor des Vorfahren auf.
  118.   }
  119.   constructor TRangeVal.Init(AParent: PEdit; AMin, AMax: Longint);
  120.   begin
  121.     Inherited Init(AMin,AMax);
  122.     Parent := AParent;
  123.   end;
  124.  
  125.   {-------------------------------------------------------------------------------
  126.     Gibt eine Meldung aus und setzt anschlie▀end den Fokus auf das zugeordnete
  127.     Edit-Feld.
  128.   }
  129.   procedure TRangeVal.Error;
  130.   var
  131.     s : array[0..255] of Char;
  132.     a : array[0..3] of Word;
  133.   begin
  134.     { Bastle einen String mit Bereichsangaben }
  135.     a[0] := LoWord(Min);
  136.     a[1] := HiWord(Min);
  137.     a[2] := LoWord(Max);
  138.     a[3] := HiWord(Max);
  139.     wvsprintf(s,LoadStr(ids_InvalidInterval),a);
  140.     MessageBox(Parent^.HWindow,s,APPNAME,mb_Ok or mb_IconExclamation);
  141.     SetFocus(Parent^.HWindow);
  142.     Parent^.SetSelection(0,Parent^.GetTextLen);
  143.   end;
  144.  
  145.  
  146. type
  147.     PMWindow = ^TMWindow;
  148.     TMWindow = object(TDlgWindow)
  149.       lpDlgRec    : TDlgRec;          { Struktur: Informationen im Dialog }
  150.       lInterval   : LongInt;          { Intervall-Zeit in ms }
  151.       bIntervalOn : Boolean;          { Intervall Ein/Aus }
  152.       wRegMsg     : Word;             { Systemweiter Nachrichtencode }
  153.       tfLogFile   : Text;             { Logdatei }
  154.       peInterval  : PEdit;            { ▄berprⁿfung des Intervals }
  155.  
  156.     { Inheritance }
  157.         constructor Init (AParent: PWindowsObject; ATitle: PChar);
  158.         procedure SetupWindow; virtual;
  159.         destructor Done; virtual;
  160.         function     GetClassName: PChar; virtual;
  161.         procedure GetWindowClass(var AWndClass: TWndClass); virtual;
  162.  
  163.     { Special message handling }
  164.     procedure WMSysCommand (var Msg: TMessage);
  165.       virtual wm_First or wm_SysCommand;
  166.     procedure DefWndProc (var Msg: TMessage); virtual;
  167.  
  168.     { Ressource checking and message logging }
  169.     procedure UpdateLogFile (Notification: PChar);
  170.     procedure GetActualValues (var DR: TCheckRec; CheckHandles: Boolean);
  171.     procedure UpdateFixValues;
  172.     procedure UpdateActualValues;
  173.  
  174.     { Message handling }
  175.     procedure WMDLGFix (var Msg: TMessage);
  176.       virtual id_First or iddlg_BtnFix;
  177.     procedure WMDLGCheck (var Msg: TMessage);
  178.       virtual id_First or iddlg_BtnCheck;
  179.     procedure IntervalBtn (var Msg: TMessage);
  180.       virtual id_First or iddlg_BtnStart;
  181.     procedure OnTopBtn (var Msg: TMessage);
  182.       virtual id_First or iddlg_OnTop;
  183.     procedure WMTimer (var Msg: TMessage);
  184.       virtual wm_First or wm_Timer;
  185.  
  186.     { INI-files }
  187.     procedure ReadINIData;
  188.     procedure WriteINIData;
  189.     end;
  190.  
  191. {*******************************************************************************}
  192. { TMWindow                                                                      }
  193. {*******************************************************************************}
  194. constructor TMWindow.Init (AParent : PWindowsObject; ATitle: PChar);
  195. begin
  196.     Inherited Init(AParent, 'DLG_MAINWINDOW');
  197.   { Erzeuge eine systemweit eindeutige Nachricht }
  198.   wRegMsg := RegisterWindowMessage('ALCHECK_NOTIFY');
  199.   { Editfeld fⁿr den Intervall... }
  200.   New(peInterval,InitResource(@Self,iddlg_Interval,6));
  201.   { ...und ein Validierungsobjekt }
  202.   peInterval^.SetValidator(New(PRangeVal,Init(peInterval,250,65000)));
  203. end;
  204.  
  205. {-------------------------------------------------------------------------------
  206.   ╓ffnet das Logfile und lie▀t die Daten aus der INI-Datei ein. Fⁿgt dem
  207.   Systemmenⁿ eine "About"-Option hinzu.
  208. }
  209. procedure TMWindow.SetupWindow;
  210. var
  211.   hmnuSys : HMenu;
  212.  
  213.   { Existiert die Logdatei, wird sie im Modus }
  214.   { Append ge÷ffnet, ansonsten neu angelegt.  }
  215.   procedure OpenLogFile;
  216.   var
  217.     sz        : array[0..255] of Char;
  218.     szT       : array[0..20] of Char;
  219.     y,m,d,dow : Word;
  220.   begin
  221.     {$ifopt I+}
  222.       {$define I_ON}
  223.       {$I-}
  224.     {$endif}
  225.     { Die Logdatei wird in selben Verzeichnis wie ALCHECK }
  226.     { angelegt und erhΣlt den Namen ALCHECK.LOG.          }
  227.     GetModuleFileName(HInstance,sz,SizeOf(sz));
  228.     FileSplit(sz,sz,szT,szT);
  229.     if sz[StrLen(sz)-1] <> '\' then StrCat(sz,'\');
  230.     Assign(tfLogFile,StrCat(sz,'ALCHECK.LOG'));
  231.     { Immer zuerst im Modus "Append" }
  232.     Append(tfLogFile);
  233.     if IOResult <> 0 then Rewrite(tfLogFile);
  234.  
  235.     FillChar(sz,80,'-');
  236.     sz[80] := #0;
  237.     WriteLn(tfLogFile,sz);
  238.  
  239.     { Datum und Uhrzeit eintragen }
  240.     GetDate(y,m,d,dow);
  241.     wvsprintf(szT,'%02u',m);
  242.     Write(tfLogFile,d:2,'.',szT,'.',y,' - ');
  243.     GetTime(d,m,dow,dow);
  244.     wvsprintf(szT,'%02u',m);
  245.     WriteLn(tfLogFile,d,':',szT);
  246.     WriteLn(tfLogFile,sz);
  247.     {$ifdef I_ON}
  248.       {$undef I_ON}
  249.       {$I+}
  250.     {$endif}
  251.   end;
  252.  
  253.  
  254. begin
  255.     Inherited SetupWindow;
  256.   SetWindowText(HWindow,APPNAME);
  257.  
  258.   bIntervalOn := false;
  259.  
  260.   { Initialisierungsdatei auslesen }
  261.   ReadINIData;
  262.  
  263.   { Logdatei anlegen }
  264.   OpenLogFile;
  265.  
  266.   { "About"-Eintrag in das Systemmenⁿ einhΣngen }
  267.   hmnuSys := GetSystemMenu(HWindow,false);
  268.   AppendMenu(hmnuSys,mf_SEPARATOR,$FFFF,nil);
  269.   AppendMenu(hmnuSys,mf_STRING,idmsys_About,LoadStr(ids_About));
  270.  
  271.   { Wird als Flag fⁿr UpdateActualValues verwendet: -1 => Keine Filehandles anzeigen }
  272.   lpDlgRec.CurRec.iHandles := -1;
  273.   lpDlgRec.FixRec.iHandles := -1;
  274. end;
  275.  
  276. {-------------------------------------------------------------------------------
  277.   Timer freigeben, Logdatei schlie▀en und die INI-Daten wegschreiben.
  278. }
  279. destructor TMWindow.Done;
  280. begin
  281.   KillTimer(HWindow,1);
  282.   Close(tfLogFile);
  283.   WriteINIData;
  284.     Inherited Done;
  285. end;
  286.  
  287. {-------------------------------------------------------------------------------
  288.   Der Klassenname wird fⁿr FindWindow ben÷tigt.
  289. }
  290. function TMWindow.GetClassName: PChar;
  291. begin
  292.     GetClassName := 'BorDlgWin-ALCHECK';
  293. end;
  294.  
  295. {-------------------------------------------------------------------------------
  296. }
  297. procedure TMWindow.GetWindowClass(var AWndClass: TWndClass);
  298. begin
  299.     Inherited GetWindowClass(AWndClass);
  300.     AWndClass.hIcon := LoadIcon(HInstance,'APP_ICON');
  301. end;
  302.  
  303. {-------------------------------------------------------------------------------
  304.   Bearbeitet die "About"-Option im Systemmenⁿ.
  305. }
  306. procedure TMWindow.WMSysCommand (var Msg: TMessage);
  307. begin
  308.   if LoWord(Msg.wParam) = idmsys_About then
  309.   begin
  310.     Application^.ExecDialog(New(PCtrDialog,Init(@Self,'DLG_ABOUT',CTRDLG_PARENT)));
  311.   end
  312.   else
  313.    DefWndProc(Msg);
  314. end;
  315.  
  316. {-------------------------------------------------------------------------------
  317.   ▄berschrieben, um die Kommunikationsnachrichten von AlCheckNotify abzufangen.
  318. }
  319. procedure TMWindow.DefWndProc (var Msg: TMessage);
  320. begin
  321.   if Msg.Message = wRegMsg then
  322.   begin
  323.     { Eine Anwendung hat eine Nachricht fⁿr ALCHECK }
  324.     SetDlgItemText(HWindow,iddlg_Message,PChar(Msg.lParam));
  325.     GetActualValues(lpDlgRec.CurRec,IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0);
  326.     UpdateActualValues;
  327.     if Msg.wParam <> 0 then
  328.     begin
  329.       { Neu fixieren }
  330.       GetActualValues(lpDlgRec.FixRec,IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0);
  331.       UpdateFixValues;
  332.     end;
  333.     UpdateLogFile(PChar(Msg.lParam));
  334.   end
  335.   else
  336.     Inherited DefWndProc(Msg);
  337. end;
  338.  
  339. {-------------------------------------------------------------------------------
  340.   TrΣgt die aktuellen Werte in das Logfile ein.
  341. }
  342. procedure TMWindow.UpdateLogFile (Notification: PChar);
  343. begin
  344.   if IsDlgButtonChecked(HWindow,iddlg_Logging) > 0 then
  345.   begin
  346.     WriteLn(tfLogFile,'[',Notification,']');
  347.     WriteLn(tfLogFile,LoadStr(ids_LogFileHeader));
  348.     WriteLn(tfLogFile,'    ',lpDlgRec.CurRec.lGlobalMem:10,'  ',lpDlgRec.FixRec.lGlobalMem);
  349.     WriteLn(tfLogFile,'    ',lpDlgRec.CurRec.lUserMem:10  ,'  ',lpDlgRec.FixRec.lUserMem);
  350.     WriteLn(tfLogFile,'    ',lpDlgRec.CurRec.lGDIMem:10   ,'  ',lpDlgRec.FixRec.lGDIMem);
  351.     if IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0 then
  352.       WriteLn(tfLogFile,'    ',lpDlgRec.CurRec.iHandles:10  ,'  ',lpDlgRec.FixRec.iHandles)
  353.     else
  354.       WriteLn(tfLogFile,LoadStr(ids_LogFileNoHandles));
  355.     WriteLn(tfLogFile);
  356.   end;
  357. end;
  358.  
  359. {-------------------------------------------------------------------------------
  360.   Ermitteln der aktuellen Systemressourcen. Wird "CheckHandles" als true
  361.   ⁿbergeben, wird zusΣtzlich die Anzahl der freien File-Handles ermittelt.
  362. }
  363. procedure TMWindow.GetActualValues (var DR: TCheckRec; CheckHandles: Boolean);
  364. var
  365.   lpSysHeap : TSysHeapInfo;
  366. begin
  367.   lpSysHeap.dwSize := SizeOf(lpSysHeap);
  368.   SystemHeapInfo(@lpSysHeap);
  369.   with DR do
  370.   begin
  371.     GlobalCompact(0);  { Bei Bedarf! }
  372.     lGlobalMem := GetFreeSpace(0) div 1024;
  373.     lUserMem := lpSysHeap.wUserFreePercent;
  374.     lGDIMem := lpSysHeap.wGDIFreePercent;;
  375.     if CheckHandles then iHandles := GetFreeFileHandles
  376.   end;
  377. end;
  378.  
  379. {-------------------------------------------------------------------------------
  380.   Die fixierten Werte aktualisieren
  381. }
  382. procedure TMWindow.UpdateFixValues;
  383. var sz : array[0..100] of Char;
  384. begin
  385.   with lpDlgRec.FixRec do
  386.   begin
  387.     Str(lGlobalMem,sz);
  388.     StrCat(sz,' KB');
  389.     SetDlgItemText(HWindow,iddlg_GlobalF,sz);
  390.  
  391.     Str(lUserMem,sz);
  392.     StrCat(sz,'%');
  393.     SetDlgItemText(HWindow,iddlg_UserF,sz);
  394.  
  395.     Str(lGDIMem,sz);
  396.     StrCat(sz,'%');
  397.     SetDlgItemText(HWindow,iddlg_GDIF,sz);
  398.  
  399.     if iHandles < 0 then
  400.       StrCopy(sz,'?')
  401.     else
  402.       Str(iHandles,sz);
  403.     SetDlgItemText(HWindow,iddlg_HandlesF,sz);
  404.   end;
  405. end;
  406.  
  407. {-------------------------------------------------------------------------------
  408.   Die aktuellen Werte neu eintragen.
  409. }
  410. procedure TMWindow.UpdateActualValues;
  411. var sz : array[0..100] of Char;
  412. begin
  413.   with lpDlgRec.CurRec do
  414.   begin
  415.     Str(lGlobalMem,sz);
  416.     StrCat(sz,' KB');
  417.     SetDlgItemText(HWindow,iddlg_GlobalA,sz);
  418.  
  419.     Str(lUserMem,sz);
  420.     StrCat(sz,'%');
  421.     SetDlgItemText(HWindow,iddlg_UserA,sz);
  422.  
  423.     Str(lGDIMem,sz);
  424.     StrCat(sz,'%');
  425.     SetDlgItemText(HWindow,iddlg_GDIA,sz);
  426.  
  427.     if iHandles < 0 then
  428.       StrCopy(sz,'?')
  429.     else
  430.       Str(iHandles,sz);
  431.     SetDlgItemText(HWindow,iddlg_HandlesA,sz);
  432.   end;
  433. end;
  434.  
  435. {-------------------------------------------------------------------------------
  436.   Btn-Response: Aktuelle Ressourcen neu fixieren.
  437. }
  438. procedure TMWindow.WMDLGFix (var Msg: TMessage);
  439. begin
  440.   GetActualValues(lpDlgRec.FixRec,IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0);
  441.   UpdateFixValues;
  442.   UpdateLogFile(LoadStr(ids_Manual));
  443. end;
  444.  
  445. {-------------------------------------------------------------------------------
  446.   Btn-Response: Aktuelle Werte neu eintragen.
  447. }
  448. procedure TMWindow.WMDLGCheck (var Msg: TMessage);
  449. begin
  450.   GetActualValues(lpDlgRec.CurRec,IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0);
  451.   UpdateActualValues;
  452.   UpdateLogFile(LoadStr(ids_Manual));
  453. end;
  454.  
  455. {-------------------------------------------------------------------------------
  456.   Btn-Response: Intervall ein- oder ausschalten
  457. }
  458. procedure TMWindow.IntervalBtn (var Msg: TMessage);
  459. var
  460.   sz        : array[0..5] of Char;
  461.   szCaption : array[0..100] of Char;
  462.   nCode     : Integer;
  463. begin
  464.   if not bIntervalOn then
  465.   begin
  466.     { ▄berprⁿfe den Wert im Intervall-Editfeld. Wird ein ungⁿltiger Wert gefunden, }
  467.     { wird dieser gemeldet und der Timer wird nicht gestartet.                     }
  468.     if not peInterval^.IsValid(true) then exit;
  469.  
  470.     if SetTimer(HWindow,1,lInterval,nil) <> 0 then
  471.     begin
  472.       bIntervalOn := true;
  473.       peInterval^.GetText(sz,SizeOf(sz));
  474.       Val(sz,lInterval,nCode);
  475.       SetDlgItemText(HWindow,iddlg_BtnStart,LoadStr(ids_Stop));
  476.       GetActualValues(lpDlgRec.CurRec,IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0);
  477.       UpdateActualValues;
  478.       { ─ndere die Caption, um den aktiven Status des Timers anzuzeigen }
  479.       StrCopy(szCaption,APPNAME);
  480.       StrCat(szCaption,LoadStr(ids_Running));
  481.       SetWindowText(HWindow,szCaption);
  482.     end
  483.     else
  484.     begin
  485.       MessageBox(HWindow,LoadStr(ids_NoSystemTimer),APPNAME,mb_Ok or mb_IconStop);
  486.     end;
  487.   end
  488.   else
  489.   begin
  490.     { Interval ausschalten }
  491.     bIntervalOn := false;
  492.     StrCopy(szCaption,APPNAME);
  493.     SetWindowText(HWindow,szCaption);
  494.     FlashWindow(HWindow,false);
  495.     KillTimer(HWindow,1);
  496.     SetDlgItemText(HWindow,iddlg_BtnStart,LoadStr(ids_Start));
  497.   end;
  498. end;
  499.  
  500. {-------------------------------------------------------------------------------
  501.   Btn-Response: Das Fenster zwischen 'Immer Oben' und normaler Z-Ordnung
  502.   umschalten.
  503. }
  504. procedure TMWindow.OnTopBtn (var Msg: TMessage);
  505. begin
  506.   if IsDlgButtonChecked(HWindow,iddlg_OnTop) > 0 then
  507.     SetWindowPos(HWindow,HWND_TOPMOST,0,0,0,0,SWP_NOSIZE or SWP_NOMOVE)
  508.   else
  509.     SetWindowPos(HWindow,HWND_NOTOPMOST,0,0,0,0,SWP_NOSIZE or SWP_NOMOVE);
  510. end;
  511.  
  512. {-------------------------------------------------------------------------------
  513.   Realisiert alle Aktionen, die beim Auftreten eines Timer-Ereignisses
  514.   ausgefⁿhrt werden mⁿssen.
  515. }
  516. procedure TMWindow.WMTimer (var Msg: TMessage);
  517. begin
  518.   FlashWindow(HWindow,true);
  519.   GetActualValues(lpDlgRec.CurRec,IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0);
  520.   UpdateActualValues;
  521.   UpdateLogFile(LoadStr(ids_Interval));
  522. end;
  523.  
  524. {-------------------------------------------------------------------------------
  525.   Lie▀t die EintrΣge aus der INI-Datei und setzt die entsprechenden Optionen.
  526. }
  527. procedure TMWindow.ReadINIData;
  528. var
  529.   x, y  : Integer;
  530.   u     : Word;
  531.   sz    : array[0..20] of Char;
  532. begin
  533.   { Position }
  534.   x := GetPrivateProfileInt(APPNAME,'XPos',100,INIFILENAME);
  535.   y := GetPrivateProfileInt(APPNAME,'YPos',100,INIFILENAME);
  536.  
  537.   { Update Filehandles }
  538.   u := GetPrivateProfileInt(APPNAME,'UpdateHandles',0,INIFILENAME);
  539.   if u <> 0 then CheckDlgButton(HWindow,iddlg_HandleUpd,1);
  540.  
  541.   { Always on top }
  542.   u := GetPrivateProfileInt(APPNAME,'OnTop',0,INIFILENAME);
  543.   if u <> 0 then
  544.   begin
  545.     CheckDlgButton(HWindow,iddlg_OnTop,1);
  546.     SetWindowPos(HWindow,HWND_TOPMOST,x,y,0,0,SWP_NOSIZE)
  547.   end
  548.   else
  549.     SetWindowPos(HWindow,0,x,y,0,0,SWP_NOZORDER or SWP_NOSIZE);
  550.  
  551.   { Logdatei }
  552.   u := GetPrivateProfileInt(APPNAME,'Logging',0,INIFILENAME);
  553.   if u <> 0 then CheckDlgButton(HWindow,iddlg_Logging,1);
  554.  
  555.   { Interval }
  556.   lInterval := GetPrivateProfileInt(APPNAME,'Interval',1000,INIFILENAME);
  557.   Str(lInterval,sz);
  558.   peInterval^.SetText(sz);
  559. end;
  560.  
  561. {-------------------------------------------------------------------------------
  562.   Schreibt die aktuellen Einstellungen in die INI-Datei.
  563. }
  564. procedure TMWindow.WriteINIData;
  565. var
  566.   rc : TRect;
  567.   s  : array[0..20] of Char;
  568. begin
  569.   { Position }
  570.   GetWindowRect(HWindow,rc);
  571.   Str(rc.Left,s);
  572.   WritePrivateProfileString(APPNAME,'XPos',s,INIFILENAME);
  573.   Str(rc.Top,s);
  574.   WritePrivateProfileString(APPNAME,'YPos',s,INIFILENAME);
  575.  
  576.   { Update Filehandles }
  577.   if IsDlgButtonChecked(HWindow,iddlg_HandleUpd) > 0 then
  578.     WritePrivateProfileString(APPNAME,'UpdateHandles','1',INIFILENAME)
  579.   else
  580.     WritePrivateProfileString(APPNAME,'UpdateHandles','0',INIFILENAME);
  581.  
  582.   { Always on top }
  583.   if IsDlgButtonChecked(HWindow,iddlg_OnTop) > 0 then
  584.     WritePrivateProfileString(APPNAME,'OnTop','1',INIFILENAME)
  585.   else
  586.     WritePrivateProfileString(APPNAME,'OnTop','0',INIFILENAME);
  587.  
  588.   { Logdatei }
  589.   if IsDlgButtonChecked(HWindow,iddlg_Logging) > 0 then
  590.     WritePrivateProfileString(APPNAME,'Logging','1',INIFILENAME)
  591.   else
  592.     WritePrivateProfileString(APPNAME,'Logging','0',INIFILENAME);
  593.  
  594.   { Interval }
  595.   peInterval^.GetText(s,SizeOf(s));
  596.   WritePrivateProfileString(APPNAME,'Interval',s,INIFILENAME);
  597. end;
  598.  
  599. {*******************************************************************************}
  600. { M A I N                                                                       }
  601. {*******************************************************************************}
  602. type  
  603.     TACApplication = object(TApplication)
  604.         procedure InitMainWindow; virtual;
  605.     end;
  606.  
  607.   procedure TACApplication.InitMainWindow;
  608.   begin
  609.       MainWindow := New(PMWindow, Init(nil, APPNAME));
  610.   end;
  611.  
  612. var
  613.     ThisApp : TACApplication;
  614.   hwndOld : HWnd;
  615.   hwndDlg : HWnd;
  616.  
  617. begin
  618.   { Wegen der Logdatei kann ALCHECK nur einmal gestartet werden. }
  619.   { ▄berprⁿfe, ob schon eine Instanz lΣuft. Wenn ja, bringe sie  }
  620.   { in den Vordergrund, ansonsten erzeuge eine neue Instanz.     }
  621.   hwndOld := FindWindow('BorDlgWin-ALCHECK',nil);
  622.   if hwndOld = 0 then
  623.   begin
  624.       ThisApp.Init(APPNAME);
  625.       ThisApp.Run;
  626.       ThisApp.Done;
  627.   end
  628.   else
  629.   begin
  630.     { Ist ein Popup-Window offen? Wenn ja, mu▀ dieses auch nach oben gebracht werden! }
  631.     hwndDlg := GetLastActivePopup(hwndOld);
  632.     BringWindowToTop(hwndOld);
  633.     if hwndDlg <> hwndOld then BringWindowToTop(hwndDlg);
  634.   end;
  635. end.
  636.