Autor Téma: Test na otevření souboru  (Přečteno 882 krát)

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #15 kdy: 12-10-2020, 19:21:56 »
Ano, to funguje.
A není jednodušší, protože ho chci pokud je otevřený zavřít, otestovat to zavírání?
Kód: Delphi [Vybrat]
  1. try
  2. closefile(mer)
  3. except
  4. ..
  5. end;
  6.  
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline < z >

  • Administrátoři
  • Guru
  • *****
  • Příspěvků: 1150
  • Karma: 44
    • Verze Delphi: 7, 2010
Re:Test na otevření souboru
« Odpověď #16 kdy: 12-10-2020, 21:44:02 »
Doufám, že tam, kde soubor otevíráš, tam ho taky zavíráš na konci - try/finally.
Nenechávej soubor cestovat hyperprostorem bez dohledu.

Nepochopil jsem přesně, jak ty dávky fungují, ale každá dávka si musí soubor otevřít i zavřít.
Další dávka buď musí navazovat po ukončení předchozí, nebo si zjistí, že ta předchozí nedoběhla.

Vlákna nejsou zas tak složitá. Zvlášť když Delphi za tebe celou třídu založí (nový - TThread)
http://semi.gurroa.cz/Clanky/Threads.html

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #17 kdy: 13-10-2020, 12:21:19 »
Ahoj,
vypadá to, že ta chyba se zápisem do zavřeného fajlu je spíš podružná. Všechno se asi točí kolem načasování událostí a provádění procedur.
Zajímalo by mě, co se děje s během programu, když procedura definovaná ve formuláři typu child je v běhu spuštěná timerem a formulář zavřu. Doběhne ta procedura nebo ne? Postará se formulář o její ukončení? Co když se v proceduře zapisuje do gridu? Běh procedury může trvat tak 2 vteřiny včetně vyčtení dat z ústředny, výpočtů sekundárních veličin, zobrazení v gridu a uložení cyklem do random access fajlu.
Pro názornost uvedu stručnou strukturu úlohy:

Obsluha zavření MDIChild formuláře s tabulkou hodnot:
Kód: Delphi [Vybrat]
  1. procedure TfrmMereni.FormClose(Sender: TObject; var Action: TCloseAction);
  2. begin
  3.  
  4.   //if IsFileInUse('C:\temp\Imp\tempmer.mer')   then exit;
  5.  
  6.   frmMain.mnuPrepocet.enabled:=true;
  7.   flag_muzes_merit:=false;
  8.   frmMain.timer1.enabled:=false;
  9.   frmMain.timer2.Enabled:=false;
  10.   frmMain.cmdGo.enabled:=true;
  11.   frmMain.cmdGo.enabled:=true;
  12.   frmMain.cmdStop.enabled:=false;
  13.   frmMain.mnuStop.enabled:=false;
  14.   frmMain.mnuStart.enabled:=true;
  15.   frmMain.cmdReset.enabled:=true;
  16.   frmMain.cmdSnetOff.enabled:=true;
  17.   frmMain.mnuReset.enabled:=true;
  18.   frmMain.mnuSnetOff.enabled:=true;
  19.   frmMain.Timer1.Enabled:=false;
  20.   frmMain.mnuVyberKonf.enabled:=true;
  21.   frmMain.cmdVyberKonf.enabled:=true;
  22.   cyklus:=0;
  23.   frmMain.StatusBar1.Panels[1].Text:='IDLE';
  24.   application.ProcessMessages;
  25. //  try
  26. //    closefile(cfgtemp);
  27. //  except;
  28. //  end;
  29.   Action := caFree;
  30. end;
  31.  

Obsluha události Timeru (nastaven na 100 ms):
Kód: Delphi [Vybrat]
  1.   procedure TfrmMain.Timer1Timer(Sender: TObject);
  2.   var cas: TDateTime;
  3.   begin
  4.     if not flag_muzes_merit then exit;
  5.     cas:=now;
  6.     if cas >(casStart + cyklus*perioda/(24*3600)) then  //vypočte a porovná žádaný čas odečtu s reálným časem
  7.     begin
  8.         frmmereni.mercyklus;
  9.     end;
  10.     application.ProcessMessages;
  11.   end;
  12.  

