| Autor |
Beitrag |
LowSkills
 
Beiträge: 111
Windows XP
Delphi 6 Professional
|
Verfasst: Sa 28.07.07 15:23
Aloha!
Mal wieder was für euch... zum grübeln 
Ich habe eine (Ich hoffe) saubere Programmierung geleistet. Das Programm soll Serienmails auf der Basis von
1. Selbst geschriebenen oder geladenen Texten und
2. Daten aus einer AccessDB
verfassen.
Von den procedures und functions her sollte alles eigentlich (bisher wars so) fehlerfrei laufen. Aber - und jetzt kommt das große aber:
Der Speicher wird gesprengt:
Debuggermeldung: [...]OutOfMemory - Programm wird geschlossen.
Vorher bekomm ich von Windows die Meldung, dass mein virtueller Speicher nicht ausreicht und die Auslagerungsdatei vergrößert wird.
Zugegeben: Mein Rechner ist ne alte Krücke, aber ich kann ja nicht aus meiner Haut und das Progg muss an den Mann... 
Erstmal der QT:
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
22:
23:
24:
25:
26:
27:
28:
29:
30:
31:
32:
33:
34:
35:
36:
37:
38:
39:
40:
41:
42:
43:
44:
45:
46:
47:
48:
49:
50:
51:
52:
53:
54:
55:
56:
57:
58:
59:
60:
61:
62:
63:
64:
65:
66:
67:
68:
69:
70:
71:
72:
73:
74:
75:
76:
77:
78:
79:
80:
81:
82:
83:
84:
85:
86:
87:
88:
89:
90:
91:
92:
93:
94:
95:
96:
97:
98:
99:
100:
101:
102:
103:
104:
105:
106:
107:
108:
109:
110:
111:
112:
113:
114:
115:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
407:
408:
409:
410:
411:
412:
413:
414:
415:
416:
417:
418:
419:
420:
421:
422:
423:
424:
425:
426:
427:
428:
429:
430:
431:
432:
433:
434:
435:
436:
437:
438:
439:
440:
441:
442:
443:
444:
445:
446:
447:
448:
449:
450:
451:
452:
453:
454:
455:
456:
457:
458:
459:
460:
461:
462:
463:
464:
465:
466:
467:
468:
469:
470:
471:
472:
473:
474:
475:
476:
477:
478:
479:
480:
481:
482:
483:
484:
485:
486:
487:
488:
489:
490:
491:
492:
493:
494:
495:
496:
497:
498:
499:
500:
501:
502:
503:
504:
505:
506:
507:
508:
509:
510:
511:
512:
513:
514:
515:
516:
517:
518:
519:
520:
521:
522:
523:
524:
525:
526:
527:
528:
529:
530:
531:
532:
533:
534:
535:
536:
537:
538:
539:
540:
541:
542:
543:
544:
545:
546:
547:
548:
549:
550:
551:
552:
553:
554:
555:
556:
557:
558:
559:
560:
561:
562:
563:
564:
565:
566:
567:
568:
569:
570:
571:
572:
573:
574:
575:
576:
577:
578:
579:
580:
581:
582:
583:
584:
585:
586:
587:
588:
589:
590:
591:
592:
593:
594:
595:
596:
597:
598:
599:
600:
601:
602:
603:
604:
605:
606:
607:
608:
609:
610:
611:
612:
613:
614:
615:
616:
617:
618:
619:
620:
621:
622:
623:
624:
625:
626:
627:
628:
629:
630:
631:
632:
633:
634:
635:
636:
637:
638:
639:
640:
641:
642:
643:
644:
645:
646:
647:
648:
649:
650:
651:
652:
653:
654:
655:
656:
657:
658:
659:
660:
661:
662:
663:
664:
665:
666:
667:
668:
669:
670:
671:
672:
673:
674:
675:
676:
677:
678:
679:
680:
681:
682:
683:
684:
685:
686:
687:
688:
689:
690:
691:
692:
693:
694:
695:
696:
697:
698:
699:
700:
701:
702:
703:
704:
705:
706:
707:
708:
709:
710:
711:
712:
713:
714:
715:
716:
717:
718:
719:
720:
721:
722:
723:
724:
725:
726:
727:
728:
729:
730:
731:
732:
733:
734:
735:
736:
737:
738:
739:
740:
741:
742:
743:
744:
745:
746:
747:
748:
749:
750:
751:
752:
753:
754:
755:
756:
757:
758:
759:
760:
761:
762:
763:
764:
765:
766:
767:
768:
769:
770:
771:
772:
773:
774:
775:
776:
777:
778:
779:
780:
781:
782:
783:
784:
785:
786:
787:
788:
789:
790:
791:
792:
793:
794:
795:
796:
797:
798:
799:
800:
801:
802:
803:
804:
805:
806:
807:
808:
809:
810:
811:
812:
813:
814:
815:
816:
817:
818:
819:
820:
821:
822:
823:
824:
825:
826:
827:
828:
829:
830:
831:
832:
833:
834:
835:
836:
837:
838:
839:
840:
841:
842:
843:
844:
845:
846:
847:
848:
849:
850:
851:
852:
853:
854:
855:
856:
857:
858:
859:
860:
861:
862:
863:
864:
865:
866:
867:
868:
869:
870:
871:
872:
873:
874:
875:
876:
877:
878:
879:
880:
881:
882:
883:
884:
885:
886:
887:
888:
889:
890:
891:
892:
893:
894:
895:
896:
897:
898:
899:
900:
901:
902:
903:
904:
905:
906:
907:
908:
909:
910:
911:
912:
913:
914:
915:
916:
917:
918:
919:
920:
921:
922:
923:
924:
925:
926:
927:
928:
929:
930:
931:
932:
933:
934:
935:
936:
937:
938:
939:
940:
941:
942:
943:
944:
945:
946:
947:
948:
949:
950:
951:
952:
953:
954:
955:
956:
957:
958:
959:
960:
961:
962:
963:
964:
965:
966:
967:
968:
969:
970:
971:
972:
973:
974:
975:
976:
977:
978:
979:
980:
981:
982:
983:
984:
985:
986:
987:
988:
989:
990:
991:
992:
993:
994:
995:
996:
997:
998:
999:
1000:
1001:
1002:
1003:
1004:
1005:
1006:
1007:
1008:
1009:
1010:
1011:
1012:
1013:
1014:
1015:
1016:
1017:
1018:
1019:
1020:
1021:
1022:
1023:
1024:
1025:
1026:
1027:
1028:
1029:
1030:
1031:
1032:
1033:
1034:
1035:
1036:
1037:
1038:
1039:
1040:
1041:
1042:
1043:
1044:
1045:
1046:
1047:
1048:
1049:
1050:
1051:
1052:
1053:
1054:
1055:
1056:
1057:
1058:
1059:
1060:
1061:
1062:
1063:
1064:
1065:
| unit Unit6;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, ComCtrls, StdCtrls, ExtCtrls;
type
TSENDINGSTATS = class(TForm)
PN_IMPORTANT_ADVICE: TPanel;
IM_SECURITY: TImage;
LB_IMPORTANT_ADVICE: TLabel;
LB_IMPORTANT_ADVICE1: TLabel;
LB_IMPORTANT_ADVICE2: TLabel;
LB_IMPORTANT_ADVICE3: TLabel;
Panel1: TPanel;
PB_GESAMT: TProgressBar;
LB_PROGRESS_GESAMT: TLabel;
PB_NOW: TProgressBar;
LB_PROGRESS_NOW: TLabel;
RichEdit_SENDINGSTATS: TRichEdit;
MM_LogDatei: TMemo;
RichEdit_TEMP: TRichEdit;
MM_PrintOuts: TMemo;
Timer_Load: TTimer;
procedure FormActivate(Sender: TObject);
procedure GetEW;
procedure FailedRequest_Close;
procedure Server_zuweisen;
procedure Ansprechpartner;
procedure Mediadaten;
procedure VLG_Kombis;
procedure RelevanteVerlageErmitteln;
procedure BTP_oder_Prodigit;
procedure Anforderung_Durchfuehren;
procedure aktuellen_VLG_ermitteln;
procedure ausgabenliste_erstellen;
procedure Anhang_Ja_Nein;
procedure Ausgabenliste_Einfuegen;
procedure Verlagsliste_aktualisieren;
procedure Dokumentation;
procedure Fortschritt;
procedure GesamtFortschritt;
procedure BriefSpeichern;
procedure abschicken;
procedure PlainToHTML;
procedure Anhang_hinzufuegen;
procedure eMail_rausfinden;
procedure NoMailToPrint;
procedure Timer_LoadTimer(Sender: TObject);
procedure initilaize;
procedure connectT10;
procedure disconnectT10;
procedure connectT1001;
procedure disconnectT1001;
private
public
end;
var
SENDINGSTATS: TSENDINGSTATS;
CloseDatabase: boolean;
woe, mntl, Zwoe, Dwoe, Zxwoe, BTP_MAIL, PRODIGIT_MAIL : string;
MonthNameNow, MonthNamePast, MonthNamePast2, MonthNamePast3, MonthNamePast4 : string;
Sending_failed, btp: boolean;
Name, Tel, eMail: string;
Anrede: string;
MediadatenNr, ValidSince: string;
Anhang: boolean;
Listing: Text;
aktueller_VLG: string;
BE_ANZAHL, Verlagsanzahl: integer;
Fehler, Doku, Info, GesInfo: String;
AnzahlVerlage: integer;
SendViaMail: boolean;
eMailEmpfaenger: string;
SQLnichtda: boolean;
implementation
uses Unit2, PowerReceiver, ShlObj, ActiveX, uDatenaustausch, DateUtils,
uVerlagsgruppen, uProgress;
{$R *.dfm}
function GetSpecialFolder(iGUID: integer): string;
var
shellMalloc : IMalloc;
ppidl : PItemIdList;
begin
ppidl := nil;
try
if SHGetMalloc(shellMalloc) = NOERROR then
begin
SHGetSpecialFolderLocation(Form1.Handle, iGUID, ppidl);
SetLength(Result, MAX_PATH);
if not SHGetPathFromIDList(ppidl, PChar(Result)) then
raise exception.create('SHGetPathFromIDList failed : invalid pidl');
SetLength(Result, lStrLen(PChar(Result)));
end;
finally
if ppidl <> nil then
shellMalloc.free(ppidl);
end;
end;
procedure TSENDINGSTATS.VLG_Kombis;
var c, codesource: integer;
d, Codes: integer;
MainCode: string;
r: integer;
begin
For c:=1 to 50 do
begin
If FileExists(GetSpecialFolder($26)+'\Power Tools\VLG_DATA_'+IntToStr(c)+'.dat') then
begin
Verlagsgruppen.MM_SETTINGS_VLG.Lines.Clear;
Verlagsgruppen.MM_SETTINGS_VLG.Lines.LoadFromFile(GetSpecialFolder($26)+'\Power Tools\VLG_DATA_'+IntToStr(c)+'.dat');
Verlagsgruppen.ED_VERLAGSGRUPPENNAME.Text:=Verlagsgruppen.MM_SETTINGS_VLG.Lines[0];
Verlagsgruppen.CB_GENDER.ItemIndex:=StrToInt(Verlagsgruppen.MM_SETTINGS_VLG.Lines[1]);
Verlagsgruppen.ED_VLG_NAME.Text:=Verlagsgruppen.MM_SETTINGS_VLG.Lines[2];
Verlagsgruppen.ED_VLG_EMAIL.Text:=Verlagsgruppen.MM_SETTINGS_VLG.Lines[3];
Verlagsgruppen.ED_VLG_STRASSE.Text:=Verlagsgruppen.MM_SETTINGS_VLG.Lines[4];
Verlagsgruppen.ED_VLG_PLZ.Text:=Verlagsgruppen.MM_SETTINGS_VLG.Lines[5];
Verlagsgruppen.ED_VLG_ORT.Text:=Verlagsgruppen.MM_SETTINGS_VLG.Lines[6];
Codesource:=StrToInt(Verlagsgruppen.MM_SETTINGS_VLG.Lines[7]);
Verlagsgruppen.ListBox_VLG_CODES.Items.LoadFromFile(GetSpecialFolder($26)+'\Power Tools\VLG_DATA_'+IntToStr(Codesource)+'_CODES.dat');
Codes:=Verlagsgruppen.ListBox_VLG_CODES.Items.Count;
MainCode:=Verlagsgruppen.ListBox_VLG_CODES.Items[0];
For d:=1 to Codes-1 do
begin
Datenaustausch.ADOQueryVLG.Close;
Datenaustausch.ADOQueryVLG.SQL.Clear;
Datenaustausch.ADOQueryVLG.SQL.Text:='DELETE FROM [T1001 - Verlag] WHERE (([T1001 - Verlag].[Code Verlag]='+Verlagsgruppen.ListBox_VLG_CODES.Items[d]+'));';
Datenaustausch.AdoQueryVLG.ExecSQL;
end;
Datenaustausch.ADOQueryVLG.Close;
Datenaustausch.ADOQueryVLG.SQL.LoadFromFile(GetSpecialFolder($26)+'\Power Tools\SQL\VLGKombi.dat');
Datenaustausch.ADOQueryVLG.SQL.Add('WHERE (([T1001 - Verlag].[Code Verlag]='+MainCode+'));');
Datenaustausch.ADOQueryVLG.Open;
Datenaustausch.AdoQueryVLG.ExecSQL;
Datenaustausch.ADOQueryVLG.First;
Datenaustausch.ADOQueryVLG.Edit;
Datenaustausch.ADOQueryVLG.FieldValues['Name des Verlages']:=Verlagsgruppen.ED_VERLAGSGRUPPENNAME.Text;
Datenaustausch.ADOQueryVLG.UpdateRecord;
Datenaustausch.ADOQueryVLG.Edit;
Datenaustausch.ADOQueryVLG.FieldValues['PL-IX - Ansprechpartner']:=Verlagsgruppen.ED_VLG_NAME.Text;
Datenaustausch.ADOQueryVLG.UpdateRecord;
Datenaustausch.ADOQueryVLG.Edit;
Datenaustausch.ADOQueryVLG.FieldValues['Verlag Ort']:='KOMBI';
Datenaustausch.ADOQueryVLG.UpdateRecord;
ShowMessage('fertich');
end;
end;
end;
procedure TSENDINGSTATS.FormActivate(Sender: TObject);
var SQLNichtda: boolean;
begin
SENDINGSTATS.PB_GESAMT.Position:=0;
SENDINGSTATS.PB_NOW.Position:=0;
SENDINGSTATS.LB_PROGRESS_GESAMT.Caption:='';
SENDINGSTATS.LB_PROGRESS_NOW.Caption:='';
SENDINGSTATS.RichEdit_SENDINGSTATS.Clear;
If not DirectoryExists(GetSpecialFolder($26)+'\Power Tools\Temporary') then
begin
mkDir(GetSpecialFolder($26)+'\Power Tools\Temporary');
end;
If not DirectoryExists(GetSpecialFolder($26)+'\Power Tools\Temporary\Print') then
begin
mkDir(GetSpecialFolder($26)+'\Power Tools\Temporary\Print');
end;
If not DirectoryExists(GetSpecialFolder($26)+'\Power Tools\Documentations') then
begin
mkDir(GetSpecialFolder($26)+'\Power Tools\Documentations');
end;
If not DirectoryExists(GetSpecialFolder($26)+'\Power Tools\Documentations\'+DateToStr(Now)) then
begin
mkDir(GetSpecialFolder($26)+'\Power Tools\Documentations\'+DateToStr(Now));
end;
If not DirectoryExists(GetSpecialFolder($26)+'\Power Tools\Documentations\'+DateToStr(Now)+'\Anhänge') then
begin
mkDir(GetSpecialFolder($26)+'\Power Tools\Documentations\'+DateToStr(Now)+'\Anhänge');
end;
If not FileExists(GetSpecialFolder($26)+'\Power Tools\documentations\doc_'+DateToStr(Date)+'.dat') then
begin
SENDINGSTATS.RichEdit_SENDINGSTATS.Lines.SaveToFile((GetSpecialFolder($26)+'\Power Tools\documentations\doc_'+DateToStr(Date)+'.dat'));
end;
If Not FileExists(GetSpecialFolder($26)+'\Power Tools\Temporary\Log.dat') then
begin
SENDINGSTATS.MM_LogDatei.Lines.Clear;
SENDINGSTATS.MM_LogDatei.Lines[0]:='false';
SENDINGSTATS.MM_LogDatei.Lines.Add(IntToStr(Form1.TB_QUANTITY.Position));
SENDINGSTATS.MM_LogDatei.Lines.Add(Form1.ED_LOAD_BTP.Text);
SENDINGSTATS.MM_LogDatei.Lines.Add(Form1.ED_LOAD_PRODIGIT.Text);
SENDINGSTATS.MM_LogDatei.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Temporary\Log.dat');
end;
SENDINGSTATS.Timer_Load.Enabled:=true;
end;
procedure TSENDINGSTATS.initilaize;
begin
SENDINGSTATS.RelevanteVerlageErmitteln;
SENDINGSTATS.PB_GESAMT.Max:=2*AnzahlVerlage;
SENDINGSTATS.GetEW;
SQLnichtda:=false;
if not FileExists(GetSpecialFolder($26)+'\Power Tools\SQL\relevantVLG.dat') then SQLnichtda:=true;
if SQLnichtda = true then
begin
Fehler:='Es Fehlen SQL-Anweisungen. Das Programm wird geschlossen';
SENDINGSTATS.FailedRequest_Close;
end;
SENDINGSTATS.Anforderung_Durchfuehren;
end;
procedure TSENDINGSTATS.Anforderung_Durchfuehren;
var y : integer;
begin
SENDINGSTATS.PB_NOW.Max:=29;
For y:=0 to Verlagsanzahl do
begin
SENDINGSTATS.PB_NOW.Position:=0;
SENDINGSTATS.aktuellen_VLG_ermitteln;
GesInfo:='Erstelle eMail für Verlag '+aktueller_VLG+'...';
SENDINGSTATS.GesamtFortschritt;
SENDINGSTATS.connectT10;
SENDINGSTATS.BTP_oder_Prodigit;
SENDINGSTATS.ausgabenliste_erstellen;
SENDINGSTATS.Anhang_Ja_Nein;
SENDINGSTATS.Ausgabenliste_Einfuegen;
SENDINGSTATS.Mediadaten;
SENDINGSTATS.disconnectT10;
SENDINGSTATS.connectT1001;
SENDINGSTATS.eMail_rausfinden;
SENDINGSTATS.Ansprechpartner;
SENDINGSTATS.disconnectT1001;
If SendViaMail = true then
begin
SENDINGSTATS.abschicken;
end
else
begin
SENDINGSTATS.RichEdit_SENDINGSTATS.Lines.Add(TimeToStr(Now)+': Für Verlag '+aktueller_VLG+' ist keine eMail-Adresse hinterlegt. Die Datei wird gespeichert und nach der Versendung aller Mails ausgedruckt.');
SENDINGSTATS.NoMailToPrint;
end;
SENDINGSTATS.Verlagsliste_aktualisieren;
SENDINGSTATS.BriefSpeichern;
GesInfo:='eMail an Verlag '+aktueller_VLG+' erfolgreich erstellt und versendet... ermittle nächsten Verlag...';
SENDINGSTATS.GesamtFortschritt;
SENDINGSTATS.RichEdit_TEMP.Clear;
end;
If DirectoryExists(GetSpecialFolder($26)+'\Power Tools\Temporary') then
begin
end;
end;
procedure TSENDINGSTATS.GetEW;
begin
try
SENDINGSTATS.LB_PROGRESS_NOW.Caption:='Ermittle mögliche Erscheinungsweisen und deren Parameter...';
SENDINGSTATS.LB_PROGRESS_NOW.Refresh;
case MonthOfTheYear(now) of
1: begin
MonthNamePast4:='September';
MonthNamePast3:='Oktober';
MonthNamePast2:='November';
MonthNamePast:='Dezember';
MonthNameNow:='Januar';
end;
2: begin
MonthNamePast4:='Oktober';
MonthNamePast3:='November';
MonthNamePast2:='Dezember';
MonthNamePast:='Januar';
MonthNameNow:='Februar';
end;
3: begin
MonthNamePast4:='November';
MonthNamePast3:='Dezember';
MonthNamePast2:='Januar';
MonthNamePast:='Febraur';
MonthNameNow:='März';
end;
4: begin
MonthNamePast4:='Dezember';
MonthNamePast3:='Januar';
MonthNamePast2:='Februar';
MonthNamePast:='März';
MonthNameNow:='April';
end;
5: begin
MonthNamePast4:='Januar';
MonthNamePast3:='Februar';
MonthNamePast2:='März';
MonthNamePast:='April';
MonthNameNow:='Mai';
end;
6: begin
MonthNamePast4:='Februar';
MonthNamePast3:='März';
MonthNamePast2:='April';
MonthNamePast:='Mai';
MonthNameNow:='Juni';
end;
7: begin
MonthNamePast4:='März';
MonthNamePast3:='April';
MonthNamePast2:='Mai';
MonthNamePast:='Juni';
MonthNameNow:='Juli';
end;
8: begin
MonthNamePast4:='April';
MonthNamePast3:='Mai';
MonthNamePast2:='Juni';
MonthNamePast:='Juli';
MonthNameNow:='August';
end;
9: begin
MonthNamePast4:='Mai';
MonthNamePast3:='Juni';
MonthNamePast2:='Juli';
MonthNamePast:='August';
MonthNameNOw:='September';
end;
10: begin
MonthNamePast4:='Juni';
MonthNamePast3:='Juli';
MonthNamePast2:='August';
MonthNamePast:='September';
MonthNameNow:='Oktober';
end;
11: begin
MonthNamePast4:='Juli';
MonthNamePast3:='August';
MonthNamePast2:='September';
MonthNamePast:='Oktober';
MonthNameNow:='November';
end;
12: begin
MonthNamePast4:='August';
MonthNamePast3:='September';
MonthNamePast2:='Oktober';
MonthNamePast:='November';
MonthNameNow:='Dezember';
end;
end;
if form1.TB_QUANTITY.Position = 2 then
begin
woe:=', KW '+IntTostr(WeekOfTheYear(now)-2)+' und '+IntToStr(WeekOfTheYear(now)-1)+';';
mntl:=', Ausgaben '+MonthNamePast2+' und '+MonthNamePast+';';
Zxwoe:=', Ausgaben der KW '+IntTostr(WeekOfTheYear(now)-2)+' und '+IntToStr(WeekOfTheYear(now)-1)+';';
end else if form1.TB_QUANTITY.Position = 3 then
begin
woe:=', KW '+IntTostr(WeekOfTheYear(now)-3)+', '+IntTostr(WeekOfTheYear(now)-2)+', '+IntTostr(WeekOfTheYear(now)-1)+';';
mntl:=', Ausgaben '+MonthNamePast3+', '+MonthNamePast2+', '+MonthNamePast+';';
Zxwoe:=', Ausgaben der KW '+IntTostr(WeekOfTheYear(now)-3)+', '+IntTostr(WeekOfTheYear(now)-2)+', '+IntTostr(WeekOfTheYear(now)-1)+';';
end else if form1.TB_QUANTITY.Position = 4 then
begin
woe:=', KW '+IntTostr(WeekOfTheYear(now)-4)+', '+IntTostr(WeekOfTheYear(now)-3)+', '+IntTostr(WeekOfTheYear(now)-2)+', '+IntTostr(WeekOfTheYear(now)-1)+';';
mntl:=', Ausgaben '+MonthNamePast4+', '+MonthNamePast3+', '+MonthNamePast2+', '+MonthNamePast+';';
Zxwoe:=', Ausgaben der KW '+IntTostr(WeekOfTheYear(now)-4)+', '+IntTostr(WeekOfTheYear(now)-3)+', '+IntTostr(WeekOfTheYear(now)-2)+', '+IntTostr(WeekOfTheYear(now)-1)+';';
end;
Zwoe:=', letzte '+IntTostr(Form1.TB_QUANTITY.Position)+' Ausgaben;';
Dwoe:=', letzte '+IntTostr(Form1.TB_QUANTITY.Position)+' Ausgaben;';
SENDINGSTATS.RichEdit_SENDINGSTATS.Lines.Add(TimeToStr(Now)+': Die zu den möglichen Erscheinungsweisen gehörenden Parameter wurden erfolgreich ermittelt.');
SENDINGSTATS.LB_PROGRESS_NOW.Caption:='Mögliche Erscheinungsweisen und deren Parameter erfolgreich ermittelt...';
SENDINGSTATS.LB_PROGRESS_NOW.Refresh;
except
Fehler:='Es gab einen Fehler bei der KW-Ermittlung zur Erscheinungsweise. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.RelevanteVerlageErmitteln;
var Feldinhalt: string;
begin
try
SENDINGSTATS.PB_NOW.Position:=0;
SENDINGSTATS.PB_NOW.Max:=520;
SENDINGSTATS.LB_PROGRESS_NOW.Caption:='Ermittle relevante Verlage...';
SENDINGSTATS.LB_PROGRESS_NOW.Refresh;
Datenaustausch.AdoQuery.SQL.Clear;
Datenaustausch.ADOQuery.SQL.LoadFromFile(GetSpecialFolder($26)+'\Power Tools\SQL\relevantVLG.dat');
Datenaustausch.ADOQuery.Open;
Datenaustausch.ADOQuery.ExecSQL;
SENDINGSTATS.MM_LogDatei.Lines.Clear;
Datenaustausch.ADOQuery.First;
AnzahlVerlage:=Datenaustausch.ADOQuery.RecordCount;
Datenaustausch.ADOQuery.First;
While not Datenaustausch.ADOQuery.Eof do
begin
Feldinhalt:=Datenaustausch.ADOQuery.FieldValues['Code Verlag'];
SENDINGSTATS.MM_LogDatei.Lines.Add(Feldinhalt);
SENDINGSTATS.LB_PROGRESS_NOW.Caption:='Ermittlung relevanter Verlage... aktuell: Verlag Nr. '+Feldinhalt+'...';
SENDINGSTATS.LB_PROGRESS_NOW.Refresh;
SENDINGSTATS.PB_NOW.StepBy(1);
Datenaustausch.ADOQuery.Next;
end;
Datenaustausch.ADOQuery.Close;
SENDINGSTATS.LB_PROGRESS_NOW.Caption:='Ermittlung relevanter Verlage erfolgreich abgeschlossen...';
SENDINGSTATS.LB_PROGRESS_NOW.Refresh;
SENDINGSTATS.PB_NOW.Position:=0;
SENDINGSTATS.LB_PROGRESS_NOW.Caption:='';
SENDINGSTATS.MM_LogDatei.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Temporary\relevanteVLGs.dat');
except
Fehler:='Es ist ein Fehler bei der Ermittlung der relevanten Verlage aufgetreten. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.FailedRequest_Close;
begin
try
MessageDlg(Fehler,mtwarning,[mbOK],0);
SENDINGSTATS.RichEdit_SENDINGSTATS.Lines.Add(timetostr(now)+': '+Fehler);
SENDINGSTATS.RichEdit_SENDINGSTATS.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Documentations\doc_'+DateToStr(Date)+'.dat');
SENDINGSTATS.Close;
Form1.Close;
except
MessageDlg('Ein schwerwiegender Ausnahmefehler ist aufgetreten. Das Programm kann nicht Ordnungsgemäß beendet werden. Das Programm wird geschlossen.',mtwarning,[mbOK],0);
SENDINGSTATS.Close;
Form1.Close;
end;
end;
procedure TSENDINGSTATS.aktuellen_VLG_ermitteln;
begin
try
Info:='Ermittle aktuellen Verlag...';
Fortschritt;
SENDINGSTATS.MM_LogDatei.Lines.Clear;
If FileExists(GetSpecialFolder($26)+'\Power Tools\Temporary\relevanteVLGs.dat') then
begin
SENDINGSTATS.MM_LogDatei.Lines.LoadFromFile(GetSpecialFolder($26)+'\Power Tools\Temporary\relevanteVLGs.dat');
aktueller_VLG:=SENDINGSTATS.MM_LogDatei.Lines[0];
end;
Info:='Ermittlung des aktuellen Verlages erfolgreich abgeschlossen. Aktueller Verlag ist Verlag '+aktueller_VLG+'...';
Fortschritt;
except
Fehler:='Es gab einen Fehler bei der Ermittlung des aktuellen Verlages. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.BTP_oder_Prodigit;
begin
try
Info:='Ermittle, ob es sich um einen Partnerverlag handelt...';
Fortschritt;
Datenaustausch.ADOQueryVLG.First;
if Datenaustausch.ADOQueryVLG.FieldValues['Mitglied BTP?'] = 'True' then
begin
btp:=true;
Form1.MM_OVER.Lines.Clear;
Form1.MM_OVER.Text:=Form1.MM_DEVICE_BTP.Text;
end
else
begin
btp:=false;
Form1.MM_OVER.Lines.Clear;
Form1.MM_OVER.Text:=Form1.MM_DEVICE_PRODIGIT.Text;
end;
Info:='Ermittlung, ob es sich um einen Partnerverlag handelt erfolgreich abgeschlossen..';
Fortschritt;
except
Fehler:='Es gab einen Fehler während der Ermittlung des BTP-Verhältnisses. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSendingstats.Server_zuweisen;
var ServerIDFromRow: integer;
Area: string;
begin
try
Info:='Weise SMTP und POP3 Daten zu...';
Fortschritt;
Datenaustausch.AdoQueryVLG.SQL.Clear;
Datenaustausch.ADOQueryVLG.SQL.Text:='SELECT * FROM [T1001 - Verlag] WHERE (([T1001 - Verlag].[Code Verlag]='+aktueller_VLG+'));';
Datenaustausch.ADOQueryVLG.Open;
Datenaustausch.ADOQueryVLG.ExecSQL;
Datenaustausch.ADOQueryVLG.First;
Area:=Datenaustausch.ADOQueryVLG.FieldValues['Code BuLand'];
If Area = 'NW' then begin If btp = true Then ServerIDFromRow:=0 else ServerIDFromRow:=1; end;
If Area = 'NI' then begin If btp = true Then ServerIDFromRow:=2 else ServerIDFromRow:=3; end;
If Area = 'RP' then begin If btp = true Then ServerIDFromRow:=4 else ServerIDFromRow:=5; end;
If Area = 'HE' then begin If btp = true Then ServerIDFromRow:=6 else ServerIDFromRow:=7; end;
If Area = 'MV' then begin If btp = true Then ServerIDFromRow:=8 else ServerIDFromRow:=9; end;
If Area = 'SH' then begin If btp = true Then ServerIDFromRow:=10 else ServerIDFromRow:=11; end;
If Area = 'HB' then begin If btp = true Then ServerIDFromRow:=12 else ServerIDFromRow:=13; end;
If Area = 'HH' then begin If btp = true Then ServerIDFromRow:=14 else ServerIDFromRow:=15; end;
If Area = 'BE' then begin If btp = true Then ServerIDFromRow:=16 else ServerIDFromRow:=17; end;
If Area = 'BB' then begin If btp = true Then ServerIDFromRow:=18 else ServerIDFromRow:=19; end;
If Area = 'SN' then begin If btp = true Then ServerIDFromRow:=20 else ServerIDFromRow:=21; end;
If Area = 'ST' then begin If btp = true Then ServerIDFromRow:=22 else ServerIDFromRow:=23; end;
If Area = 'TH' then begin If btp = true Then ServerIDFromRow:=24 else ServerIDFromRow:=25; end;
If Area = 'BY' then begin If btp = true Then ServerIDFromRow:=26 else ServerIDFromRow:=27; end;
If Area = 'SL' then begin If btp = true Then ServerIDFromRow:=28 else ServerIDFromRow:=29; end;
If Area = 'BW' then begin If btp = true Then ServerIDFromRow:=30 else ServerIDFromRow:=31; end;
Info:='SMTP und POP3-Server zugewiesen...';
Fortschritt;
Info:='Ersetze eMail, Tel. und Name im Serienbrief...';
Fortschritt;
Name:=Form1.SG_INPUTSETTINGS.Cells[0,ServerIDFromRow];
Tel:=Form1.SG_INPUTSETTINGS.Cells[1,ServerIDFromRow];
eMail:=Form1.SG_INPUTSETTINGS.Cells[2,ServerIDFromRow];
Form1.IdSMTP.Password:=Form1.SG_INPUTSETTINGS.Cells[7,ServerIDFromRow];
Form1.IdSMTP.Port:=StrToInt(Form1.SG_INPUTSETTINGS.Cells[4,ServerIDFromRow]);
Form1.IdSMTP.Host:=Form1.SG_INPUTSETTINGS.Cells[3,ServerIDFromRow];
Form1.IdSMTP.UserId:=Form1.SG_INPUTSETTINGS.Cells[2,ServerIDFromRow];
Form1.IdSMTP.MailAgent:=Form1.SG_INPUTSETTINGS.Cells[3,ServerIDFromRow];
Form1.IdPOP3.Password:=Form1.SG_INPUTSETTINGS.Cells[7,ServerIDFromRow];
Form1.IdPOP3.Port:=StrToInt(Form1.SG_INPUTSETTINGS.Cells[6,ServerIDFromRow]);
Form1.IdPOP3.Host:=Form1.SG_INPUTSETTINGS.Cells[5,ServerIDFromRow];
Form1.IDPOP3.UserId:=Form1.SG_INPUTSETTINGS.Cells[2,ServerIDFromRow];
Datenaustausch.ADOQueryVLG.Close;
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{NAME DES ABSENDERS}',Name,[RfReplaceAll]);
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{DURCHWAHL DES ABSENDERS}',Tel,[RfReplaceAll]);
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{EMAIL DES ABSENDERS}',eMail,[RfReplaceAll]);
Info:='Alle Daten wurden erfolgreich zugewiesen...';
Fortschritt;
except
Fehler:='Es gab einen Fehler bei der Zuweisung der SMTP/POP3 Daten. Das Programm wird geschlossen';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Ansprechpartner;
begin
try
Info:='Ermittle Ansprechpartner...';
Fortschritt;
Datenaustausch.ADOQueryVLG.First;
if Datenaustausch.ADOQueryVLG.FieldValues['PL-IX - ID Anrede zum ASP'] = '0' then
begin
Anrede:='Sehr geehrte Damen und Herren,';
end
else
if Datenaustausch.ADOQueryVLG.FieldValues['PL-IX - ID Anrede zum ASP'] = '1' then
begin
Anrede:='Sehr geehrter Herr '+Datenaustausch.ADOQueryVLG.FieldValues['PL-IX - Ansprechpartner']+',';
end
else
if Datenaustausch.ADOQueryVLG.FieldValues['PL-IX - ID Anrede zum ASP'] = '2' then
begin
Anrede:='Sehr geehrte Frau '+Datenaustausch.ADOQueryVLG.FieldValues['PL-IX - Ansprechpartner']+',';
end;
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{ANREDE}',Anrede,[RfreplaceAll]);
Info:='Ansprechpartner erfolgreich ermittelt und ersetzt...';
Fortschritt;
except
Fehler:='Es gab einen Fehler bei der Ermittlung der Anrede. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Anhang_Ja_Nein;
begin
try
Info:='Ermittle Notwendigkeit des Anhangs...';
Fortschritt;
Datenaustausch.ADOQueryVLG.First;
Datenaustausch.ADOQueryVLG.RecordCount;
if Datenaustausch.ADOQueryVLG.RecordCount > 3 then
begin
Anhang:=true;
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{ART DES ERHALTS}','Im Anhang erhalten Sie',[RfreplaceAll]);
Info:='Ermittlung abgeschlossen, Anhang ist Notwendig';
Fortschritt;
end
else
begin
Anhang:=false;
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{ART DES ERHALTS}','Im folgenden erhalten Sie',[RfreplaceAll]);
Info:='Ermittlung abgeschlossen, ein Anhang ist nicht Notwendig';
Fortschritt;
end;
except
Fehler:='Es gab einen Fehler in der Ermittlung, ob die Auflistung im Anhang versendet werden soll. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.ausgabenliste_erstellen;
begin
try
Info:='Ermittlung Ausgaben und Erscheinungsweisen...';
Fortschritt;
Datenaustausch.ADOQueryVLG.First;
SENDINGSTATS.MM_LogDatei.Lines.Clear;
While not Datenaustausch.ADOQueryVLG.Eof do
begin
if Datenaustausch.ADOQueryVLG.FieldValues['ew'] = 'wö.' then begin SENDINGSTATS.MM_LogDatei.Lines.Add(Datenaustausch.ADOQueryVLG.FieldValues['Titel Ausgabe']+woe); end;
if Datenaustausch.ADOQueryVLG.FieldValues['ew'] = '2 x wö.' then begin SENDINGSTATS.MM_LogDatei.Lines.Add(Datenaustausch.ADOQueryVLG.FieldValues['Titel Ausgabe']+Zxwoe); end;
if Datenaustausch.ADOQueryVLG.FieldValues['ew'] = '14-tägig' then begin SENDINGSTATS.MM_LogDatei.Lines.Add(Datenaustausch.ADOQueryVLG.FieldValues['Titel Ausgabe']+Zwoe); end;
if Datenaustausch.ADOQueryVLG.FieldValues['ew'] = 'alle 3 W.' then begin SENDINGSTATS.MM_LogDatei.Lines.Add(Datenaustausch.ADOQueryVLG.FieldValues['Titel Ausgabe']+Dwoe); end;
if Datenaustausch.ADOQueryVLG.FieldValues['ew'] = 'mntl.' then begin SENDINGSTATS.MM_LogDatei.Lines.Add(Datenaustausch.ADOQueryVLG.FieldValues['Titel Ausgabe']+mntl); end;
Datenaustausch.ADOQueryVLG.Next;
end;
Info:='Ermittlung der Ausgaben und Erscheinungsweisen erfolgreich abgeschlossen...';
Fortschritt;
except
Fehler:='Es gab einen Fehler bei der Aufstellung der Ausgabenliste. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Ausgabenliste_Einfuegen;
begin
try
Info:='Füge dem Brief die Ausgabenliste hinzu...';
Fortschritt;
if Anhang = false then
begin
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{BELEGUNGSEINHEITEN}',SENDINGSTATS.MM_LogDatei.Text,[RfReplaceAll]);
end
else
begin
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{BELEGUNGSEINHEITEN}','',[RfReplaceAll]);
SENDINGSTATS.MM_LogDatei.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Temporary\Anh_'+aktueller_VLG+'.txt');
SENDINGSTATS.MM_LogDatei.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Documentations\'+DateToStr(Now)+'\Anhänge\'+aktueller_VLG+'.txt');
end;
Info:='Ausgabenliste wurde dem Brief erfolgreich hinzugefügt...';
Fortschritt;
except
Fehler:='Es gab einen Fehler beim Einfügen der Ausgabenliste. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Mediadaten;
begin
try
Info:='Ermittle Mediadatennummer und Gültigkeit...';
Fortschritt;
Datenaustausch.ADOQueryVLG.First;
MediadatenNr:=Datenaustausch.ADOQueryVLG.FieldValues['Tarif-Nr'];
ValidSince:=Datenaustausch.ADOQueryVLG.FieldValues['gültig ab'];
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{MEDIADATEN GELTEN SEIT}',ValidSince,[RfReplaceAll]);
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'{MEDIADATEN NR}',MediadatenNr,[RfReplaceAll]);
Info:='Ermittlung von Mediadaten und Gültigkeit erfolgreich abgeschlossen...';
Fortschritt;
except
Fehler:='Es gab einen Fehler bei der Ermittlung der Mediadaten. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end
end;
procedure TSENDINGSTATS.Verlagsliste_aktualisieren;
begin
try
Info:='Aktualisiere Liste relevanter Verlage...';
Fortschritt;
SENDINGSTATS.MM_LogDatei.Clear;
SENDINGSTATS.MM_LogDatei.Lines.Delete(0);
SENDINGSTATS.MM_LogDatei.Lines.LoadFromFile(GetSpecialFolder($26)+'\Power Tools\Temporary\relevanteVLGs.dat');
Info:='Aktualisierung der Verlagsliste erfolgreich abgeschlossen...';
Fortschritt;
except
Fehler:='Es gab einen Fehler bei der Überarbeitung der Liste aktueller Verlage. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Dokumentation;
begin
try
SENDINGSTATS.RichEdit_SENDINGSTATS.Lines.Add(Doku)
except
Fehler:='Es gab einen Fehler bei der Dokumentation. Das Programm wird geschlossen';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Fortschritt;
begin
try
SENDINGSTATS.LB_PROGRESS_NOW.Caption:=Info;
SENDINGSTATS.LB_PROGRESS_NOW.Refresh;
SENDINGSTATS.RichEdit_TEMP.Lines.Add(Info);
SENDINGSTATS.PB_NOW.StepBy(1);
except
Fehler:='Es gab einen Fehler bei der Anzeige des Fortschritts. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.GesamtFortschritt;
begin
try
SENDINGSTATS.LB_PROGRESS_GESAMT.Caption:=GesInfo;
SENDINGSTATS.LB_PROGRESS_GESAMT.Refresh;
SENDINGSTATS.PB_GESAMT.StepBy(1);
SENDINGSTATS.RichEdit_SENDINGSTATS.Lines.Add(GesInfo)
except
Fehler:='Es gab einen Fehler bei der Anzeige des Gesamtfortschritts. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.BriefSpeichern;
begin
try
Info:='Speichere den Brief...';
Fortschritt;
if Anhang= true then
begin
Form1.MM_OVER.Text:=StringReplace(Form1.MM_OVER.Text,'</h1>','<br><br><font color="red">Anhang: '+GetSpecialFolder($26)+'\Power Tools\Documentations\'+DateToStr(now)+'\Anhänge\'+aktueller_VLG+'.txt'+'</font></h1>',[rfReplaceAll]);
Form1.MM_OVER.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\documentations\'+DateToStr(Now)+'\'+aktueller_VLG+'.html');
end
else
begin
Form1.MM_OVER.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\documentations\'+DateToStr(Now)+'\'+aktueller_VLG+'.html');
end;
Info:='Der Brief wurde erfolgreich abgespeichert unter '+GetSpecialFolder($26)+'\Power Tools\documentations\'+DateToStr(Now)+'\'+aktueller_VLG+'.html...';
Fortschritt;
except
Fehler:='Es gab einenFehler beim Abspeichern des Briefes. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.PlainToHTML;
begin
try
Info:='Konvertiere Plain-Text ins HTML-Format...';
Fortschritt;
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,'ä','ä',[rfreplaceall]);
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,'ö','ö',[rfreplaceall]);
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,'ü','ü',[rfreplaceall]);
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,'Ä','Ä',[rfreplaceall]);
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,'Ö','Ö',[rfreplaceall]);
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,'Ü','Ü',[rfreplaceall]);
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,'ß','ß',[rfreplaceall]);
Form1.MM_Over.Text:=StringReplace(Form1.MM_Over.Text,#13,'<br>'+#13,[rfreplaceall]);
Info:='Konvertierung von Plain-Text ins HTML erfolgreich abgeschlossen...';
Fortschritt;
except
Fehler:='Ein Fehler ist bei der Konvertierung ins HTML-Format aufgetreten. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Anhang_hinzufuegen;
begin
try
If Anhang = true then
begin
Info:='Füge dem Schreiben einen Anhang hinzu...';
Fortschritt;
Info:='Erfolgreich abgeschlossen...';
Fortschritt;
end;
except
Fehler:='Ein Fehler ist beim Hinzufügen des Anhangs aufgetreten. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.eMail_rausfinden;
begin
try
Info:='Ermittle eMail-Adresse des Empfängers...';
Fortschritt;
Datenaustausch.ADOQueryVLG.First;
While Not Datenaustausch.ADOQueryVLG.Eof do
begin
eMailEmpfaenger:=Datenaustausch.ADOQueryVLG.FieldValues['PL-IX - eMail'];
end;
If eMailEmpfaenger = '' then
begin
SendViaMail:=False;
end
else
SendViaMail:=true;
Info:='Ermittlung der eMail-Adresse des Empfängers erfolgreich abgeschlossen...';
Fortschritt;
except
Fehler:='Es gab einen Fehler bei der Ermittlung der eMail-Adresse des Empfängers. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end
end;
procedure TSENDINGSTATS.abschicken;
begin
try
try
Info:='Versendung der eMail an '+eMailEmpfaenger+'...';
Fortschritt;
Form1.IdMessage1.Create(nil);
Form1.IdPOP3.Connect;
Form1.IdSMTP.Connect;
Form1.IdMessage1.From.Address:=eMail;
Form1.IdMessage1.Recipients.EMailAddresses:='h.ehrens@prodigit-online.de';
Form1.IdMessage1.Subject:=StringReplace(StringReplace(Form1.MM_OVER.Lines[12],'<!-- ','',[rfreplaceall]),' -->','',[rfreplaceall]);;
Form1.IdMessage1.Body.Text:=Form1.MM_OVER.Text;
Form1.IdSMTP.Send(IdMsg);
finally
FreeAndNil(Form1.IdMessage1);
Form1.IdSMTP.Disconnect;
Form1.IdPOP3.Disconnect;
Info:='Versendung der eMail an '+eMailEmpfaenger+' erfolgreich abgeschlossen...';
Fortschritt;
end;
except
Fehler:='Ein Fehler ist bei der Versendung der eMail an '+eMailEmpfaenger+' aufgetreten. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.NoMailToPrint;
begin
try
SENDINGSTATS.PB_NOW.Max:=SENDINGSTATS.PB_NOW.Max+2;
Info:='Bereite Druckvorlage vor...';
Fortschritt;
if FileExists(GetSpecialFolder($26)+'\Power Tools\Temporary\Print\printindex.dat') then
begin
SENDINGSTATS.MM_PrintOuts.Lines.Clear;
SENDINGSTATS.MM_PrintOuts.Lines.LoadFromFile(GetSpecialFolder($26)+'\Power Tools\Temporary\Print\printindex.dat');
SENDINGSTATS.MM_PrintOuts.Lines.Add(aktueller_VLG);
SENDINGSTATS.MM_PrintOuts.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Temporary\Print\printindex.dat');
end
else
begin
SENDINGSTATS.MM_PrintOuts.Lines.Clear;
SENDINGSTATS.MM_PrintOuts.Lines.Add(aktueller_VLG);
SENDINGSTATS.MM_PrintOuts.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Temporary\Print\printindex.dat');
end;
Form1.MM_OVER.Lines.SaveToFile(GetSpecialFolder($26)+'\Power Tools\Temporary\Print\'+aktueller_VLG+'.dat');
Info:='Die Druckvorlage wurde erfolgreich initialisiert...';
Fortschritt;
except
Fehler:='Ein Fehler trat bei der Bereitstellung der Druckvorlage für Verlag '+aktueller_VLG+' auf. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.Timer_LoadTimer(Sender: TObject);
var q: integer;
begin
if q < 10 then
begin
q:=q+1;
end
else
begin
SENDINGSTATS.Timer_Load.Enabled:=false;
SENDINGSTATS.initilaize;
end;
end;
procedure TSENDINGSTATS.connectT10;
begin
try
Datenaustausch.AdoQueryVLG.SQL.Clear;
Datenaustausch.ADOQueryVLG.SQL.Text:='SELECT * FROM [T10 - Belegungseinheiten] WHERE (([T10 - Belegungseinheiten].[Code Verlag]='+aktueller_VLG+'));';
Datenaustausch.ADOQueryVLG.Open;
Datenaustausch.ADOQueryVLG.ExecSQL;
except
Fehler:='Es gab einen Fehler beim Auslesen der Daten der T10 - Belegungseinheitentabelle. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.disconnectT10;
begin
try
Datenaustausch.AdoQueryVLG.Close;
except
Fehler:='Es gab einen Fehler beim Beenden der Verbindung zur T10 - Belegungseinheitentabelle. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.connectT1001;
begin
try
Datenaustausch.AdoQueryVLG.SQL.Clear;
Datenaustausch.ADOQueryVLG.SQL.Text:='SELECT * FROM [T1001 - Verlag] WHERE (([T1001 - Verlag].[Code Verlag]='+aktueller_VLG+'));';
Datenaustausch.ADOQueryVLG.Open;
Datenaustausch.ADOQueryVLG.ExecSQL;
except
Fehler:='Es gab einen Fehler beim Auslesen der Daten der T1001 - Verlagstabelle. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
procedure TSENDINGSTATS.disconnectT1001;
begin
try
Datenaustausch.AdoQueryVLG.Close;
except
Fehler:='Es gab einen Fehler beim Beenden der Verbindung zur T1001 - Verlagstabelle. Das Programm wird geschlossen.';
SENDINGSTATS.FailedRequest_Close;
end;
end;
end. |
Also, das ist der ganze (an dieser Stelle) Relevante Quelltext. Ich geh nicht davon aus, dass ihr das jetzt Stringweise analysiert habt, ist aber auch gar nicht nötig zur Klärung.
An welcher Stelle muss ich ansetzen, um meinem Speicher was gutes zu gönnen?
Kann ich variablen, die in ihrer schleife vorerst ihren Dienst geleistet haben, freigeben, ohne das sie, wenn sie in der Schleife wieder dran sind weg sind?
Wenn ja: Bringt das was bezüglich meines Problems?
Anderer Ansatz:
Würde es helfen, wenn ich nicht nach jeder Aktion was ins RichEdit schreiben und selbiges refreshen lasse? Wär schade, denn die Dokumentation wär mir schon wichtig. Need Help!
Weitere Ansätze:
Mit Start des Programms laden sich so einige (In zahlen: etwa 10) Forms. Zwei, eigentlich drei davon werden direkt benötigt, andere gar nicht: Aber sie sind halt da (invisible). Kann es helfen, wenn ich da nicht benötigte Forms (hart)schließe- also ganz weg. Wenn ja, kann ich (invisible)Forms schließen?
Ihr seht: Viele Dinge, eines wirrer als das andere und ich hoffe in meiner hoffnungslos-verzweifelt-naiv-geprägten art, das ihr mir helfen könnt.
Vielen Dank! _________________ Verstand ist eines der am besten verteilten Güter. Jeder denkt, er hätte genug davon.
Kein Problem widersteht lange dem Angriff beharrlichen Denkens.
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Sa 28.07.07 20:02
Dein Quälkot könnte an zahlreichen Stellen eine starke Optimierung vertragen. So z.B. bei der Server-Auswahl, bei den vergangenen Monaten, ... Das sieht mir sehr danach aus, dass Du vieles an Source immer wieder dupliziert hast. Entferne da erstmal die ganze Redundanz.
Ferner solltest Du mal schauen, an welchen Stellen der Speicher immer wieder reserviert wird. Ein häufiger Fehler ist es, bei Datenbanken Edit oder Insert aufzurufen, ohne mit Post abzuschließen. Ansonsten nutzte einfach mal FastMM4, der finde die wahrscheinlichen Fehlerquellen im Normalfall recht schnell.
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
LowSkills 
Beiträge: 111
Windows XP
Delphi 6 Professional
|
Verfasst: So 29.07.07 11:44
ja ja, ist ja schon gut Hab ja schon verstanden. Du magst mich also nicht
Spaß bei seite, bei den Monaten ist natürlich einiges machbar, ebenso an den Serverdingern. Wahrscheinlich hätte ich es auch schon lange geändert, wenn ich wüsste, wie.
Fakt ist, dass ich mittlerweile nur noch an zwei stellen die Datenbank öffne/schliesse, und nicht mehr wie vorher am beginn jeder Procedure, wie ihr ja da sehen könnt.
Werde heute mal versuchen müssen, ob es hilft, wenn ich die Doku reduziere, alternativ mal FastMM4...
Wenn jetzt noch einer so freundlich wäre: Was ist fastmm4??? o.0
Vielen Dank schonmal. _________________ Verstand ist eines der am besten verteilten Güter. Jeder denkt, er hätte genug davon.
Kein Problem widersteht lange dem Angriff beharrlichen Denkens.
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: So 29.07.07 12:48
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
LowSkills
Beiträge: 111
Windows XP
Delphi 6 Professional
|
Verfasst: Mo 30.07.07 21:16
Ja ja, ich bins wieder. 
Auch auf die Gefahr hin, dass ich jetzt wieder einmal einen auf den Deckel bekomme:
Google ist nicht mein Freund! Wir haben uns zerstritten und seit einiger Zeit mit dem Allerwertesten nicht mehr angeschaut.
Spaß bei Seite: Ich bin brav deinem Link gefolgt, BenBE, habe mir dann auch die 4. Revision der Fastmm4 dinger runtergeladen. Leider gehöre ich zu den Menschen, die sich schwer damit tun, etwas zu installieren, das nicht mit einer install.exe daherkommt. Fürderhin gestaltet es sich als schwierig, etwas zu installieren, dass ohne install.exe daherkommt und dessen ReadMe nicht viel Aufschluß bringt bezüglich Fragen wie How-to-install oder so.
Natürlich habe ich mich umgehend bei google informieren wollen, wie man das denn installiert, zu meinem allergrößten Bedauern musste ich allerdings resignierend feststellen, dass Google kein besonders guter Freund von mir ist.
Könnt mir da nochmal jemand helfen?
Bidde...?! _________________ Verstand ist eines der am besten verteilten Güter. Jeder denkt, er hätte genug davon.
Kein Problem widersteht lange dem Angriff beharrlichen Denkens.
|
|
BenBE
Beiträge: 8721
Erhaltene Danke: 191
Win95, Win98SE, Win2K, WinXP
D1S, D3S, D4S, D5E, D6E, D7E, D9PE, D10E, D12P, DXEP, L0.9\FPC2.0
|
Verfasst: Mo 30.07.07 21:53
Naja ... ne Install brauch das auch nicht wirklich. Es sollte reichen alle Dateien, die irgendwie nach Source, oder so ähnlich aussehen, mit in dein Projekt-Verzeichnis zu entpacken, dann in deiner DPR-Datei (Projekt --> Quelltext anzeigen) als erste Unit FastMM4, (vor allen anderen) zu ergänzen und dein Projekt neu zu erstellen.
Ggf. musst Du mal kurz die Unit FastMM4.pas öffnen und ein wenig im Kopf lesen und ein paar Compiler-Schalter deinen bedürfnissen anpassen.
_________________ Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.
|
|
Sinspin
Beiträge: 1335
Erhaltene Danke: 118
Win 10
RIO, CE, Lazarus
|
Verfasst: Mo 30.07.07 22:21
du brauchst die folgenden dateien in deinem projektverzeichnis.
FastMM4.pas
FastMM4Options.inc
FastMM4Messages.pas
die FastMM4Messages.pas gibt es ettliche male. und zwar für so ziemlich jede bekanntere landesprache eine.
du holst dir am besten die aus ".\Translations\German\". mit dem meldungen kann mann dann wenigstens was anfangen.
startest du dann den programm über delphi, arbeitest damit und beendest es wieder so findet sich nach dem ende eine textdatei im verzeichnis deiner exe. wenn du glück hast siehst du die ergebnisse aber schon direkt nach dem programm ende in einem fenster (ich hatte noch nicht das glück)
zu deinem quelltext.
jeder fängt mal "klein" an. ich habe früher auch mal solche quelltexte geschrieben. jetzt würden mich solche redundanzen nicht mehr schlafen lassen. 
ansonsten kann ich nichts finden. ist bei dem quelltextumfang auch nicht so einfach. zumal man das ganze ja nicht ausführen kann um mal das laufzeitverhalten beobachten zu können.
was ich mal ganz genau unter die lupe nehmen würde ist die procedure VLG_Kombis.
ansonsten kann ich nur sagen. einfach mal im FMM den FullDebugMode anschalten und schauen was kommt.
allerdings musst du dazu noch die FastMM_FullDebugMode.dll in dein porgrammverzeichnis kopieren. _________________ Wir zerstören die Natur und Wälder der Erde. Wir töten wilde Tiere für Trophäen. Wir produzieren Lebewesen als Massenware um sie nach wenigen Monaten zu töten. Warum sollte unser aller Mutter, die Natur, nicht die gleichen Rechte haben?
|
|
LowSkills
Beiträge: 111
Windows XP
Delphi 6 Professional
|
Verfasst: Di 31.07.07 10:26
Dankeschön. Werd das heute ode morgen mal in Angriff nehmen und hoffen, dass sich was tut.
Im übrigen hast du recht, wenn du sagst, du würdest die procedure VLG_Kombis nochmal unter die Lupe nehmen. Werd ich auch, die funzt nähmlich noch nicht so ganz, wie ich das will. Aber das krieg ich hin. Mit dem Laufzeitverhalten allerdings kann das ja nichts zu tun haben, die ist nähmlich noch gar nicht "on", also scharf geschaltet, fals man das so sagen kann. Werd heut mal schauen, ob ich nen größeren Arbeitsspeicher besorgen kann. Mit 512 MB-Ram ist man ja heute so oder so das ende der Nahrungskette. Vielleicht hilft das ja schon. Muss ich allerdings auch schon wieder in Frage stellen.
Denn: Wenn ich, wie ich feststellen muss, bereits beim ersten Verlag Out Of Memory gerate, könnte es auch bei größerem Speicher problematisch werden, bedenkt man, das die Schleife insgesamt fast 520 Verlage durchläuft.
Da ich allerdings nicht weis, ob die Speicheranforderung ihr Max erreicht, wenn sie das erste mal durchgelaufen ist, kann ich auch nicht sagen, ob der Speicher dannach in trockenen Tüchern wäre und somit Problemlos die andern 519 Verlage durchlaufen würde.
Ich weiss ja nicht, ob der dann bei Verlag noch mehr speicher Verlangt. dann wäre ja auch bei einem riesen Speicher spätestens nach zehn verlagen schluss, net oder?
Vielen Dank aber nochmal an Dich SinSpin, dass du dich so ausführlich mit dem Quellcode auseinandergesetzt hast. Werd später oder morgen mal den aktuellen Quellcode posten, wie er nach dem neuesten Feinschliff aussieht.
Danke schonmal wieder im Vorraus. Und scheut euch nicht, ruhig weiter fleißig lösungsansätze zu finden/posten.
Was würde ich nur ohne euch machen?! _________________ Verstand ist eines der am besten verteilten Güter. Jeder denkt, er hätte genug davon.
Kein Problem widersteht lange dem Angriff beharrlichen Denkens.
|
|
|
GOOGLE HILFT