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

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Test na otevření souboru
« kdy: 11-10-2020, 20:52:10 »
Ahoj pánové,
existuje funkce která vrátí hodnotu true pokud je soubor otevřený?
Nebo je to potřeba zkusit v bloku Try except (tak to dělám teď)? Nějak se mi to už vykouřilo z hlavy. Potřeboval bych zjistit, jestli soubor kam chci zapisovat po přijetí dat z comportu je otevřený nebo ne. Po každé dávce dat ho zavírám a někdy se stane, že při ukončování komunikace soubor zavřu někde v půlce a vyhodí to chybu. Předesílám, že přes vlákna to neumím.
Díky,
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ěď #1 kdy: 11-10-2020, 21:07:55 »
Teď si vzpomínám, myslím že IsOPen by to mohlo vrátit.
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ěď #2 kdy: 11-10-2020, 21:15:45 »
Nevím, co dělá IsOpen, ale na netu najdeš příklady, jak testovat pomocí CreateFile

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #3 kdy: 11-10-2020, 21:32:46 »
No, nedělá nic. S něčím jsem si to spletl. N anetu jsem našel toto, což funguje, ale stejně mi to moc nepomohlo.
Kód: Delphi [Vybrat]
  1. function IsFileInUse(fName: string) : boolean;
  2. var
  3.   HFileRes: HFILE;
  4. begin
  5.   Result := False;
  6.   if not FileExists(fName) then begin
  7.     Exit;
  8.   end;
  9.  
  10.   HFileRes := CreateFile(PChar(fName)
  11.     ,GENERIC_READ or GENERIC_WRITE
  12.     ,0
  13.     ,nil
  14.     ,OPEN_EXISTING
  15.     ,FILE_ATTRIBUTE_NORMAL
  16.     ,0);
  17.  
  18.   Result := (HFileRes = INVALID_HANDLE_VALUE);
  19.  
  20.   if not(Result) then begin
  21.     CloseHandle(HFileRes);
  22.   end;
  23. end;

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ěď #4 kdy: 11-10-2020, 21:39:27 »
Tak teoreticky se může stát, že soubor sice nemá nikdo otevřený, ale aplikace tam kvůli oprávnění stejně nebude moci zapisovat, takže mi přijde jednodušší ten zápis prostě zkusit. (Na Novellu šlo nastavit práva tak, že uživatel mohl soubor vytvořit, zapsat do něj, zavřít - a pak už ho ani on sám nemohl změnit nebo smazat.)

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #5 kdy: 11-10-2020, 22:19:53 »
Abych vysvětlil, čeho chci dosáhnout.
na časovač třeba po vteřině spouštím v cyklech komunikaci s měřicí ústřednou přes comport. Data se zobrazují do stringgridu v otevřeném formuláři. Na konci každého cyklu po otevřu file, zapíšu data, zavřu file a čeká se na další událost časovače. Když chci ukončit měření, zavřu formulář s gridem a v události onClose zavřu i file s daty. Jenomže mezitím se to může potkat se startem zápisu dalšího cyklu a ten pak zapisuje do zavřeného fajlu. A je to - Error 103. Potřebuju aby program poznal, že fajl je zavřený a už do něj další data neposílal.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline František

  • Guru
  • *****
  • Příspěvků: 596
  • Karma: 6
    • Verze Delphi: primárne v XE5, občas 10.2.3 comunity
