AGB  ·  Datenschutz  ·  Impressum  







Anmelden
Nützliche Links
Registrieren
Zurück Delphi-PRAXiS Programmierung allgemein Win32/Win64 API (native code) Programm stürzt nach mehren Stunden Laufzeit ab.

Programm stürzt nach mehren Stunden Laufzeit ab.

Ein Thema von gee21 · begonnen am 2. Sep 2021 · letzter Beitrag vom 22. Sep 2021
Antwort Antwort
Seite 1 von 3  1 23   
gee21

Registriert seit: 3. Jan 2013
199 Beiträge
 
Delphi 10.4 Sydney
 
#1

Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 2. Sep 2021, 13:58
Hallo.

Ich habe ein Programm geschrieben das auf einem FTP Server PDF Dateien herunterlädt und an den richtigen Drucker senden soll.
Es gibt 4 Verzeichnisse auf dem ftp server. je nach dem in welchen Verzeichniss das pdf file liegt, gebe ich es dann an den "passenden" drucker weiter.

Grundsätzlich funktioniert alles so wie es soll... ABER nach 5-8 stunden stürzt das Tool meistens ab (friert ein). Im Log sehe ich meistens das es sich um ein verbindungsproblem zum server handelt (read timed out)... jedoch habe ich die ftp geschichte ins TRY / EXCEPT getan damit bei einem Fehler einfach eine neue Verbindung / ein neuer versuch gestartet wird. (wäre zumindest das ziel).

Wenn ich das programm laufen lasse und dann beispielsweise das LAN KABEL ausstecke... so erhalte ich ebenfalls die Meldung: Read Timed Out oder Connection reset by peer... wenn ich das LAN kabel dann wieder einstecke, funktioniert alles wieder normal... (also so beim Test passiert auch alles so wie es soll).


HAT VIELEICHT JEMAND EINE IDEE an was es liegen könnte das es mehrere stunden funktioniert und dann plötzlich einfriert? (Im Taskmanager wenn mein tool läuft, ist CPU, RAM und Festplatennutzung der project.exe "normal")
Würde es helfen die FTP geschichte in einem seperaten Thread laufen zu lassen?




Delphi-Quellcode:
unit main;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, IdIOHandler, IdIOHandlerSocket,
  IdIOHandlerStack, IdSSL, IdSSLOpenSSL, IdBaseComponent, IdComponent,
  IdTCPConnection, IdTCPClient, IdExplicitTLSClientServerBase, IdFTP,
  Vcl.StdCtrls, Vcl.ComCtrls, Vcl.ExtCtrls, system.IOUtils, shellapi, Vcl.Menus;

