Sitemap
Mitgliederliste Mitgliederliste
Gruppen Gruppen
Das Team Das Team
Museum Richtlinien
Synonyme Synonyme
Hilfe
Login
Registrieren
Code verbesserbar (Zeitumstellung)
in Delphi Programmierung » Delphi Language (Object-Pascal) / CLX
  • delphi
  • sprache
Autor Beitrag
D. Annies
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1843

windows 7
D6 Enterprise, D7 Pers und TD 2006
BeitragVerfasst: Do 11.04.13 17:01 
Moin, Delpher,

jedesmal nach der Zeitumstellung habe ich wegen der 1h-Verschiebung ca. 400 Dateien (mit Bestätigung) zu
sichern.
Geht es auch, dass, wenn der Zeitstempel genau diese eine Stunde ausmacht (plus/minus), dass man dann
prg-gesteuert darauf verzichtet?

Code:

markieren
ausblenden volle Höhe Delphi-Quelltext 
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:
 
Procedure TBuchMain.FindFiles(aPath, aFindMask: String; aWithSub: Boolean);
Var  FindRec                       : tSearchRec;
     uvname, start, ziel           : string;
     n, erg                        : integer;
     gefunden, raus                : boolean;
Begin
  raus := false;
  Dateiliste := TStringList.Create;
  If (aPath = '') or (aFindMask = '') then Exit;
  If aPath[Length(aPath)] <> '\' Then  aPath := aPath + '\';  //Pfad := aPath;
  If FindFirst (aPath + aFindMask, faAnyFile - faDirectory, FindRec) = 0 Then
  Begin
    Repeat
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
      begin
        if aktuser <> 'an s' then    // normaler User
        begin           // die benötigten Projektdateien
          if (pos('home.', FindRec.Name) > 0) or
             (pos('.pas',  FindRec.Name) > 0) or (pos('.dfm',  FindRec.Name) > 0) or
             (pos('.res',  FindRec.Name) > 0) or (pos('.exe',  FindRec.Name) > 0) or
             (pos('.dpr',  FindRec.Name) > 0)
            OR          // die nicht benötigten Projektdateien
             (pos('.ddp',  FindRec.Name) > 0) or (pos('.dof',  FindRec.Name) > 0) or
             (pos('.dsk',  FindRec.Name) > 0) or (pos('.dcu',  FindRec.Name) > 0) or
             (pos('.cfg',  FindRec.Name) > 0) then
          begin  end    // keine PrgDatei weitergeben
        end
        else                         // if SuperUser
        begin
          if (pos('.ddp',  FindRec.Name) > 0) or  (pos('.dof',  FindRec.Name) > 0) or
             (pos('.dsk',  FindRec.Name) > 0) or  (pos('.dcu',  FindRec.Name) > 0) or
             (pos('.cfg',  FindRec.Name) > 0) then    begin  end;

          if (FindRec.Name[1] = '_')             or (pos('.~', FindRec.Name) > 0)    or
             (pos('bestand_', FindRec.Name) > 0) or (pos('temp_', FindRec.Name) > 0) or
             (pos('Geburtstag_', FindRec.Name) > 0) then
          begin
            showmessage(apath + findrec.name + ' wird gelöscht');
            DeleteFile(apath + FindRec.name)
          end;

          uvname := '';                     //Pfad
          for n := pos('Buecherei\', aPath)+10 to length(aPath) do
            uvname := uvname + apath[n];
            //uvname := uvname + '\';
                                                        // Stick nach Platte(oder 2.Stick)
          if aPath[1] = label38.Caption[1] then  // START, von zB. C: nach zB. F: = ArbeitsVerz.
          begin          //stdwert
            start := label38.Caption; ziel := label30.Caption;
            home_filename := label38.Caption + uvname + FindRec.Name;    // stdwert ?
            work_filename := label30.caption + uvname + FindRec.name;
          end
          else //if aPath[1] = label30.Caption[1] then  // ENDE, von zB. F: nach zB. C: = Rücksicherung
          begin
            start := label30.Caption; ziel := label38.caption;
            home_filename := label30.caption + uvname + FindRec.name;
            work_filename := label38.Caption + uvname + FindRec.name;    // stdwert?
          end;
                                                    // getTimeZoneInformation, DateiAttribute
          if (fileexists(home_filename)) and (fileexists(work_filename)) then
          begin

              ///////////////////////////  ! Stunde So/Wi wegcodieren

            if (FileDateToDateTime(FileAge(work_filename)) <> FileDateToDateTime(FileAge(home_filename))) and
                            (fileage(work_filename) + 3600 <> FileAge(home_filename)) and
                            (fileage(work_filename)        <> FileAge(home_filename) + 3600) then
            begin
              erg := xmessagedlg('ArchivBit wurde gesetzt' +#13 +
                       'Soll    ' + work_filename + ' '+#13+ datetimetostr(filedatetodatetime(FileAge(work_filename))) +#13+
                       'durch '   + home_filename + ' '+#13+ datetimetostr(filedatetodatetime(FileAge(home_filename))) +#13+
                       ' ersetzt werden?', mtConfirmation, [mbYes, mbno, mbcancel], ['ja', 'nein', 'Abbrechen'], self.font);
                                                             //  ???
              case erg of mryes    : CopyFile(PChar(home_filename), PChar(work_filename), FALSE);
                                     //Dateiliste.Add(home_filename + ' e');
                          mrcancel : raus := true;
              end;
            end
            // else showmessage(work_filename + ' ist von der Zeitumstellung betroffen');
          end             //CreateDir oder forcedirectories(label30.caption+uvname);
          else
          if (fileexists(home_filename)) and (not fileexists(work_filename)) then
          begin
            if not directoryexists(ziel+uvname) then CreateDir(ziel+uvname);
            CopyFile(PChar(home_filename), PChar(work_filename), TRUE);
          end;
        end
      end;
      if raus = true then BREAK;
    Until FindNext(FindRec) <> 0;  // alle Dateien aus dem Verzeichnis sind geprüft
    FindClose(FindRec);
  end;

  If (Not aWithSub) or raus Then  Exit;    // keine UV's oder Abbruch dann raus

  gefunden := FindFirst(aPath + '*.*', faAnyFile, FindRec) = 0;
  while gefunden do
  begin
    if ((FindRec.Attr and faDirectory) <> 0) and (FindRec.Name[1] <> '.') then
      FindFiles(aPath + FindRec.Name, aFindMask, aWithSub);  // Rekursion
    gefunden := FindNext(FindRec) = 0;
  end;
  FindClose(FindRec);

  {If FindFirst (aPath + '*.*', faAnyFile, FindRec) = 0 Then
  begin
    Repeat     // In Unterverzeichnissen weiter suchen
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
        If Boolean (FindRec.Attr and faDirectory) Then  // wenn es sich um ein Verzeichnis handelt
          If ((FindRec.Attr and faDirectory) <> 0) then
            FindFiles(aPath + FindRec.Name, aFindMask, aWithSub);  // Rekursion
    Until FindNext(FindRec) <> 0;
    FindClose(FindRec);
  end;}
End;


Vielen Dank für eure Ideen!
LG, Detlef

_________________
ut vires desint, tamen est laudanda voluntas
WasWeißDennIch
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 653
Erhaltene Danke: 160
BeitragVerfasst: Do 11.04.13 17:32 
Du könntest statt der lokalen Zeit die Systemzeit ermitteln (UTC) und mit der vergleichen. Siehe z.B. hier.

Für diesen Beitrag haben gedankt: D. Annies
D. Annies Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1843

windows 7
D6 Enterprise, D7 Pers und TD 2006
BeitragVerfasst: Do 11.04.13 18:04 
oder man ersetze dieses and durch ein or!
markieren
ausblenden volle Höhe Delphi-Quelltext 
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:
 
Procedure TBuchMain.FindFiles(aPath, aFindMask: String; aWithSub: Boolean);
Var  FindRec                       : tSearchRec;
     uvname, start, ziel           : string;
     n, erg                        : integer;
     gefunden, raus                : boolean;
Begin
  raus := false;
  Dateiliste := TStringList.Create;
  If (aPath = '') or (aFindMask = '') then Exit;
  If aPath[Length(aPath)] <> '\' Then  aPath := aPath + '\';  //Pfad := aPath;
  If FindFirst (aPath + aFindMask, faAnyFile - faDirectory, FindRec) = 0 Then
  Begin
    Repeat
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
      begin
        if aktuser <> 'an s' then    // normaler User
        begin           // die benötigten Projektdateien
          if (pos('home.', FindRec.Name) > 0) or
             (pos('.pas',  FindRec.Name) > 0) or (pos('.dfm',  FindRec.Name) > 0) or
             (pos('.res',  FindRec.Name) > 0) or (pos('.exe',  FindRec.Name) > 0) or
             (pos('.dpr',  FindRec.Name) > 0)
            OR          // die nicht benötigten Projektdateien
             (pos('.ddp',  FindRec.Name) > 0) or (pos('.dof',  FindRec.Name) > 0) or
             (pos('.dsk',  FindRec.Name) > 0) or (pos('.dcu',  FindRec.Name) > 0) or
             (pos('.cfg',  FindRec.Name) > 0) then
          begin  end    // keine PrgDatei weitergeben
        end
        else                         // if SuperUser
        begin
          if (pos('.ddp',  FindRec.Name) > 0) or  (pos('.dof',  FindRec.Name) > 0) or
             (pos('.dsk',  FindRec.Name) > 0) or  (pos('.dcu',  FindRec.Name) > 0) or
             (pos('.cfg',  FindRec.Name) > 0) then    begin  end;

          if (FindRec.Name[1] = '_')             or (pos('.~', FindRec.Name) > 0)    or
             (pos('bestand_', FindRec.Name) > 0) or (pos('temp_', FindRec.Name) > 0) or
             (pos('Geburtstag_', FindRec.Name) > 0) then
          begin
            showmessage(apath + findrec.name + ' wird gelöscht');
            DeleteFile(apath + FindRec.name)
          end;

          uvname := '';                     //Pfad
          for n := pos('Buecherei\', aPath)+10 to length(aPath) do
            uvname := uvname + apath[n];
            //uvname := uvname + '\';
                                                        // Stick nach Platte(oder 2.Stick)
          if aPath[1] = label38.Caption[1] then  // START, von zB. C: nach zB. F: = ArbeitsVerz.
          begin          //stdwert
            start := label38.Caption; ziel := label30.Caption;
            home_filename := label38.Caption + uvname + FindRec.Name;    // stdwert ?
            work_filename := label30.caption + uvname + FindRec.name;
          end
          else //if aPath[1] = label30.Caption[1] then  // ENDE, von zB. F: nach zB. C: = Rücksicherung
          begin
            start := label30.Caption; ziel := label38.caption;
            home_filename := label30.caption + uvname + FindRec.name;
            work_filename := label38.Caption + uvname + FindRec.name;    // stdwert?
          end;
                                                    // getTimeZoneInformation, DateiAttribute
          if (fileexists(home_filename)) and (fileexists(work_filename)) then
          begin

              ///////////////////////////  ! Stunde So/Wi wegcodieren

            if (FileDateToDateTime(FileAge(work_filename)) <> FileDateToDateTime(FileAge(home_filename))) and
                            (fileage(work_filename) + 3600 <> FileAge(home_filename)) and   //  <---- OR
                            (fileage(work_filename)        <> FileAge(home_filename) + 3600) then
            begin
              erg := xmessagedlg('ArchivBit wurde gesetzt' +#13 +
                       'Soll    ' + work_filename + ' '+#13+ datetimetostr(filedatetodatetime(FileAge(work_filename))) +#13+
                       'durch '   + home_filename + ' '+#13+ datetimetostr(filedatetodatetime(FileAge(home_filename))) +#13+
                       ' ersetzt werden?', mtConfirmation, [mbYes, mbno, mbcancel], ['ja', 'nein', 'Abbrechen'], self.font);
                                                             //  ???
              case erg of mryes    : CopyFile(PChar(home_filename), PChar(work_filename), FALSE);
                                     //Dateiliste.Add(home_filename + ' e');
                          mrcancel : raus := true;
              end;
            end
            // else showmessage(work_filename + ' ist von der Zeitumstellung betroffen');
          end             //CreateDir oder forcedirectories(label30.caption+uvname);
          else
          if (fileexists(home_filename)) and (not fileexists(work_filename)) then
          begin
            if not directoryexists(ziel+uvname) then CreateDir(ziel+uvname);
            CopyFile(PChar(home_filename), PChar(work_filename), TRUE);
          end;
        end
      end;
      if raus = true then BREAK;
    Until FindNext(FindRec) <> 0;  // alle Dateien aus dem Verzeichnis sind geprüft
    FindClose(FindRec);
  end;

  If (Not aWithSub) or raus Then  Exit;    // keine UV's oder Abbruch dann raus

  gefunden := FindFirst(aPath + '*.*', faAnyFile, FindRec) = 0;
  while gefunden do
  begin
    if ((FindRec.Attr and faDirectory) <> 0) and (FindRec.Name[1] <> '.') then
      FindFiles(aPath + FindRec.Name, aFindMask, aWithSub);  // Rekursion
    gefunden := FindNext(FindRec) = 0;
  end;
  FindClose(FindRec);

  {If FindFirst (aPath + '*.*', faAnyFile, FindRec) = 0 Then
  begin
    Repeat     // In Unterverzeichnissen weiter suchen
      If (FindRec.Name <> '.') and (FindRec.Name <> '..') Then
        If Boolean (FindRec.Attr and faDirectory) Then  // wenn es sich um ein Verzeichnis handelt
          If ((FindRec.Attr and faDirectory) <> 0) then
            FindFiles(aPath + FindRec.Name, aFindMask, aWithSub);  // Rekursion
    Until FindNext(FindRec) <> 0;
    FindClose(FindRec);
  end;}
End;

_________________
ut vires desint, tamen est laudanda voluntas
WasWeißDennIch
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 653
Erhaltene Danke: 160
BeitragVerfasst: Do 11.04.13 18:11 
Sei mir nicht böse, aber ich fände es immer noch um Längen eleganter, beiden Zeiten in ein Sommer-/Winterzeit unabhängiges Format zu bringen und dann erst zu vergleichen, als mit zeitlichen Offsets zu hantieren. Aber wie ich schon in meiner PN schrieb: es gibt auch an anderen Code-Stellen noch Potential ;)

Für diesen Beitrag haben gedankt: D. Annies
D. Annies Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1843

windows 7
D6 Enterprise, D7 Pers und TD 2006
BeitragVerfasst: Do 11.04.13 21:03 
Danke für deinen Hinweis/Erinnererung.
Ich gucke mir deinen Code am WE an, bin zurzeit ziemlich in Pression.
LG, Detlef

_________________
ut vires desint, tamen est laudanda voluntas
Gerd Kayser
ontopic starontopic starontopic starontopic starontopic starontopic starofftopic starofftopic star
Beiträge: 632
Erhaltene Danke: 121

Win 7 32-bit
Delphi 2006/XE
BeitragVerfasst: Fr 12.04.13 07:51 
1. Eine Zeitumstellung findet im Jahr an genau zwei Sonntagen statt: letzter Sonntagmorgen im März ---> eine Stunde wird übersprungen, letzter Sonntagmorgen im Oktober --> eine Stunde wird eingefügt. Man braucht also nicht bei jedem Programmlauf bei den einzelnen Dateien auf Zeitsprünge zu prüfen. Genau genommen reicht da der Zeitpunkt im Oktober, weil nur dann eine Uhrzeit zweimal auftauchen könnte (z. B. 2:30 A-Stunde und 2:30 B-Stunde). Zum Optimieren würde ich also hier ansetzen.

2. Pos arbeitet case-sensitiv.
markieren
ausblenden Delphi-Quelltext 
1:
 
(pos('.pas',  FindRec.Name) > 0) or (pos('.dfm',  FindRec.Name) > 0) or

Was passiert wohl, wenn die Endung zum Beispiel ".PAS" lautet?

Für diesen Beitrag haben gedankt: D. Annies
D. Annies Threadstarter
ontopic starontopic starontopic starontopic starontopic starontopic starontopic starontopic star
Beiträge: 1843

windows 7
D6 Enterprise, D7 Pers und TD 2006
BeitragVerfasst: Sa 13.04.13 08:20 
Danke für die Hinweise, Gerd
Gruß, Detlef

_________________
ut vires desint, tamen est laudanda voluntas

Entwickler-Ecke.de rev.276b99aea638 based on phpBB
Alle Rechte vorbehalten.
Alle Beiträge stammen von dritten Personen und dürfen geltendes Recht nicht verletzen.
Entwickler-Ecke und die zugehörigen Webseiten distanzieren sich ausdrücklich von Fremdinhalten jeglicher Art!

Impressum | Datenschutzerklärung | Kontakt zum Team