Re:Test na otevření souboru
« Odpověď #6 kdy: 12-10-2020, 08:13:40 »

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #7 kdy: 12-10-2020, 09:43:00 »
Neběží, vlákna neumím.
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ěď #8 kdy: 12-10-2020, 09:44:18 »
Když to neběží ve vláknech, tak stačí si udělat nějaký příznak, že už nemá zapisovat?

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #9 kdy: 12-10-2020, 09:45:04 »
Jinak díky za tip, já mám D2009, ale třeba to bude stejné.
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ěď #10 kdy: 12-10-2020, 09:49:52 »
S příznakem to mám, většinou to projde dobře, teď experimentuju s tím, kde ho testovat. Jinak jsem objevil další svůj nedůsledný bordel, po zavřeni formuláře s gridem se pokouší procedura měřicího cyklu , která je v main unitě zapsat data do gridu, takže accsess violation.
Nic, musím na test covidu, uřesním až přijdu.
D.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline Stanislav Hruška

  • Padawan
  • ******
  • Příspěvků: 5450
  • Karma: 41
    • Verze Delphi: W10 + Delphi 10.4 professional
Re:Test na otevření souboru
« Odpověď #11 kdy: 12-10-2020, 12:57:22 »
Tak na rýchlo tu vidím dve riešenia:
  • Kontrolovať, či už procedúra meracieho cyklu ukončila svoju činnosť. Iba vtedy povoliť uzatvorenie. Medzitým môže byť formulár zobrazený a Disable
  • Procedúra meracieho cyklu bude kontrolovať if no Assigned(Grid) then. Tu samozrejme môže dôjsť k strate údajov
W10 64b, Delphi 10.4, FireBird 3.05
Expert na kladenie nejasne formulovaných otázok.

Offline Jan Fiala

  • Plnoletý
  • ***
  • Příspěvků: 106
  • Karma: 0
    • Verze Delphi: 10.4.1
    • PSPad editor
Re:Test na otevření souboru
« Odpověď #12 kdy: 12-10-2020, 15:04:35 »
Stačí se soubor pokusit otevřít výhradně (exclusive). Pokud se ti to podaří, můžeš zapisovat. Pokud ne, má jej otevřený někdo jiný.

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #13 kdy: 12-10-2020, 15:53:53 »
Citace
Kontrolovať, či už procedúra meracieho cyklu ukončila svoju činnosť. Iba vtedy povoliť uzatvorenie. Medzitým môže byť formulár zobrazený a Disable
Procedúra meracieho cyklu bude kontrolovať if no Assigned(Grid) then. Tu samozrejme môže dôjsť k strate údajo

Spíš si myslím, že čistší by bylo umístit proceduru cyklu (obsluhu timeru) do stejné unit jako je ten formulář s gridem. Nebo se pletu (šeredně)?
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ěď #14 kdy: 12-10-2020, 18:27:21 »
Otevřeš soubor s flagem fmShareExclusive a pak testuješ pomocí CreateFile.
To musí fungovat.

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

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 3004
  • Karma: 135
    • Verze Delphi: D2007, XE3, DX10
