[Announce] "Check_Last_PurgeDate_include" Stand: 25.04.08

25/04/2008 - 18:12 von Thomas Barghahn | Report spam
Hallo zusammen,

wie Joachim Reiter in
Message-ID: <suvqr1opa0rq$.dlg@joachimreiter.my-fqdn.de>
schon angemerkt hat, funktioniert das o.g. Script mit einem "Sleep" so
nicht!

Wir hatten solch eine Diskussion bezüglich des "Wartens" in
Programmablàufen hier vor Jahren schon einmal. Maik Prinz hatte schon
damals hier eine API-Funktion vorgestellt, mit welcher ein echtes
"Warten" bis zum nàchsten Programmpunkt möglich ist.
(siehe: "GetTickCount" in
Message-ID: <200408.dcs4-d.855.dlg@news.2prinz.de>)

Diese Funktion wurde nun auch im Script "Check_Last_PurgeDate_include"
übernommen und funktioniert tadellos. :-)

Beim Start von Dialog beginnt das Aufràumen (wenn nötig) und im
"Hintergrund" "wartet" der "DBReminder" die ihm zugewiesene Zeit ab! :-)

Also: "Alles auf Null und noch einmal"! ;-)
Aus der zuletzt ernannten "function" wird nun doch wieder eine
"procedure"! ;-)

++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++

File: "Check_last_PurgeDate_include.ds"

Dieser befindet sich im Verzeichnis:
"..\40tude_Dialog\Scripts\Custom\"


procedure Init_Check_Last_PurgeDate ( var FileName : String;
var Wait : LongInt
);

begin
// -
// Configuration settings
// -

// Autor : Kai J?rges
// Date : 2008/04/25

// Dateiname zum Speichern, Pfad selbst anpassen!
// !!Diese Datei wird automatisch angelegt!!
FileName := 'C:\Programme\40tude_Dialog\lastpurge.tmp';

// Zeit, welche das Aufràumen ungefàhr benötigt
// Zeit in Sekunden
Wait := 8;

// -
// End of configuration settings
// -

end;

// //
// - No user maintainable parts below this line -- //
// //

procedure SaveLastPurgeDate (FileName : string);

// Aktuelles Datum in Datei speichern
var
f : Textfile;

begin
AssignFile(f, FileName);
Rewrite(f);
TextWriteln(f, DateToStr(Date));
CloseFile(f);
end; // procedure SaveLastPurgeDate

function CheckLastPurgeDate (FileName : String
) : Boolean;

// Pruefe, ob heute schon ein Purge durchgefuehrt wurde
// Wenn ja: true
// Wenn nein: false
// Wenn Datei nicht existiert: false
var
f : TextFile;
tmp : String;

begin
if fileexists(fileName) then begin
AssignFile(f, fileName);
Reset(f);
TextReadln(f, tmp)
CloseFile(f);
if DateToStr(Date) = tmp then begin
result := true;
end
Else begin
result := false;
end;
end
Else
result := false;
end; // function CheckLastPurgeDate

function GetTickCount : cardinal; external 'GetTickCount@kernel32.dll stdcall';

procedure Delay(const Milliseconds: Word);
var DelayTill: LongWord;

begin
DelayTill := GetTickCount + Milliseconds;
while ((GetTickCount) < DelayTill) do begin
Application.ProcessMessages;
Sleep(0);
end;
end;

procedure Check_Last_PurgeDate;

var
FileName : String;
Wait : LongInt;
begin
Init_Check_Last_PurgeDate (FileName, Wait);
// Heute schon Purge durchgefuehrt?
if Not CheckLastPurgeDate (FileName) then begin
// PURGE durchfuehren
ADo('PurgeSubscribedGroups');
Wait := Wait * 1000;
Delay (Wait);
// Datum speichern
SaveLastPurgeDate (FileName);
end;
end;


So *könnte* das Ereignisscript "OnStartUp" aussehen:


program OnStartup;

uses Forms,TextFile;

{$I DBReminder_include.ds}
{$I Check_Last_PurgeDate_include.ds}

procedure OnStartup;
begin
//Your code goes here
lockdisplay;
try
ADo('CollapseAllThreads');
finally
unlockdisplay;
end; // try - finally
Check_Last_PurgeDate;
//remind to compact DB
DatabaseReminder;
end;

begin
end.


Zum Schluss sind die Settings im IncludeFile anzupassen und das
Ereignisscript "OnStartUp" *muss unbedingt* kompiliert werden!

Freundliche Grüße
Thomas Barghahn
+++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++ +++
Paulus sprach zu den Apachen:
"Ihr sollt nicht nach der Predigt klatschen!"
(Otto)
 

Lesen sie die antworten

#1 Joachim Reiter
25/04/2008 - 19:04 | Warnen spam
_Thomas Barghahn_ tat am 25.04.2008 18:12 Uhr dies kund:

Hallo zusammen,

wie Joachim Reiter in
Message-ID: <suvqr1opa0rq$
schon angemerkt hat, funktioniert das o.g. Script mit einem "Sleep" so
nicht!

Wir hatten solch eine Diskussion bezüglich des "Wartens" in
Programmablàufen hier vor Jahren schon einmal. Maik Prinz hatte schon
damals hier eine API-Funktion vorgestellt, mit welcher ein echtes
"Warten" bis zum nàchsten Programmpunkt möglich ist.
(siehe: "GetTickCount" in
Message-ID: )



Hierfuer moechte ich mich ueber diesen Weg auch insbes. bei @Maik herzlich
bedanken, denn...

Diese Funktion wurde nun auch im Script "Check_Last_PurgeDate_include"
übernommen und funktioniert tadellos. :-)

Beim Start von Dialog beginnt das Aufràumen (wenn nötig) und im
"Hintergrund" "wartet" der "DBReminder" die ihm zugewiesene Zeit ab! :-)

Also: "Alles auf Null und noch einmal"! ;-)
Aus der zuletzt ernannten "function" wird nun doch wieder eine
"procedure"! ;-)



[Include- u. OnStartup-Script...]

das nun endlich funktioniert und nach von mir gemachten Einstellungen genau
das ist, wie ich es mir vorgestellt hatte :-))

Herzlichen Dank, Thomas (u. wie erwaehnt an Maik und ebenso nochmals an Kai)
und willkommen im WE ;-)

Danke und Gruss... Joachim
,--.
| Antworten an mich, solange nicht gewünscht oder ausdrücklich |
| gewollt nur in der jeweiligen NG, nicht per Mail!!! Danke! |
'--'

Ähnliche fragen