A nakonec procedura měřicího cyklu (zkrácená):
Kód: Delphi [Vybrat]
  1.  
  2. Procedure TfrmMereni.Mercyklus;
  3.   var  starttime, endtime: TTime;
  4.        i, j, k, misto: integer;
  5.        casodectu: TdateTime;
  6.        teplota, tlak: double;
  7.        Re, C, vx, beta, Ro, korekce: double;
  8.        jedn: ansistring;
  9.        label Repete1;
  10.   begin
  11.       frmmain.Statusbar1.Panels[1].Text:='';
  12.       frmmain.Statusbar1.Panels[3].Text:='';
  13.       application.ProcessMessages;
  14.       flagChybaImpu:=false;
  15.       flag_muzes_merit:=false;
  16.     try
  17.         closefile(cfgtemp);
  18.     except
  19.     end;
  20.       reset(cfgtemp);
  21.       seek(cfgtemp, 0);
  22.       cyklus:=cyklus+1;
  23.       for i:= 1 to 10 do sumaSK[i]:=0;
  24.       For i:= 0 To 19 do
  25.       begin
  26.           Imp_Data[i]:= 0;
  27.           Imp_sig[i]:= 0;
  28.       end;
  29.       if frmmain.chkZvuk.Checked then beep;
  30.       frmMereni.Caption:='Měření - cyklus č. ' + inttostr(cyklus) + ', čas ' + datetimetostr(now);
  31.       casodectu:=now;
  32.       case typkarty of
  33.       1:    begin
  34.                 rx:='';                                 // vyprázdnění přijímacího stringu
  35.                 frmmain.comport1.WriteStr('I_CM00TR' + #13);
  36.                 Repete1:
  37.                 sleep(delay1);
  38.                 if (pos('S00',rx)<>0) then
  39.                     frmmain.Statusbar1.Panels[1].Text:='Trigger OK..'
  40.                 else
  41.                     begin
  42.                         frmmain.Statusbar1.Panels[1].Text:='Chyba přenosu trigru! ';
  43.                         frmmain.Memo1.Lines.add('Chyba přenosu trigru! ');
  44.                     end;
  45.                 rx:='';
  46.                 sleep(delay2);
  47.                 for i:= 1 to maximp do
  48.                 begin
  49.                   if ctrlstring[i] <> '' then
  50.                   begin
  51.                     stavimpu[i-1]:=true;
  52.                     if i < 10 then povel:='I_ST0' + inttostr(i) + '0' else povel:='I_ST' + inttostr(i) + '0';
  53.                     frmmain.comport1.WriteStr(povel + #13);
  54.                     endtime:=time+0.2/(24*60*60);
  55.                     repeat
  56.                         application.ProcessMessages;
  57.                     until ((time)>endtime) or (pos('H080',rx)<>0);
  58.                     if (pos('H080',rx)<>0) then
  59.                     begin
  60.                         frmmain.Statusbar1.Panels[1].Text:='Data ve streamu 0..';
  61.                         { **** Přečtení dat z impu do stringu ****}
  62.                         rx:='';
  63.                         if i < 10 then povel:='I_SR0' + inttostr(i) + '0080' else povel:='I_SR' + inttostr(i) + '0080';
  64.                         frmmain.comport1.WriteStr(povel + #13);
  65.                         sleep(100);
  66.                         endtime:=time+0.1/(24*60*60);
  67.                         repeat
  68.                             application.ProcessMessages;
  69.                         until ((time)>endtime) or (length(rx)=167);
  70.                         Prejezeni(i, 20);
  71.                         frmmain.Statusbar1.Panels[1].Text:='Čekám na další odečet..';
  72.                     end else
  73.                     begin
  74.                         stavimpu[i-1]:=false;
  75.                         frmmain.Statusbar1.Panels[3].Text:='Nepřišla data z IMPu' + inttostr(i) + '..';
  76.                         application.ProcessMessages;
  77.                     end;
  78.                   end; // if poll
  79.                 end;  // for i
  80.             end;  // case typkarty = USB
  81.       2:    //vyslipovel(0, 'TR');             // zatím neimplementováno pro staré karty
  82.       end; // case
  83.  
  84.     { **** Načtení hodnot do tabulky změřených hodnot **** }
  85.     seek(cfgtemp, 0);
  86.     misto:=0;
  87.     if barimp<>0 then bartlak:=(round(KXPlusQ(mval[barimp, barkanal], barzes, barNula, barNulael)*1000)/1000);
  88.     for i:=1 to poslrec do
  89.     begin // 1. průchod tabulkou
  90.       read(cfgtemp, cfgtemprec);
  91.       if cfgtemprec.Ind then
  92.       begin
  93.         misto:=misto+1;
  94.         j:=cfgtemprec.adrimpu; k:=cfgtemprec.kanal;
  95.         if cyklus=1 then frmMereni.VyplnMerTabulku(misto);
  96.         //napíše elektrickou hodnotu do gridu
  97.         try
  98.         MRecpole[misto].cas1:=casodectu;
  99.         MRecpole[misto].mdat1:=round(mval[j, k]*100000)/100000;
  100.         MRecpole[misto].Err1:=ChybaMer[j, k];
  101.         except
  102.         begin
  103.            mval[j, k]:=9999;
  104.            MRecpole[misto].mdat1:=9999;
  105.            MRecpole[misto].Err1:=0;
  106.            flagChybaImpu:=true;
  107.         end;
  108.         end;
  109.         if frmMereni <> nil then
  110.         begin
  111.             frmMereni.mertab1.Cells[7,misto]:=floattostr(MRecpole[misto].mdat1);
  112.             frmMereni.mertab1.Cells[13,misto]:=floattostr(MRecpole[misto].Err1);
  113.         end;
  114.         if mval[j, k] <> 9999 then
  115.         begin
  116.           try
  117.               { **** PRIMÁRNÍ VÝPOČTY - I. PRŮCHOD TABULKOU **** }
  118.           exept
  119.               přiřadí hodnotě 9999 a zapíše do tabulky
  120.           end;
  121.       end;  // IND
  122.     end;  // prvního průchodu tabulkou
  123.  
  124.     { **** SEKUNDÁRNÍ VÝPOČTY - II. PRŮCHOD TABULKOU **** }
  125.     seek(cfgtemp, 0);
  126.     misto:=0;
  127.     for i:=1 to poslrec do
  128.     begin // 2. průchod tabulkou
  129.       read(cfgtemp, cfgtemprec);
  130.       if cfgtemprec.Ind then
  131.       begin
  132.         misto:=misto+1;
  133.         case cfgtemprec.Kod_typu_MM of
  134.         15: begin
  135.                 LoadStringFromCharArray(cfgTempRec.Jednotka, jedn);
  136.                 prutok:=100;
  137.                 If cfgTempRec.Mtadr3 = 0 Then teplota:= cfgTempRec.C4 Else teplota:= MRecpole[cfgtemprec.Mtadr3].mfyz1;
  138.                 If cfgTempRec.Mtadr2 = 0 Then tlak:=cfgTempRec.C3 else tlak:=MRecpole[cfgtemprec.Mtadr2].mfyz1;
  139.                 with cfgtemprec do MRecpole[misto].mfyz1:=Round(PrutokSO(teplota, tlak, MRecpole[Mtadr1].mfyz1, D1, krp, D2, kro, kapa, vlhkost, C2,
  140.                        bartlak, organ, medium, typvyp, jedn, prutok, Re, C, vx, beta, Ro)*1000)/1000;
  141.                 MRecpole[cfgtemprec.Mtadr2].mfyz1, D1, krp, D2, kro, kapa, vlhkost, C2, bartlak, organ, medium, typvyp, trim(jednotka),
  142.                 prutok)*1000)/1000;
  143.              end;
  144.         end;
  145.         if (cfgtemprec.Skup > 0) and (cfgtemprec.Skup < 11) then sumaSK[cfgtemprec.Skup]:=sumaSK[cfgtemprec.Skup]+MRecpole[misto].mfyz1;
  146.       end;    //IND
  147.     end;  // druhého průchodu tabulkou
  148.  
  149.     seek(cfgtemp, 0);
  150.     misto:=0;
  151.     for i:=1 to poslrec do
  152.     begin // 3. průchod tabulkou - agregace skupin
  153.       read(cfgtemp, cfgtemprec);
  154.       if cfgtemprec.Ind then
  155.       begin
  156.         misto:=misto+1;
  157.         case cfgtemprec.Kod_typu_MM of
  158.         24: MRecpole[misto].mfyz1:=sumaSK[cfgtemprec.Skup];
  159.         25: if (cfgtemprec.Skup > 0) and (cfgtemprec.Skup < 11) then MRecpole[misto].mfyz1:=sumaSK[cfgtemprec.Skup]/pocetSK[cfgtemprec.Skup] else MRecpole[misto].mfyz1:=9999 ;
  160.         end;
  161.         if not cfgtemprec.vypocet then frmMereni.mertab1.Cells[7,misto]:=floattostr(MRecpole[misto].mdat1) else frmMereni.mertab1.Cells[7,misto]:='';
  162.         frmMereni.mertab1.Cells[13,misto]:=floattostr(MRecpole[misto].Err1);
  163.         frmMereni.mertab1.Cells[8,misto]:=floattostr(MRecpole[misto].mfyz1);
  164.         Suma[misto]:= Suma[misto]+MRecpole[misto].mfyz1;
  165.         frmMereni.mertab1.Cells[9,misto]:= floattostr(round(10000*Suma[misto]/cyklus)/10000);    // tady se počítá průměr místa
  166.         if cyklus=1 then
  167.         begin
  168.             Max[misto]:=MRecpole[misto].mfyz1; frmMereni.mertab1.Cells[10,misto]:= floattostr(Max[misto]);
  169.             Min[misto]:=MRecpole[misto].mfyz1; frmMereni.mertab1.Cells[11,misto]:= floattostr(Min[misto]);
  170.      end else
  171.         begin
  172.             if Max[misto] < MRecpole[misto].mfyz1 then begin Max[misto]:=round(MRecpole[misto].mfyz1*10000)/10000; frmMereni.mertab1.Cells[10,misto]:= floattostr(Max[misto]); end;
  173.             if Min[misto] > MRecpole[misto].mfyz1 then begin Min[misto]:=round(MRecpole[misto].mfyz1*10000)/10000; frmMereni.mertab1.Cells[11,misto]:= floattostr(Min[misto]); end;
  174.             kolisani[misto]:=abs(Max[misto]-Min[misto]); frmMereni.mertab1.Cells[12,misto]:= floattostr(kolisani[misto]);
  175.         end;
  176.       end;    //IND
  177.  
  178.  
  179.     end;  // třetího průchodu tabulkou
  180.  
  181.     { **** ZÁPIS NAMĚŘENÝCH A VYPOČTENÝCH DAT do souboru **** }
  182.  
  183.     if not Zapisdata(cyklus) then frmmain.statusbar1.Panels[3].Text:='Chyba zápisu dat!!!';
  184.     application.processmessages;
  185.     if cyklus=1 then frmmain.timer1.enabled:=true;
  186.     flag_muzes_merit:=true;
  187.   end;
  188.  

No, moc stručné to zrovna není, vypustil jsem dašlí výpočty uvnitř cyklu, pokud je to moc, tak se omlouvám a vybodněte se na mě.
Díky - Dalibor.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline vandrovnik

  • Guru
  • *****
  • Příspěvků: 1109
  • Karma: 47
    • Verze Delphi: 10.3
Re:Test na otevření souboru
« Odpověď #18 kdy: 13-10-2020, 12:37:30 »
Excellent
Rated 1 time
Nestudoval jsem to celé, ale v prvé řadě bych se snažil zbavit toho ProcessMessages. Když ho vyhodíš, tak se určitě nestane, že by se formulář uvolnil dřív, než doběhne obsluha něčeho.

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #19 kdy: 13-10-2020, 14:33:22 »
Ale nemůžu ho vyhodit všude, když budu mít nastavený cyklus třeba na 5 minut, tak
Kód: Delphi [Vybrat]
  1.                     repeat
  2.                         application.ProcessMessages;
  3.                     until ((time)>endtime) or (pos('H080',rx)<>0);
  4.  
pokud nevrátí ústředna H080, tak procedura Mercyklus zmrzne na 5 minut.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline vandrovnik

  • Guru
  • *****
  • Příspěvků: 1109
  • Karma: 47
    • Verze Delphi: 10.3
Re:Test na otevření souboru
« Odpověď #20 kdy: 13-10-2020, 14:39:07 »
To by chtělo dát do samostatného vlákna... což asi nechceš slyšet :-)

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 3004
  • Karma: 135
    • Verze Delphi: D2007, XE3, DX10