type
  TForm1 = class(TForm)
    IdFTP1: TIdFTP;
    IdSSLIOHandlerSocketOpenSSL1: TIdSSLIOHandlerSocketOpenSSL;
    Memo_Log: TMemo;
    Edit_Host: TEdit;
    Edit_User: TEdit;
    Edit_Password: TEdit;
    Edit_Port: TEdit;
    Edit_LS: TEdit;
    Edit_RE: TEdit;
    Edit_ET1: TEdit;
    Edit_ET2: TEdit;
    Edit_verbindungsDAUER: TEdit;
    Label1: TLabel;
    Timer1_dauer_Counter: TTimer;
    ProgressBar_VerbindungsZeit: TProgressBar;
    CheckBox_DebugLog: TCheckBox;
    Button_start_action: TButton;
    Edit_update_pause: TEdit;
    Label2: TLabel;
    timer_restarter: TTimer;
    Edit_pause_wiederverbindung: TEdit;
    Label3: TLabel;
    CheckBox_verstecke_cmd: TCheckBox;
    Label4: TLabel;
    Edit_druck_pause: TEdit;
    Button_STOP: TButton;
    Edit_rechnungen_max: TEdit;
    Edit_papierfach_max: TEdit;
    Label_rechnung_aktuell: TLabel;
    Label_Papier_aktuell: TLabel;
    Label5: TLabel;
    Label6: TLabel;
    CheckBox_tray: TCheckBox;
    CheckBox_autostart: TCheckBox;
    TrayIcon1: TTrayIcon;
    PopupMenu1: TPopupMenu;
    ffneprogramm1: TMenuItem;
    Timer1autominimize: TTimer;
    Label7: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    Label10: TLabel;
    Button_zähler_auf_null: TButton;
    CheckBox_papierzähler: TCheckBox;
    PopupMenu2: TPopupMenu;
    Loglschen1: TMenuItem;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    edit_pause_zwischen_directories: TEdit;
    CheckBox_SSL: TCheckBox;
    procedure Timer1_dauer_CounterTimer(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure Button_start_actionClick(Sender: TObject);
    procedure timer_restarterTimer(Sender: TObject);
    procedure Button_STOPClick(Sender: TObject);
    procedure ffneprogramm1Click(Sender: TObject);
    procedure FormResize(Sender: TObject);
    procedure TrayIcon1Click(Sender: TObject);
    procedure TrayIcon1DblClick(Sender: TObject);
    procedure CheckBox_trayClick(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure Timer1autominimizeTimer(Sender: TObject);
    procedure Button_zähler_auf_nullClick(Sender: TObject);
    procedure Loglschen1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  stop_op,progress_running: boolean;
  programmpfad: string;
  papierfach, rechnungsfach: integer;
  ts_log: tstringlist;
implementation

{$R *.dfm}

procedure addline (s: string);
var
i: integer;
 begin
    try
    form1.Memo_Log.Lines.Add(datetimetostr(now)+': '+S);

     if form1.Memo_Log.Lines.Count>5000 then begin

      if tfile.Exists (programmpfad+'log_OLD.txt') then begin
      ts_log.loadfromfile (programmpfad+'log_OLD.txt');

       if ts_log.Count>20000 then begin
       ts_log.Clear;
       ts_log.Add(Datetimetostr(now)+' Altes Log wurde automatisch zurückgesetzt da über 20 000 zeilen.')
       end;

      for I := 0 to form1.Memo_Log.Lines.Count-1 do ts_log.Add(form1.Memo_Log.Lines[i]);

      end;
     form1.Memo_Log.Lines.SaveToFile(programmpfad+'log_OLD.txt');
     form1.Memo_Log.Clear;
     end;

     form1.Memo_Log.Lines.SaveToFile(programmpfad+'log.txt');

    except on e:exception do form1.Memo_Log.Lines.Add('Fehler beim speichern des Log Files: '+e.Message); end;
 end;

 procedure Addline_Debug (S:String);
 var
 i: integer;
 begin
  if form1.CheckBox_DebugLog.Checked=true then begin
      form1.Memo_Log.Lines.Add(datetimetostr(now)+'_DEBUG: '+S);
      if form1.Memo_Log.Lines.Count>5000 then begin

       if tfile.Exists (programmpfad+'log_OLD.txt') then begin
       ts_log.loadfromfile (programmpfad+'log_OLD.txt');

        if ts_log.Count>20000 then begin
        ts_log.Clear;
        ts_log.Add(Datetimetostr(now)+' Altes Log wurde automatisch zurückgesetzt da über 100000 zeilen.')
        end;

        for I := 0 to form1.Memo_Log.Lines.Count-1 do ts_log.Add(form1.Memo_Log.Lines[i]);
       end;
      form1.Memo_Log.Lines.SaveToFile(programmpfad+'log_OLD.txt');
      form1.Memo_Log.Clear;
      end;
     form1.Memo_Log.Lines.SaveToFile(programmpfad+'log.txt');
     end;
  end;


procedure savesettings;
var
ts: tstringlist;
begin
  try
  ts:=tstringlist.Create;
  ts.Add(form1.Edit_Host.Text);
  ts.Add(form1.Edit_User.Text);
  ts.Add(form1.Edit_Password.Text);
  ts.Add(form1.Edit_Port.Text);
  TS.Add(Form1.Edit_LS.Text);
  TS.Add(Form1.Edit_RE.Text);
  TS.Add(Form1.Edit_ET1.Text);
  TS.Add(Form1.Edit_ET2.Text);
  TS.Add(Form1.Edit_verbindungsdauer.Text);
  TS.Add(Form1.Edit_update_pause.Text);
  TS.Add(Form1.Edit_pause_wiederverbindung.Text);
  TS.Add(Form1.Edit_druck_pause.Text);
  TS.Add(Form1.Edit_rechnungen_max.Text);
  TS.Add(Form1.Edit_papierfach_max.Text);
  if form1.CheckBox_tray.Checked=false then ts.Add('tray:off') else ts.Add('tray:on');
  if form1.CheckBox_autostart.Checked=false then ts.Add('autostart:off') else ts.Add('autostart:on');
  if form1.CheckBox_DebugLog.Checked=false then ts.Add('debug:off') else ts.Add('debug:on');
  if form1.CheckBox_verstecke_cmd.Checked=false then ts.Add('hidecmd:off') else ts.Add('hidecmd:on');
  ts.Add(inttostr(papierfach));
  ts.Add(inttostr(rechnungsfach));
  ts.Add(form1.edit_pause_zwischen_directories.text);
  ts.SaveToFile(programmpfad+'settings.txt');
  ts.Free;
  except on e:exception do
  addline('Fehler beim speichern der Einstellungen: '+e.message);
   end;
  end;


procedure loadsettings;
var
ts: tstringlist;
begin
ts:=tstringlist.Create;
if tfile.Exists(programmpfad+'settings.txt') then begin
   ts.LoadFromFile(programmpfad+'settings.txt');
   form1.Edit_Host.Text:=ts.strings[0];
   form1.Edit_User.Text:=ts.strings[1];
   form1.Edit_Password.Text:=ts.strings[2];
   form1.Edit_Port.Text:=ts.strings[3];
   form1.Edit_LS.Text:=ts.strings[4];
   form1.Edit_RE.Text:=ts.strings[5];
   form1.Edit_ET1.Text:=ts.strings[6];
   form1.Edit_ET2.Text:=ts.strings[7];
   form1.Edit_verbindungsdauer.Text:=ts.strings[8];
   form1.Edit_update_pause.Text:=ts.strings[9];
   form1.Edit_pause_wiederverbindung.Text:=ts.strings[10];
   form1.Edit_druck_pause.Text:=ts.strings[11];
   form1.Edit_rechnungen_max.Text:=ts.strings[12];
   form1.Edit_papierfach_max.Text:=ts.strings[13];
   if ts.Strings[14]='tray:offthen form1.CheckBox_tray.Checked:=false;
   if ts.Strings[15]='autostart:offthen form1.CheckBox_autostart.Checked:=false;
   if ts.Strings[16]='debug:offthen form1.CheckBox_DebugLog.Checked:=false;
   if ts.Strings[17]='hidecmd:offthen form1.CheckBox_verstecke_cmd.Checked:=false;
   papierfach:=strtoint(ts.Strings[18]);
   rechnungsfach:=strtoint(ts.Strings[19]);
   form1.Label_rechnung_aktuell.Caption:=ts.Strings[19];
   form1.Label_Papier_aktuell.Caption:=ts.Strings[18];
   try form1.edit_pause_zwischen_directories.text:=ts.Strings[20]; except end;
 end;
  ts.Free;
end;


procedure ftpverbinden ;
begin
 if form1.IdFTP1.Connected=false then begin
  try
  form1.ProgressBar_VerbindungsZeit.max:=strtoint(form1.Edit_verbindungsDAUER.Text);
  form1.ProgressBar_VerbindungsZeit.Position:=strtoint(form1.Edit_verbindungsDAUER.Text);
  form1.IdFTP1.Username:= form1.Edit_User.Text;
  form1.IdFTP1.Password:= form1.Edit_Password.Text;
  form1.IdFTP1.Port:= strtoint(form1.Edit_Port.Text);
  form1.IdFTP1.Host:= form1.Edit_Host.Text;
  form1.Timer1_dauer_Counter.enabled:=true;
  form1.IdFTP1.Connect;
  addline_debug('FTP Verbindung hergestellt');
  except on e:exception do addline('Fehler während Verbindungsaufbau: '+e.Message) end;
 end else addline('FTP Verbindung sollte aufgebaut werden ist aber bereits aufgebaut.');
end;


procedure ftp_trennen;
begin
 try
  if form1.IdFTP1.Connected=true then begin
  form1.IdFTP1.Disconnect;
  addline_debug('FTP Erfolgreich getrennt');
  end;

  except on e:exception do begin
   addline('Fehler beim trennen der FTP Verbidung: '+e.Message);
   try form1.IdFTP1.Disconnect except end;
  end;
 end;
end;


procedure ftp_directory_change (S:String);
begin
sleep(strtoint(form1.edit_pause_zwischen_directories.text)*1000);
try
form1.IdFTP1.ChangeDir(s);
addline_debug('ftp directory change ok: '+s);
except on e:exception do addline('Fehler beim Directory change: '+e.message) end;
end;

procedure PrinServer_action;
var
i: integer;
ts: tstringlist;
s: string;
begin
progress_running:=true;
ts:=tstringlist.Create;

 if form1.IdFTP1.Connected=false then begin
 form1.timer_restarter.enabled:=false;
 addline('Die Verbindung wurde getrennt? sollte aber offen sein für PrintServer Action. versuche neustart des ganzen Task');
 sleep(2000);
 form1.Button_start_action.Click;
 abort;
 end;

     try
//erstes verzeichniss LS
ftp_directory_change(form1.Edit_LS.Text);
//mache aktion
 form1.idftp1.List();
 for i := 0 to form1.idftp1.DirectoryListing.Count-1 do
 if form1.idftp1.DirectoryListing[i].FileName='.'=false then
 if form1.idftp1.DirectoryListing[i].FileName='..'=false then begin
  s:=form1.idftp1.DirectoryListing[i].FileName;
  ts.Add(s);
  form1.idftp1.Get(s,programmpfad+'LS\'+s, true);
  form1.idftp1.Delete(s);
  addline_debug(': LS Download von Server OK: '+s);
 end;

 if ts.Count>0 then begin
 s:='ACTUAL_PRINT.PDF';
   for I := ts.count-1 downto 0 do begin
 if tfile.exists(programmpfad+'LS\'+s) then begin
 tfile.Delete(programmpfad+'LS\'+s);
 addline('AlteDatei war vorhanden und wurde gelöscht: '+programmpfad+'LS\'+s); end;
 tfile.move(programmpfad+'LS\'+ts.strings[i],programmpfad+'LS\'+s );

   if tfile.Exists(Programmpfad+'LS.bat')=false then begin
   addline('BAT Fehler... '+ Programmpfad+'LS.bat nicht gefunden');
   end else begin
    if form1.checkbox_verstecke_cmd.Checked=true then
    ShellExecute(Application.Handle, 'open', PChar('LS.bat'), nil, nil, SW_HIDE)
    else
    ShellExecute(Application.Handle, 'open', PChar('LS.bat'), nil, nil, SW_NORMAL);
    papierfach:=papierfach+1;
    try
     addline_debug('Druckbefehl (LS) gesendet: '+ts.Strings[i]);
      try
      sleep(strtoint(form1.Edit_druck_pause.text)*1000);
      tfile.Delete(programmpfad+'LS\'+s);
      except on e:exception do
       addline('Fehler beim löschen der Lokalen Datei (LS)... evt zu kurze Wartezeit? '+e.Message)
      end;
     TS.Delete(i);
    except on e:exception do addline(e.Message) end;
   end;
  end;
 end;


ts.Clear;
//zweites verzeichniss RE
ftp_directory_change(form1.Edit_RE.Text);
//mache aktion
 form1.idftp1.List();
 for i := 0 to form1.idftp1.DirectoryListing.Count-1 do
 if form1.idftp1.DirectoryListing[i].FileName='.'=false then
 if form1.idftp1.DirectoryListing[i].FileName='..'=false then begin
  s:=form1.idftp1.DirectoryListing[i].FileName;
  ts.Add(s);
  form1.idftp1.Get(s,programmpfad+'RE\'+s, true);
  form1.idftp1.Delete(s);
  addline_debug(': RE Download von Server OK: '+s);
 end;

 if ts.Count>0 then begin
 s:='ACTUAL_PRINT.PDF';
   for I := ts.count-1 downto 0 do begin
 if tfile.exists(programmpfad+'RE\'+s) then begin
 tfile.Delete(programmpfad+'RE\'+s);
 addline('AlteDatei war vorhanden und wurde gelöscht: '+programmpfad+'RE\'+s); end;
 tfile.move(programmpfad+'RE\'+ts.strings[i],programmpfad+'RE\'+s );

   if tfile.Exists(Programmpfad+'RE.bat')=false then begin
   addline('BAT Fehler... '+ Programmpfad+'RE.bat nicht gefunden');
   end else begin

    if form1.checkbox_verstecke_cmd.Checked=true then
    ShellExecute(Application.Handle, 'open', PChar('RE.bat'), nil, nil, SW_HIDE)
    else
    ShellExecute(Application.Handle, 'open', PChar('RE.bat'), nil, nil, SW_NORMAL);
     rechnungsfach:=rechnungsfach+1;
    try
     addline_debug('Druckbefehl (RE) gesendet: '+ts.Strings[i]);
      try
      sleep(strtoint(form1.Edit_druck_pause.text)*1000);
      tfile.Delete(programmpfad+'RE\'+s);
      except on e:exception do
       addline('Fehler beim löschen der Lokalen Datei (RE)... evt zu kurze Wartezeit? '+e.Message)
      end;
     TS.Delete(i);
    except on e:exception do addline(e.Message) end;
   end;
  end;
 end;


ts.Clear;
//drittes verzeichniss ET1
ftp_directory_change(form1.Edit_ET1.Text);
//mache aktion
 form1.idftp1.List();
 for i := 0 to form1.idftp1.DirectoryListing.Count-1 do
 if form1.idftp1.DirectoryListing[i].FileName='.'=false then
 if form1.idftp1.DirectoryListing[i].FileName='..'=false then begin
  s:=form1.idftp1.DirectoryListing[i].FileName;
  ts.Add(s);
  form1.idftp1.Get(s,programmpfad+'ET1\'+s, true);
  form1.idftp1.Delete(s);
  addline_debug(': ET1 Download von Server OK: '+s);
 end;

 if ts.Count>0 then begin
 s:='ACTUAL_PRINT.PDF';
   for I := ts.count-1 downto 0 do begin
 if tfile.exists(programmpfad+'ET1\'+s) then begin
 tfile.Delete(programmpfad+'ET1\'+s);
 addline('AlteDatei war vorhanden und wurde gelöscht: '+programmpfad+'ET1\'+s); end;
 tfile.move(programmpfad+'ET1\'+ts.strings[i],programmpfad+'ET1\'+s );
   if tfile.Exists(Programmpfad+'ET1.bat')=false then begin
   addline('BAT Fehler... '+ Programmpfad+'ET1.bat nicht gefunden');
   end else begin

    if form1.checkbox_verstecke_cmd.Checked=true then ShellExecute(Application.Handle, 'open', PChar('ET1.bat'), nil, nil, SW_HIDE)
    else ShellExecute(Application.Handle, 'open', PChar('ET1.bat'), nil, nil, SW_NORMAL);

    try
     addline_debug('Druckbefehl (ET1) gesendet: '+ts.Strings[i]);
      try
     sleep(strtoint(form1.Edit_druck_pause.text)*1000);
      tfile.Delete(programmpfad+'ET1\'+s);
      except on e:exception do
       addline('Fehler beim löschen der Lokalen Datei (ET1)... evt zu kurze Wartezeit? '+e.Message)
      end;
     TS.Delete(i);
    except on e:exception do addline(e.Message) end;
   end;
  end;
 end;

  ts.Clear;
  //viertes verzeichniss ET2
  ftp_directory_change(form1.Edit_ET2.Text);
  //mache aktion
  form1.idftp1.List();
  for i := 0 to form1.idftp1.DirectoryListing.Count-1 do
  if form1.idftp1.DirectoryListing[i].FileName='.'=false then
   if form1.idftp1.DirectoryListing[i].FileName='..'=false then begin
   s:=form1.idftp1.DirectoryListing[i].FileName;
   ts.Add(s);
   form1.idftp1.Get(s,programmpfad+'ET2\'+s, true);
   form1.idftp1.Delete(s);
   addline_debug(': ET2 Download von Server OK: '+s);
   end;

 if ts.Count>0 then begin
 s:='ACTUAL_PRINT.PDF';
   for I := ts.count-1 downto 0 do begin
 if tfile.exists(programmpfad+'ET2\'+s) then begin
 tfile.Delete(programmpfad+'ET2\'+s);
 addline('AlteDatei war vorhanden und wurde gelöscht: '+programmpfad+'ET2\'+s); end;
 tfile.move(programmpfad+'ET2\'+ts.strings[i],programmpfad+'ET2\'+s );

   if tfile.Exists(Programmpfad+'ET2.bat')=false then begin
   addline('BAT Fehler... '+ Programmpfad+'ET2.bat nicht gefunden');
   end else begin

    if form1.checkbox_verstecke_cmd.Checked=true then
    ShellExecute(Application.Handle, 'open', PChar('ET2.bat'), nil, nil, SW_HIDE)
    else
    ShellExecute(Application.Handle, 'open', PChar('ET2.bat'), nil, nil, SW_NORMAL);

    try
     addline_debug('Druckbefehl (ET2) gesendet: '+ts.Strings[i]);
      try
      sleep(strtoint(form1.Edit_druck_pause.text)*1000);
      tfile.Delete(programmpfad+'ET2\'+s);
      except on e:exception do
       addline('Fehler beim löschen der Lokalen Datei (ET2)... evt zu kurze Wartezeit? '+e.Message)
      end;
     TS.Delete(i);
    except on e:exception do addline(e.Message) end;
   end;
  end;
 end;


  if form1.CheckBox_papierzähler.Checked=true then begin
   if papierfach>strtoint(form1.Edit_papierfach_max.text) then begin
    if form1.checkbox_verstecke_cmd.Checked=true then
    ShellExecute(Application.Handle, 'open', PChar('wartung.bat'), nil, nil, SW_HIDE)
    else
    ShellExecute(Application.Handle, 'open', PChar('wartung.bat'), nil, nil, SW_NORMAL);
    rechnungsfach:=0;
    papierfach:=0;
   end else begin
    if rechnungsfach>strtoint(form1.Edit_rechnungen_max.text) then begin
    if form1.checkbox_verstecke_cmd.Checked=true then
    ShellExecute(Application.Handle, 'open', PChar('wartung.bat'), nil, nil, SW_HIDE)
    else
    ShellExecute(Application.Handle, 'open', PChar('wartung.bat'), nil, nil, SW_NORMAL);
    rechnungsfach:=0;
    papierfach:=0;

    end;
   end;
  end;

  savesettings;
  addline_debug('PrinServer_Action fertig!');

      except on e:exception do begin
      addline('Fehler im "PrinServer_action" '+e.Message);
        try ftp_trennen except on e:exception do addline('Fehler beim versuch FTP zu trennen... '+e.Message); end;
      end;
     end;

form1.Label_rechnung_aktuell.Caption:=inttostr(rechnungsfach);
form1.Label_Papier_aktuell.Caption:= inttostr(papierfach);
ts.free;
progress_running:=false;
form1.timer_restarter.interval:=strtoint(form1.Edit_update_pause.Text)*1000;

 if form1.ProgressBar_VerbindungsZeit.Position>strtoint(form1.Edit_pause_wiederverbindung.text) then
 form1.timer_restarter.enabled:=true
 else begin
 form1.timer_restarter.enabled:=false;
 addline_debug('Restart Timer wurde nicht gestartet da weniger als '+ form1.Edit_pause_wiederverbindung.text+' sek übrig sind: '+inttostr(form1.ProgressBar_VerbindungsZeit.Position)+'Sek');
 ftp_trennen;
 end;

end;

procedure TForm1.Button_zähler_auf_nullClick(Sender: TObject);
begin
   papierfach:=0;
   rechnungsfach:=0;
   form1.Label_rechnung_aktuell.Caption:='0';
   form1.Label_Papier_aktuell.Caption:='0';
   savesettings;
end;

procedure TForm1.Button_start_actionClick(Sender: TObject);
begin
  if stop_op=true then begin
  stop_op:=false;
  ftp_trennen;
  abort;
  end
  else begin
  ftpverbinden;
  PrinServer_action;
  end;
 end;

procedure TForm1.Button_STOPClick(Sender: TObject);
begin
stop_op:=true;
end;

procedure TForm1.CheckBox_trayClick(Sender: TObject);
begin
if form1.CheckBox_tray.Checked=false then form1.TrayIcon1.Visible:=false else form1.TrayIcon1.Visible:=true;

end;

procedure TForm1.ffneprogramm1Click(Sender: TObject);
begin
form1.Visible:=true;
form1.WindowState:=wsnormal;
end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);
begin
savesettings;

addline('Close Tool');
end;

procedure TForm1.FormCreate(Sender: TObject);
begin

ts_log:=tstringlist.Create;
progress_running:=false;
stop_op:=false;
programmpfad:=extractfilepath(application.ExeName)+'\';
if tfile.Exists(programmpfad+'log.txt') then form1.Memo_Log.Lines.LoadFromFile(programmpfad+'log.txt');
addline('');
addline('Programm Start');

loadsettings;


if tdirectory.exists(programmpfad+'LS')=false then tdirectory.CreateDirectory(programmpfad+'LS');
if tdirectory.exists(programmpfad+'RE')=false then tdirectory.CreateDirectory(programmpfad+'RE');
if tdirectory.exists(programmpfad+'ET1')=false then tdirectory.CreateDirectory(programmpfad+'ET1');
if tdirectory.exists(programmpfad+'ET2')=false then tdirectory.CreateDirectory(programmpfad+'ET2');

if form1.CheckBox_autostart.checked=true then form1.Button_start_action.Click;

end;

procedure TForm1.FormResize(Sender: TObject);
begin
if form1.CheckBox_tray.Checked=true then if form1.WindowState=wsminimized then form1.Visible:=false;
end;

procedure TForm1.Loglschen1Click(Sender: TObject);
begin
form1.Memo_Log.Clear;
addline('Log cleaned');
end;

procedure TForm1.Timer1autominimizeTimer(Sender: TObject);
begin
form1.Timer1autominimize.Enabled:=false;
if form1.CheckBox_tray.Checked=true then form1.WindowState:=wsminimized;
end;

procedure TForm1.Timer1_dauer_CounterTimer(Sender: TObject);
begin
if stop_op=true then begin
 form1.ProgressBar_VerbindungsZeit.Position:=0;
 Timer1_dauer_Counter.Enabled:=false;
 ftp_trennen;
abort;
end;

if form1.ProgressBar_VerbindungsZeit.Position>0 then form1.ProgressBar_VerbindungsZeit.Position:=form1.ProgressBar_VerbindungsZeit.Position-1;
 form1.ProgressBar_VerbindungsZeit.Refresh;


 if progress_running=false then begin
  if form1.ProgressBar_VerbindungsZeit.Position=0 then begin

  if form1.IdFTP1.Connected=true then form1.IdFTP1.Disconnect;
  form1.Timer1_dauer_Counter.Enabled:=false;
  Addline_Debug('Beendigung des PrintServer Vorgang... ERFOLGREICH');
  form1.Button_start_action.Click;
  end;
 end else begin
  Addline_Debug('Warte auf beendigung des PrintServer Vorgang...');
 end;

end;




procedure TForm1.timer_restarterTimer(Sender: TObject);
begin
 if stop_op=false then PrinServer_action else begin
 form1.timer_restarter.Enabled:=false;
 ftp_trennen;
 end;
end;

procedure TForm1.TrayIcon1Click(Sender: TObject);
begin
form1.Visible:=true;
form1.WindowState:=wsnormal;
form1.BringToFront;
end;

procedure TForm1.TrayIcon1DblClick(Sender: TObject);
begin
form1.Visible:=true;
form1.WindowState:=wsnormal;
form1.BringToFront;
end;

end.
Robert
  Mit Zitat antworten Zitat
TurboMagic

Registriert seit: 28. Feb 2016
Ort: Nordost Baden-Württemberg
2.804 Beiträge
 
Delphi 12 Athens
 
#2

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 2. Sep 2021, 19:13
Evtl. hilft MadExcept. Das hat einen Schalter zur Erkennung eingefrorener Hauptthreads und kann da evtl. sogar drauf reagieren oder zumindest weitere Diagnosedaten liefern.

Anderer Lösungsansatz: periodisch Verbindung trennen und neu aufbauen.
  Mit Zitat antworten Zitat
venice2
(Gast)

n/a Beiträge
 
#3

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 2. Sep 2021, 19:19
Das hört sich sehr nach nicht freigegebenen Handles an. (Den blöden Fehler hatte ich auch schon mal.)
Starte den Taskmanager.
Addiere zu dem Reiter "Details" die Spalte Handles und prüfe ob sich diese summieren.

Bedenke es gibt eine grenze der erlaubten Handles pro Anwendung.
Wird diese Überschritten stürzt die Anwendung ab bzw. wird sehr träge.

Geändert von venice2 ( 2. Sep 2021 um 19:27 Uhr)
  Mit Zitat antworten Zitat
Benutzerbild von jaenicke
jaenicke

Registriert seit: 10. Jun 2003
Ort: Berlin
9.324 Beiträge
 
Delphi 11 Alexandria
 
#4

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 2. Sep 2021, 20:35
Ein Beispiel:
Du erstellst in PrinServer_action eine TStringList, hast aber keinen try..finally Block zur Freigabe drum. Tritt also ein Fehler auf oder springst du mit abort (ein paar Zeilen nach dem begin) raus, wird diese nicht wieder freigegeben.

Im Laufe vom Stunden summiert sich dann dieser nicht freigegebene Speicher und am Ende ist der voll und es geht gar nichts mehr. (Es kann auch sein, dass da noch mehr nicht freigegeben wird, ich habe nicht genau geschaut.) Und dann kann Indy auch nicht mehr richtig mit dem Server sprechen und es kann zu ganz komischen Fehlern kommen. Achte mal auf den Speicherverbrauch im Taskmanager, wenn der Fehler auftritt.

Davon unabhängig brauchst du das abort (sprich die stille Exception) in deinem Quelltext definitiv nicht. Zur Steuerung des Programm- und Schleifenablaufs gibt es mit Exit, Break, Continue usw. saubere Möglichkeiten. Das in Kombination mit Ressourcenschutzblöcken (try..finally) sollte Besserung bringen.
Sebastian Jänicke
Alle eigenen Projekte sind eingestellt, ebenso meine Homepage, Downloadlinks usw. im Forum bleiben aktiv!
  Mit Zitat antworten Zitat
Delphi.Narium

Registriert seit: 27. Nov 2017
2.415 Beiträge
 
Delphi 7 Professional
 
#5

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 3. Sep 2021, 16:38
Bei meinen HTTP-Klamotten kenn' ich das Problem in ähnlicher Form. Hier hat folgendes geholfen:
Delphi-Quellcode:
  // Grundsätzlich hinter jedes
  http.Disconnect(True);
  // noch ein.
  http.IOHandler.InputBuffer.Clear;
Behebt nicht 100% dieser Fehlersituationen, aber statt (teils mehrfach) täglich tritt der Fehler kaum noch monatlich auf.

Könnte daher einen Versuch wert sein.
  Mit Zitat antworten Zitat
gee21

Registriert seit: 3. Jan 2013
199 Beiträge
 
Delphi 10.4 Sydney
 
#6

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 6. Sep 2021, 11:16
Also vielen Dank für eure Hilfe. (ich habe heute mal die Handles und weitere Infos im Taskmanager anzeigen lassen).

@TurboMagic: Früher habe ich nach jedem überprüfen die Verbindung getrennt und wieder neu aufgebaut. damit aber die Ausdrucke möglichst schnell aus dem Drucker kommen, musste ich +/- alle 5 Sekunden neu zum server verbinden und dann gleich wieder trennen. damit also die ausdrucke noch schneller aus dem Drucker kommen und damit ich den Server nicht mit meinen Verbindung unnötig belaste, wollte ich die Verbindung so lange offen lassen bis knapp vor dem Server/Idle TimeOut erreicht ist. (NOOP und NAT KeepAlive haben immer Probleme gemacht, vermultich aber durch mein Unwissen ).

@venice2: Ja du scheinst recht zu haben die Handles zählen aufwärts wie länger das Tool läuft.

@jaenicke: Vielen Dank für dein Beispiel. ich werde diese Sachen noch diese Woche anschauen und ausprobieren. Dann im Taskmanager vergleichen um zu sehen was wie hilft. Ich denke so sollte es dann klappen.

@Delphi.Narium: Danke auch dir vielmals. Ich werde dein Tipp ganz am Schluss (in 1-2 Wochen) auch noch abändern um dann zu erkennen/lernen was diese Änderung hilft/bewirkt


VIELEN DANK bin jedes mal froh über eure Hilfe
Robert
  Mit Zitat antworten Zitat
Delphi.Narium

Registriert seit: 27. Nov 2017
2.415 Beiträge
 
Delphi 7 Professional
 
#7

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 6. Sep 2021, 12:50
Damit kannst Du feststellen, wieviele Handles Dein Prozess so "verbrät".
Delphi-Quellcode:
// Je nach Delphi ist's auch schon in Winapi.Windows zu finden:
function GetProcessHandleCount(hProcess: THandle; var pdwHandleCount: DWORD): BOOL; stdcall;
  external 'kernel32.dll';

procedure LogHandles(s : String);
var
  HandleCount: DWORD;
begin
  if GetProcessHandleCount(GetCurrentProcess, HandleCount) then
    Addline_Debug(Format('%s: Handles: %d',[s, HandleCount]);
end;
Wenn Du diesen Wert regelmäßig in Deinem Programm selbst prüfst und kontrollierst (Logfile oder sowas), kannst Du damit schonmal feststellen, ob es da einen Zuwachs gibt. (Und könnte einfacher sein (da auch unbeaufsichtigt möglich), als immer vorm Taskmanager zu sitzen und zuzuschauen

Bei 'nem Mitschreiben in 'ner Log-Datei kannst Du ggfls. sehen, welcher Wert hier vor dem Programmabsturz zuletzt protokolliert wurde.

Damit kannst Du dann ggfls. schonmal eine "Schmerzgrenze" ermitteln, ab der ggfls. mit 'nem Programmabsturz zu rechnen ist.

Wenn Du diesen Wert weißt, dann ziehe davon 'nen ordentlichen Puffer ab und steuere dann über diesen Wert einen automatischen Neustart des Programmes durch sich selbst. (Shellexecute (o. ä.) der eigenen Exe und die beendet sich dann.)

Achso:

Das ist natürlich nur ein Workaround, grundsätzlich wäre eine Lokalisierung und Bereinigung des Problemes vorzuziehen. Aber wie das so ist: Oft ist diese Anforderung leichter gesagt, als im realen Leben umgesetzt

Die obige Routine kannst Du in alle Routinen, bei denen ein (unerwarteter) Handlezuwachs möglich ist, einbauen:
Delphi-Quellcode:
// Am Anfang der Unit:
{$DEFINE HandleProtokoll}
// Am Anfang der relevanten Routinen:
{$IFDEF HandleProtokoll}LogHandles('Start Name der Funktion / Prozedure / Aufgabe ...');{$ENDIF}

// Am Ende der relevanten Routinen:
{$IFDEF HandleProtokoll}LogHandles('Ende Name der Funktion / Prozedure / Aufgabe ...');{$ENDIF}
Über den Kompilerschalter kannst Du das dann recht einfach aktivieren bzw. deaktivieren, ohne jeweils groß im Quelltext Änderungen vornehmen zu müssen.

Oder halt Dein Addline_Debug direkt um die Protokollierung der Handles ergänzen.

Ein Zuwachs im Speicherverbrauch ließe sich ähnlich protokollieren und ggfls. darauf reagieren.
  Mit Zitat antworten Zitat
gee21

Registriert seit: 3. Jan 2013
199 Beiträge
 
Delphi 10.4 Sydney
 
#8

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 6. Sep 2021, 14:46
Also ich hab jetzt heute bereits ein wenig getestet. Und werde wohl in den nächsten Tagen das ganze nocheinmal ganz genau anschauen um es dann in zukünftigen projekten direkt besser machen zu können.
(Vielen Dank delphi.narium für das beispiel mit dem handles auslesen, das wird mir bestimmt helfen in den nächsten tagen und ansonsten mache ich dann im notfall wirklich einen "workaround").

Heute sind mir folgende Fragen dazu durch den Kopf gegangen:
- Passiert bei Beispiel 1 ein Fehler oder auch nicht wird die Stringlist trotzdem immer freigegeben da sie nach dem except steht?
- ist Beispiel 2 korrekter / besser? da wird die Stringlist ebenfalls immer freigegeben da Finally immer ausgeführt wird egal ob fehler oder nicht?
- Weshalb sehe im im Taskmanager das mein Programm manchmal 2-7 Threads am laufen hat? Ich arbeite doch in diesem Tool gar nicht mit Threads? kommt das von IDFTP komponente? oder was macht den "automtisch" mehrere Threads. Ich sehe auch dass es dann manchmal von zb 7 Threads wieder runter auf 3 Threads geht.

Beispiel 1:
Delphi-Quellcode:
var
ts: tstringlist;
begin
try
ts:=tstringlist.create;
 mach das 1
 mach das 2
 mach das 3
 except
 // bei einem Fehler wird nichts gemacht. fährt aber nach except weiter?
 end;
 ts.free;
end;
Beispiel 2:
Delphi-Quellcode:
var
ts: tstringlist;
begin
 try
 ts:=tstringlist.create;
 mach das 1
 mach das 2
 mach das 3
 finally
 //egal ob ein fehler passiert oder nicht stringlist wird wieder freigegeben.
 ts.free;
 end;

end;
Robert

Geändert von gee21 ( 6. Sep 2021 um 16:53 Uhr)
  Mit Zitat antworten Zitat
venice2
(Gast)

n/a Beiträge
 
#9

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 6. Sep 2021, 14:52
Verwende bitte Delphi Tags dann kann man den Quelltext besser lesen.
Danke!

Du kannst except und finally combinieren.

Im Beispiel 1 wird ts.free; Nie Aufgerufen wenn ein anderer Fehler auftritt.

Sorry eine leere Fehlerbehandlung ist ein Nonsens.

Delphi-Quellcode:
except
// bei einem Fehler wird nichts gemacht. fährt aber nach except weiter?
end;

Geändert von venice2 ( 6. Sep 2021 um 15:09 Uhr)
  Mit Zitat antworten Zitat
TomF

Registriert seit: 29. Sep 2015
Ort: Österreich, Innviertel
24 Beiträge
 
Delphi 11 Alexandria
 
#10

AW: Programm stürzt nach mehren Stunden Laufzeit ab.

  Alt 6. Sep 2021, 15:09
Ich bin jetzt nicht so der Profi - aber müsste das ts:=tstringlist.create; nicht vor dem try stehen, damit das Sinn ergibt ?
Thomas
  Mit Zitat antworten Zitat
Antwort Antwort
Seite 1 von 3  1 23   

Themen-Optionen Thema durchsuchen
Thema durchsuchen:

Erweiterte Suche
Ansicht

Forumregeln

Es ist dir nicht erlaubt, neue Themen zu verfassen.
Es ist dir nicht erlaubt, auf Beiträge zu antworten.
Es ist dir nicht erlaubt, Anhänge hochzuladen.
Es ist dir nicht erlaubt, deine Beiträge zu bearbeiten.

BB-Code ist an.
Smileys sind an.
[IMG] Code ist an.
HTML-Code ist aus.
Trackbacks are an
Pingbacks are an
Refbacks are aus

Gehe zu:

Impressum · AGB · Datenschutz · Nach oben
Alle Zeitangaben in WEZ +1. Es ist jetzt 15:35 Uhr.
Powered by vBulletin® Copyright ©2000 - 2024, Jelsoft Enterprises Ltd.
LinkBacks Enabled by vBSEO © 2011, Crawlability, Inc.
Delphi-PRAXiS (c) 2002 - 2023 by Daniel R. Wolf, 2024 by Thomas Breitkreuz