Re:Test na otevření souboru
« Odpověď #30 kdy: 13-10-2020, 19:43:08 »
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.
No vsak, ale to v dusledku znamena, ze spoustis rekurzivne pumpu zprav, jak jsem se ti snazil naznacit, takze mj. narusis jejich prirozene poradi ve fronte

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #31 kdy: 13-10-2020, 21:33:56 »
Je tam ještě jedna potíž. Comport sbírá data z ústředen na této události:
Kód: Delphi [Vybrat]
  1. procedure TfrmMain.ComPort1RxChar(Sender: TObject; Count: Integer);
  2. var str: string;
  3. begin
  4. ComPort1.ReadStr(Str, Count);
  5. txtRX.Text:= txtRX.Text + str;
  6. if pos(#13, txtRX.Text)<>0 then
  7. begin
  8.   rx:=txtRX.Text;
  9.   txtRX.Text:=''; end;
  10. end;
  11.  

mercyklus čeká na 167 bytů

Kód: Delphi [Vybrat]
  1. ...
  2.                         { **** Přečtení dat z impu do stringu ****}
  3.                         rx:='';
  4.                         if i < 10 then povel:='I_SR0' + inttostr(i) + '0080' else povel:='I_SR' + inttostr(i) + '0080';
  5.                         frmmain.comport1.WriteStr(povel + #13);
  6.                         sleep(100);
  7.                         endtime:=time+0.1/(24*60*60);
  8.                         repeat
  9.                             application.ProcessMessages;
  10.                         until ((time)>endtime) or (length(rx)=167);
  11. ...
  12.  

pokud tam v té smyčce application.ProcessMessages nedám, data z portu tam nepřijdou.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline Stanislav Hruška

  • Padawan
  • ******
  • Příspěvků: 5450
  • Karma: 41
    • Verze Delphi: W10 + Delphi 10.4 professional
Re:Test na otevření souboru
« Odpověď #32 kdy: 13-10-2020, 21:49:30 »
OT: Nie je lepšie prerobiť
Kód: Delphi [Vybrat]
  1. 0.1/(24*60*60)
Na konštantu? Ja osobne veľmi nerád vidím podobné veci v cykoch. Je to práca navyše a úplne zbytočná.
W10 64b, Delphi 10.4, FireBird 3.05
Expert na kladenie nejasne formulovaných otázok.

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #33 kdy: 13-10-2020, 22:09:36 »
Asi jo, ale to nic neřeší.
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ěď #34 kdy: 13-10-2020, 22:12:12 »
Nevíte někdo o konvertoru hlp na pdf, nebo chm, nejraději online, abych ho nemusel inštalovat? Comport má Help v hlp formátu a já mám desítky. Díval jsem se na webu a nic rozumnýho jsem tam neobjevil.
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline JaroB

  • Guru
  • *****
  • Příspěvků: 1010
  • Karma: 28
    • Verze Delphi: XE8, Seattle
Re:Test na otevření souboru
« Odpověď #35 kdy: 14-10-2020, 09:28:12 »
Používáte TCommPortDriver nebo TComm32? Threadovaný byl, pokud si vzpomínám, jen TComm32, možná by to posloužilo jako mustr.

Offline pf1957

  • Padawan
  • ******
  • Příspěvků: 3004
  • Karma: 135
    • Verze Delphi: D2007, XE3, DX10
Re:Test na otevření souboru
« Odpověď #36 kdy: 14-10-2020, 09:49:11 »
Kód: Delphi [Vybrat]
  1. ...
  2.                         { **** Přečtení dat z impu do stringu ****}
  3.                         rx:='';
  4.                         if i < 10 then povel:='I_SR0' + inttostr(i) + '0080' else povel:='I_SR' + inttostr(i) + '0080';
  5.                         frmmain.comport1.WriteStr(povel + #13);
  6.                         sleep(100);
  7.                         endtime:=time+0.1/(24*60*60);
  8.                         repeat
  9.                             application.ProcessMessages;
  10.                         until ((time)>endtime) or (length(rx)=167);
  11. ...
  12.  

pokud tam v té smyčce application.ProcessMessages nedám, data z portu tam nepřijdou.
Ano, to dela to aktivni cekani repeat-until. Tak se mozna programovalo v DOSu, ale ne v event driven prostredi. Tam zadne sleep ani cekaci smycky nemaji co delat: V dobe cekani ma bezet pumpa zprav a tvoje aplikace ma obsluhovat eventy, ktere posila. Nad tim sleep(100) by se dalo zavrit oko, ale na tim repeat-until ne.

Ty to musis invertovat tj. misto repeat-until nastartovat timer s timeoutem, ktery kdyz by ticknul, tak by ses choval jako pri prekorceni casu a naopak pri obsluze RxChar bys sis prijmal znaky a kdyz bys je mel vsechny, tak bys ten timer zastavil a ty prijate znaky co nejrychleji zpracoval ev. obslouzil to zarizeni, pokud je to treba. Tim by ti za na to zpracovani jela porad pumpa zprav a nikde bys zadne ProcessMessages nepotreboval.

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #37 kdy: 14-10-2020, 10:20:52 »
Citace
TCommPortDriver nebo TComm32
Používám TComPort od Deana Crnily.

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ěď #38 kdy: 14-10-2020, 10:38:16 »
Citace
Ano, to dela to aktivni cekani repeat-until....

A jak by mercyklus poznala, že data byla přijata a může pokračovat. Je to tak, že bych měl rozkouskovat mercyklus na jednotlivé obsluhy komunikace a volat je nějakou obsluhou naplnění txtRX.Text na každou příchozí komunikaci (a těch Impů = 20-ti kanálové jednotky měřicí ústředny, může jich být až 40).
A pak až po příjmu všech hodnot řešit jinde výpočty a zobrazení? To mi připadá dost komplikované a těžko laditelné.
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ěď #39 kdy: 14-10-2020, 21:39:21 »
Ještě mám jeden dotaz. Jak se dá zjistit, že existuje instance child formuláře vytvořená za běhu programu?
 
Dalibor (D2009 Enterprise, dřív D5Enterprise)

Offline Jan Fiala

  • Plnoletý
  • ***
  • Příspěvků: 106
  • Karma: 0
    • Verze Delphi: 10.4.1
    • PSPad editor
Re:Test na otevření souboru
« Odpověď #40 kdy: 15-10-2020, 06:47:45 »
Ještě mám jeden dotaz. Jak se dá zjistit, že existuje instance child formuláře vytvořená za běhu programu?

Projdeš si child okna a zjistíš, zda instance existuje nebo ne. Jestli máš instance, které se nevytváří za běhu a vytváří za běhu, tak je něčím odliš - třeba TAG property na formuláři.

Offline Faltynek

  • Plnoletý
  • ***
  • Příspěvků: 228
  • Karma: 2
    • Verze Delphi: D5 Enterprise, D2009
Re:Test na otevření souboru
« Odpověď #41 kdy: 15-10-2020, 10:16:51 »
Díky za odpověď. Projít okna a třeba přes .Name mě napadlo, mayslel jsem, jestli to nejde přímo bez cyklu, třeba jako if frmMerení = nil, nebo tak něco..
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ěď #42 kdy: 15-10-2020, 10:43:54 »
Děkuju všem za podněty, nakonec jsem to udělal viz citace
Citace
Nabizi se priznak, ze se meri a tim blokovat zavreni formulare v OnCloseQuery... ale jak pises, to nema s programovanim mnoho spolecneho
jenom podmínku jsen dal do OnClose viz kód
Kód: Delphi [Vybrat]
  1. procedure TfrmMereni.FormClose(Sender: TObject; var Action: TCloseAction);
  2. begin
  3.   frmMain.Timer1.Enabled:=false;
  4.   frmMain.mnuPrepocet.enabled:=true;
  5.    ...  
  6.   frmMain.mnuSnetOff.enabled:=true;
  7.   cyklus:=0;
  8.   frmMain.StatusBar1.Panels[1].Text:='IDLE';
  9.   flag_zavrit_Merform:=true;
  10.   frmMain.lbMerfile.caption:='Soubor dat:' ;
  11.   if flag_muzes_merit then Action := caFree else Action:=caNone;
  12. end;
  13.  

a v Mercyklu na konci testuji flag_zavrit_Meform, nastavim  flag_muzes_merit na true a zavřu frmMereni. Vcelku to funguje.

Nejsem žádný programátor, jsem přístrojář a technik zkřížený s problematikou kotlů, turbín a elektro, takže mi stačí, když věci dělají co potřebuju. Navíc dědka mezi šedesátkou a smrtí už moc novým kouskům nenaučíš.

Ještě jednou všem děkuju.
Dalibor.
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ěď #43 kdy: 16-10-2020, 20:21:03 »
Brrr, vzpomněl jsem si, když jsem něco takového taky používal. Přitom ty vlákna opravdu nejsou nic tak strašného.
Vyzkoušej si to na něčem malém a sám uvidíš. 60+ není překážka naučit se něco nového. Důchodci se toho učí mnohem více ...