Re:Test na otevření souboru
« Odpověď #21 kdy: 13-10-2020, 14:41:39 »
Ale nemůžu ho vyhodit všude
Ale pokud z toho chces mit slusne napsanou aplikaci, tak ti nezbyde, nez to vsude vyhodit a prepsat to pomoci threadu. V main threadu nema bezet nic, co by delsi dobu blokovalo pumpu zprav a tim zarazenim ProcessMessages ji volas, ovsem misto z idle stavu z nedokoncene predchozi obsluhy tj. rekurzivne  >:(

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #22 kdy: 13-10-2020, 16:01:36 »
Kecám blbosti, musím pomoct ženě zavařovat hrušky. ;D
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #23 kdy: 13-10-2020, 16:08:12 »
Citace
vsude vyhodit a prepsat to pomoci threadu

Asi mi nic jiného nezbude, nebo ještě tak zakázat nějakým flagem tu proceduru spustit, dokud nebude hotová. Jenom mě štve, že když jsem tento prográmek psal před 20 lety ve Visual Basicu 4, tak takové problémy rozhodně nebyly. Jenže na W10 to už není a staré portable s W98 už šlo do kytek.

Díky za rady,
Dalibor.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #24 kdy: 13-10-2020, 16:49:29 »
Mimochodem, rekurze by asi neměla nastat, když v události timeru, který proceduru spouští je
 
Kód: Delphi [Vybrat]
  1.  if not flag_muzes_merit then exit;
pokud to není umístěno blbě.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 3004
  • Karma: 135
    • Verze Delphi: D2007, XE3, DX10
Re:Test na otevření souboru
« Odpověď #25 kdy: 13-10-2020, 17:30:35 »
Mimochodem, rekurze by asi neměla nastat, když v události timeru, který proceduru spouští je
Nejde jen o rekurzi obsluhy timeru, ale rekurzi obsluhy pumpy zprav, cili schematicky zjednoduseno:

ProcessMessages <--------------+
  repeat                       |
    ProcessMessage             |
      PeekMessage              |
      TranslateMessage         |
      DispatchMessage          |
        OnClose                |
        TimerTick              |
          mercyklus            |
            ProcessMessages ---+
          ProcessMessages -----+
        ...                    |
          ProcessMessages -----+
  until false;

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #26 kdy: 13-10-2020, 18:10:24 »
Asi tomu nerozumím. Měl jsem za to, že ProcessMessages umožňuje reagovat aplikaci na nějakou akci okna, jako zavření, kliknutí na objekt a to i když běží nějaký cyklus, kde hrozí nekonečná smyčka. Ve VB to byl příkaz DoEvents.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline vandrovnik

  • Guru
  • *****
  • Příspěvků: 1109
  • Karma: 47
    • Verze Delphi: 10.3
Re:Test na otevření souboru
« Odpověď #27 kdy: 13-10-2020, 18:54:07 »
Ale to je právě na závadu, že během toho cyklu dojde ke zrušení formuláře, ne?

Offline vandrovnik

  • Guru
  • *****
  • Příspěvků: 1109
  • Karma: 47
    • Verze Delphi: 10.3
Re:Test na otevření souboru
« Odpověď #28 kdy: 13-10-2020, 18:58:42 »
Ono to určitě půjde nějak slátat i s tím ProcessMessages, ale připadá mi, že úsilí tomu věnované je lepší věnovat tomu, aby komunikace běžela ve vlákně. Beru to tak, že pokud chci ještě nějakou dobu programovat, vlákna mě beztak neminou, tak se s nimi postupně snažím sžít. Co jsem dělal pár malých aplikací pro Android, bez vláken to nešlo vůbec.

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 3004
  • Karma: 135
    • Verze Delphi: D2007, XE3, DX10
Re:Test na otevření souboru
« Odpověď #29 kdy: 13-10-2020, 19:41:38 »
Ono to určitě půjde nějak slátat i s tím ProcessMessages,
Nabizi se priznak, ze se meri a tim blokovat zavreni formulare v OnCloseQuery... ale jak pises, to nema s programovanim mnoho spolecneho