Entwickler-Ecke

Grafische Benutzeroberflächen (VCL & FireMonkey) - Leinwand/Bild erlaubt kein Zeichen!


smepal - Mi 28.05.08 14:19
Titel: Leinwand/Bild erlaubt kein Zeichen!
Wenn ich folgenden Thread ausführe bekomme ich andauernd, aber unregelmäßig die oben stehende Fehlermeldung "Leinwand/Bild erlaubt kein Zeichen!"

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:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
 
unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, CheckLst, FileCtrl, inifiles,
  IdAntiFreezeBase, IdAntiFreeze, Shellapi, ExtCtrls, ComCtrls, Dateutils, Menus,
  AppEvnts, UStringListutils;

type
  syncThread = class(TThread)
  private
    { Private-Deklarationen }
  protected
    procedure Execute; override;
  public
    constructor create; virtual;
  end;

implementation

{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten dürfen
  nur in einer Methode namens Synchronize aufgerufen werden, z.B.

      Synchronize(UpdateCaption);

  und UpdateCaption könnte folgendermaßen aussehen:

    procedure sync.UpdateCaption;
    begin
      Form1.Caption := 'Aktualisiert in einem Thread';
    end; }

{ sync }
uses unit1;

constructor syncthread.create;
begin
  inherited create(true); // CreateSuspended = true
  freeOnTerminate := true;
end;

function SetFileDate(const FileName: string; NewDate: TDateTime): Boolean;
var FileDate, FileHandle: Integer;
begin
  result := false;
  FileDate := DateTimeToFileDate(NewDate);
  FileHandle := FileOpen(FileName, fmOpenReadWrite or fmShareDenyWrite);
  if FileHandle > 0 then begin
    if FileSetDate(FileHandle, FileDate) = 0 then result:=true;
    FileClose(FileHandle);
  end;
end;


function GetFileLastAccessTime(const path: string): TDateTime;
var
  hFile: THandle;
  rStructur: TWin32FindData;
  rFileTime: TFileTime;
  dwLastAccess: cardinal;
begin
  Result := 0;
  hFile := Windows.FindFirstFile(pchar(Path), rStructur);
  if INVALID_HANDLE_VALUE <> hFile
  then begin
    Windows.FindClose(hFile);
    { FILETIME in lokales FILETIME-Format konvertieren }
    FileTimeToLocalFileTime(rStructur.ftLastWriteTime, rFileTime);
    { lokales FILETIME-Format ins DOS-Format konvertieren }
    FileTimeToDosDateTime(rFileTime, LongRec(dwLastAccess).Hi, LongRec(dwLastAccess).Lo);
    { DOS-Format in ein Delphi-Format konvertieren }
    Result := FileDateToDateTime(dwLastAccess);
  end;
end; {function GetFileLastAccessDate() ...}

procedure getfilesinserverdir(adir,async_dir: String; aftp: Tidftp; Alist, Alistcl: TStringlist; Achronik: TListbox);
var
  e: Integer;
  aseclist: TStringlist;
begin
    aseclist := TStringlist.Create;
    //Laden des Serverdateibaums
    aftp.list(alist,'',false);
    //achronik.Items.add('ServerlistCL befüllen');
    //Rekursive Abfrage nach Unterordnern
    for e:=0 to alist.Count-1 do
      begin
    // wenn Ordner
      if ((alist[e] <> '.') and (alist[e] <> '..')) then
        begin
        if ansipos('.',alist[e])=0 then
          begin
          //achronik.Items.Add('Ordner entdeckt: '+alist[e]);
          aftp.ChangeDir(alist[e]);
          aftp.List(aseclist,'',false);
          if not directoryexists(pcpath+'/'+async_dir+'/'+alist[e]) then forcedirectories(pcpath+'/'+async_dir+'/'+adir+alist[e]);
          //Rekursiver Aufruf für Unterordner
          getfilesinserverdir(adir+alist[e]+'/',async_dir,aftp,aseclist,alistcl,achronik);
          aftp.ChangeDirUp;
          end
        else
        //Wenn kein Ordner
          begin
          //Wenn in Unterordner
          if not (adir = '') then
            begin
            alistcl.Add(adir+alist[e]);
           // achronik.Items.add('      ServerlistCL hinzufügen: '+adir+ alist[e]);
            end
          else
          //Wenn in Hauptordner
            begin
            alistcl.Add(alist[e]);
           // achronik.Items.add('      ServerlistCL hinzufügen: '+ alist[e]);
            end;
          end;
        end;
      end;
end;

procedure GetFilesInDirectory(ADirectory,ADir: string; AMask: String; AList: TStringlist; ARekursiv: Boolean);
var
  SR: TSearchRec;
begin
  if (ADirectory<>'') and (ADirectory[length(ADirectory)]<>'/') then
    ADirectory:=ADirectory+'/';

  if (FindFirst(ADirectory+AMask,faAnyFile-faDirectory,SR)=0) then begin
    repeat
      if (SR.Name<>'.') and (SR.Name<>'..') and (SR.Attr<>faDirectory) then
        begin
        Alist.Add(ADir+SR.Name);
        end;
    until FindNext(SR)<>0;
    FindClose(SR);
  end;

  if ARekursiv then
    if (FindFirst(ADirectory+'*.*',faDirectory,SR)=0) then
    begin
      repeat
        if (SR.Name<>'.') and (SR.Name<>'..') then
          GetFilesInDirectory(ADirectory+SR.Name,adir+SR.Name+'/',AMask,AList,True);
      until FindNext(SR)<>0;
      FindClose(SR);
    end;

end;
procedure syncthread.Execute;
var
i,e, v,r,p, a: Integer;
done_message: String;
serverlist, serverlistcl, pclist, pclistcl, resultlist: TStringlist;
within: Boolean;
begin
sync_tool.Configbt.Enabled:= false;
sync_tool.filebt.Enabled := false;
sync_tool.syncbt.Enabled := false;
sync_tool.mark_all.Enabled := false;
sync_tool.Button1.Enabled := false;
sync_tool.Datei1.Enabled := false;
sync_tool.Config1.Enabled := false;

 try
    // Führe hier irgendwelche Berechnungen aus.

//----------------Erstellen der Stringlisten------------------//
serverlist:= Tstringlist.Create;
//chronik.Items.add('Serverlist erstellt!');
pclist:= Tstringlist.Create;
//chronik.Items.add('PClist erstellt!');
serverlistcl:= Tstringlist.Create;
//chronik.Items.add('ServerlistCL erstellt!');
pclistcl:= Tstringlist.Create;
//chronik.Items.add('PClistCL erstellt!');
resultlist:= TStringlist.Create;
//------Abfrage ob Ordner angekreuzt oder nicht-----//
for i:= 0 to sync_tool.sync_dirs.Count-1 do
  begin
  if sync_tool.sync_dirs.Checked[i] then
    begin
    if not directoryexists(pcpath+'/'+sync_tool.sync_dirs.items[i]) then mkdir(pcpath+'/'+sync_tool.sync_dirs.items[i]);
//----------Laden der beiden Dateilisten----------------//
    sync_tool.ftp.ChangeDir(sync_tool.sync_dirs.Items[i]);
    sync_tool.chronik.Items.add('Ordner: '+ sync_tool.sync_dirs.Items[i]);
//-----Füllen der Listen und "Säubern" von Ordnern
    getfilesinserverdir('',sync_tool.sync_dirs.Items[i],sync_tool.ftp,serverlist,serverlistcl,sync_tool.chronik);
    GetFilesInDirectory(pcpath+'/'+ sync_tool.sync_dirs.Items[i],'','*.*',pclist,true);

    //chronik.Items.add('PClistCL befüllen '+ inttostr(pclist.count-1));
    for e:=0 to pclist.Count-1 do
    begin
      if ((pclist[e] <> '.') and (pclist[e] <> '..')) then
        begin
        pclistcl.Add(pclist[e]);
        //chronik.Items.add('      PClistCL hinzufügen: '+ pclist[e]);
        end;
    end;
//Vergleichen der PC mit der Serverliste und holen fehlender Dateien//
    sync_tool.chronik.Items.add('---START VERGLEICH---');
    if local.ReadBool('sync','vonserver',true) then
    begin
//-------------------von Server ausgehender Vergleich-------------------//
    sync_tool.chronik.items.Add('Von Server');
    //Dateien die nur auf Server sind ermitteln//

    differencestrings(serverlistcl, pclistcl, resultlist);

    for v:=0 to resultlist.count-1 do
      begin
      sync_tool.ftp.Get(resultlist[v],pcpath+'/'+sync_tool.sync_dirs.Items[i]+'/'+ resultlist[v],true,false);
      setfiledate(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v], incsecond(dates.ReadDateTime('Files',resultlist[v], strtodatetime('02.05.2008 00:00:01')),+1));
      sync_tool.chronik.Items.add('Lade runter: '+resultlist[v]);
      show_done_list.Add('Heruntergeladen: '+resultlist[v]);
      end;
    resultlist.Clear;
    //Dateien die auf PC und Server sind ermitteln und vergleichen//
    InterSectionStrings(serverlistcl, pclistcl, resultlist);
    for v:= 0 to resultlist.Count-1 do
      begin
        if ((GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v]) < dates.ReadDateTime('Files',resultlist[v],now)))    then
          begin
          sync_tool.chronik.Items.Add('              Serverversion ist neuer!');
          sync_tool.chronik.Items.Add('              '+datetimetostr(GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v]))+' < '+ datetimetostr(dates.ReadDateTime('Files',resultlist[v], now)));
          dates.WriteDateTime('Files',resultlist[v],dates.ReadDateTime('Files',resultlist[v], now));
          sync_tool.ftp.Get(resultlist[v],pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v], true, false);
          setfiledate(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v], incsecond(dates.ReadDateTime('Files',resultlist[v], now),1));
          sync_tool.chronik.Items.add('Lade runter: '+resultlist[v]);
          show_done_list.Add('Heruntergeladen: '+resultlist[v]);
         end
         else if (GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v]) > dates.ReadDateTime('Files',resultlist[v], now))then
          begin
          sync_tool.chronik.Items.Add('              PCversion ist neuer!');
          sync_tool.chronik.Items.Add('              '+datetimetostr(GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v]))+' > '+ datetimetostr(dates.ReadDateTime('Files',resultlist[v], now)));
          sync_tool.ftp.Put(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v],resultlist[v],true);
          dates.WriteDateTime('Files',resultlist[v], getfilelastaccesstime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v]));
          sync_tool.chronik.items.add('Lade hoch: '+resultlist[v]);
          show_done_list.Add('Hochgeladen: '+resultlist[v]);
          end
         else if (GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ resultlist[v]) = dates.ReadDateTime('Files',resultlist[v], now))then
        sync_tool.chronik.items.add('Versionen sind gleich!');
        end;
      resultlist.clear;
//    for v:=0 to serverlistcl.Count-1 do
//      begin
//      r :=0;
//      within:=false;
//      if pclistcl.Count<>0 then
//        begin
//        repeat
//          begin
//          sync_tool.chronik.Items.Add('         Vergleiche: '+serverlistcl[v]+' mit ' + pclistcl[r]);
//          if serverlistcl[v] <> pclistcl[r] then within:= false else within := true;
//          P:=r;
//          inc(r);
//          end;
//        until
//          (within = true) OR (pclistcl.Count = r);
//        end
//        else
//        within := false;
//
//      if within = false then
//        begin
//        sync_tool.ftp.Get(serverlistcl[v],pcpath+'/'+sync_tool.sync_dirs.Items[i]+'/'+ serverlistcl[v],true,false);
//        setfiledate(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v], incsecond(dates.ReadDateTime('Files',serverlistcl[v], strtodatetime('02.05.2008 00:00:01')),+1));
//        sync_tool.chronik.Items.add('Lade runter: '+serverlistcl[v]);
//        show_done_list.Add('Heruntergeladen: '+serverlistcl[v]);
//        end
//
//      else
//        begin
//        if ((GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v]) < dates.ReadDateTime('Files',serverlistcl[v],now)))    then
//          begin
//          sync_tool.chronik.Items.Add('              Serverversion ist neuer!');
//          sync_tool.chronik.Items.Add('              '+datetimetostr(GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v]))+' < '+ datetimetostr(dates.ReadDateTime('Files',serverlistcl[v], now)));
//          dates.WriteDateTime('Files',serverlistcl[v],dates.ReadDateTime('Files',serverlistcl[v], now));
//          sync_tool.ftp.Get(serverlistcl[v],pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v], true, false);
//          setfiledate(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v], incsecond(dates.ReadDateTime('Files',serverlistcl[v], now),1));
//          sync_tool.chronik.Items.add('Lade runter: '+serverlistcl[v]);
//          show_done_list.Add('Heruntergeladen: '+serverlistcl[v]);
//         end
//         else if (GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v]) > dates.ReadDateTime('Files',serverlistcl[v], now))then
//          begin
//          sync_tool.chronik.Items.Add('              PCversion ist neuer!');
//          sync_tool.chronik.Items.Add('              '+datetimetostr(GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v]))+' > '+ datetimetostr(dates.ReadDateTime('Files',serverlistcl[v], now)));
//          sync_tool.ftp.Put(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v],serverlistcl[v],true);
//          dates.WriteDateTime('Files',serverlistcl[v], getfilelastaccesstime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v]));
//          sync_tool.chronik.items.add('Lade hoch: '+serverlistcl[v]);
//          show_done_list.Add('Hochgeladen: '+serverlistcl[v]);
//          end
//         else if (GetFileLastAccessTime(pcpath+'\'+sync_tool.sync_dirs.Items[i]+'\'+ serverlistcl[v]) = dates.ReadDateTime('Files',serverlistcl[v], now))then
//        sync_tool.chronik.items.add('Versionen sind gleich!');
//        end;
//      end;
      end;
//-------------------------von PC ausgehender Verlgleich--------------------//
      if local.ReadBool('sync','vonpc',true) then
      begin
      sync_tool.chronik.Items.add('Von PC');
      DifferenceStrings(pclistcl,serverlistcl,resultlist);
      for v:=0 to resultlist.Count-1 do
      begin
        sync_tool.ftp.Put(pcpath+'/'+sync_tool.sync_dirs.Items[i]+'/'+ resultlist[v],resultlist[v],false);
        dates.WriteDateTime('files',resultlist[v],getfilelastaccesstime(pcpath+'/'+sync_tool.sync_dirs.Items[i]+'/'+ resultlist[v]));
        sync_tool.chronik.Items.add('Lade hoch: '+resultlist[v]);
        show_done_list.Add('Hochgeladen: '+serverlistcl[v]);
      end;
      resultlist.Clear;
//     for v:=0 to pclistcl.Count-1 do
//      begin
//      r :=0;
//      within:=false;
//      if serverlistcl.Count<>0 then
//        begin
//        repeat
//          begin
//          sync_tool.chronik.Items.Add('         Vergleiche: '+pclistcl[v]+' mit ' + serverlistcl[r]);
//          if pclistcl[v] <> serverlistcl[r] then within:= false else within := true;
//          P:=r;
//          inc(r);
//          end;
//        until
//          (within = true) OR (serverlistcl.Count = r);
//        end
//        else
//        within := false;
//
//      if within = false then
//        begin
//        sync_tool.ftp.Put(pcpath+'/'+sync_tool.sync_dirs.Items[i]+'/'+ pclistcl[v],pclistcl[v],false);
//        dates.WriteDateTime('files',pclistcl[v],getfilelastaccesstime(pcpath+'/'+sync_tool.sync_dirs.Items[i]+'/'+ pclistcl[v]));
//        sync_tool.chronik.Items.add('Lade hoch: '+pclistcl[v]);
//        show_done_list.Add('Hochgeladen: '+serverlistcl[v]);
//        end;
//       end;
       end;
    sync_tool.chronik.Items.add('---ENDE VERGLEICH---');
//Löschen der Stringlisten//
    serverlist.Clear;
    pclist.clear;
    pclistcl.Clear;
    serverlistcl.Clear;
    sync_tool.ftp.ChangeDirUp;
    end;
  end;
if local.ReadBool('general','show_done',true)then
begin
if show_done_list.Count = 0 then
showmessage('Es hat kein Transfer stattgefunden!')
else
begin
for a := 0 to show_done_list.Count-1 do
done_message := done_message +#13+show_done_list.Strings[a];

showmessage(done_message);
end;
end;

show_done_list.Clear;
done_message := '';
except
    on e: exception do begin
      // mache hier irgendetwas mit dem Fehler.
    application.ShowException(e);
    end;
  end;

sync_tool.Configbt.Enabled:= true;
sync_tool.filebt.Enabled := true;
sync_tool.syncbt.Enabled := true;
sync_tool.mark_all.Enabled := true;
sync_tool.Button1.Enabled := true;
sync_tool.MainMenu1.Items.Enabled:= true;
sync_tool.Datei1.Enabled := true;
sync_tool.Config1.Enabled := true;
end;

end.



Moderiert von user profile iconNarses: Topic aus Internet / Netzwerk verschoben am Mi 28.05.2008 um 15:23


jaenicke - Mi 28.05.08 15:15
So kann das auch nicht gehen, du greifst direkt auf die VCL zu, diese ist aber nicht threadsicher.
user profile iconsmepal hat folgendes geschrieben:

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
 
procedure syncthread.Execute;
var
i,e, v,r,p, a: Integer;
done_message: String;
serverlist, serverlistcl, pclist, pclistcl, resultlist: TStringlist;
within: Boolean;
begin
sync_tool.Configbt.Enabled:= false;
sync_tool.filebt.Enabled := false;
sync_tool.syncbt.Enabled := false;
sync_tool.mark_all.Enabled := false;
sync_tool.Button1.Enabled := false;
Und das obwohl oben der Kommentar ja noch drin ist, wo explizit steht, dass das so nicht funktioniert... :roll:

user profile iconsmepal hat folgendes geschrieben:

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
 
{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten dürfen
  nur in einer Methode namens Synchronize aufgerufen werden, z.B.

      Synchronize(UpdateCaption);

  und UpdateCaption könnte folgendermaßen aussehen:

    procedure sync.UpdateCaption;
    begin
      Form1.Caption := 'Aktualisiert in einem Thread';
    end; }


smepal - Mi 28.05.08 15:53
Vielen Dank!
Das habe ich jetzt gemacht!
Jetzt bekomme ich irgendwie eine Zugriffsverletzung, die ich aber nicht lokalisieren kann!

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:
116:
117:
118:
119:
120:
121:
122:
123:
124:
125:
126:
127:
128:
129:
130:
131:
132:
133:
134:
135:
136:
137:
138:
139:
140:
141:
142:
143:
144:
145:
146:
147:
148:
149:
150:
151:
152:
153:
154:
155:
156:
157:
158:
159:
160:
161:
162:
163:
164:
165:
166:
167:
168:
169:
170:
171:
172:
173:
174:
175:
176:
177:
178:
179:
180:
181:
182:
183:
184:
185:
186:
187:
188:
189:
190:
191:
192:
193:
194:
195:
196:
197:
198:
199:
200:
201:
202:
203:
204:
205:
206:
207:
208:
209:
210:
211:
212:
213:
214:
215:
216:
217:
218:
219:
220:
221:
222:
223:
224:
225:
226:
227:
228:
229:
230:
231:
232:
233:
234:
235:
236:
237:
238:
239:
240:
241:
242:
243:
244:
245:
246:
247:
248:
249:
250:
251:
252:
253:
254:
255:
256:
257:
258:
259:
260:
261:
262:
263:
264:
265:
266:
267:
268:
269:
270:
271:
272:
273:
274:
275:
276:
277:
278:
279:
280:
281:
282:
283:
284:
285:
286:
287:
288:
289:
290:
291:
292:
293:
294:
295:
296:
297:
298:
299:
300:
301:
302:
303:
304:
305:
306:
307:
308:
309:
310:
311:
312:
313:
314:
315:
316:
317:
318:
319:
320:
321:
322:
323:
324:
325:
326:
327:
328:
329:
330:
331:
332:
333:
334:
335:
336:
337:
338:
339:
340:
341:
342:
343:
344:
345:
346:
347:
348:
349:
350:
351:
352:
353:
354:
355:
356:
357:
358:
359:
360:
361:
362:
363:
364:
365:
366:
367:
368:
369:
370:
371:
372:
373:
374:
375:
376:
377:
378:
379:
380:
381:
382:
383:
384:
385:
386:
387:
388:
389:
390:
391:
392:
393:
394:
395:
396:
397:
398:
399:
400:
401:
402:
403:
404:
405:
406:
 
unit Unit5;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient,
  IdExplicitTLSClientServerBase, IdFTP, CheckLst, FileCtrl, inifiles,
  IdAntiFreezeBase, IdAntiFreeze, Shellapi, ExtCtrls, ComCtrls, Dateutils, Menus,
  AppEvnts, UStringListutils;

type
  syncThread = class(TThread)
    procedure load_settings;
    procedure configure_buttons;
    procedure write_text_1;
    procedure write_text_2;
    procedure write_text_3;
    procedure write_text_4;
    procedure write_text_5;
    procedure write_text_6;
    procedure write_text_7;
    procedure write_text_8;
    procedure write_text_9;
    procedure write_text_10;
    procedure write_text_11;
    procedure write_text_12;
    procedure write_text_13;
    procedure write_text_14;
    procedure write_text_15;
    procedure write_text_16;

  private
    { Private-Deklarationen }

  protected
    procedure Execute; override;
  public
    constructor create; virtual;
  end;

implementation

{ Wichtig: Methoden und Eigenschaften von Objekten in visuellen Komponenten dürfen
  nur in einer Methode namens Synchronize aufgerufen werden, z.B.

      Synchronize(UpdateCaption);

  und UpdateCaption könnte folgendermaßen aussehen:

    procedure sync.UpdateCaption;
    begin
      Form1.Caption := 'Aktualisiert in einem Thread';
    end; }

{ sync }
uses unit1;
var
sync_dirs_max: Integer;
info, sync_dir: String;
sync_dir_checked: Array of Boolean ;
current_sync_dir: Array of String;

constructor syncthread.create;
begin
  inherited create(true); // CreateSuspended = true
  freeOnTerminate := true;
end;

function SetFileDate(const FileName: string; NewDate: TDateTime): Boolean;
var FileDate, FileHandle: Integer;
begin
  result := false;
  FileDate := DateTimeToFileDate(NewDate);
  FileHandle := FileOpen(FileName, fmOpenReadWrite or fmShareDenyWrite);
  if FileHandle > 0 then begin
    if FileSetDate(FileHandle, FileDate) = 0 then result:=true;
    FileClose(FileHandle);
  end;
end;

function GetFileLastAccessTime(const path: string): TDateTime;
var
  hFile: THandle;
  rStructur: TWin32FindData;
  rFileTime: TFileTime;
  dwLastAccess: cardinal;
begin
  Result := 0;
  hFile := Windows.FindFirstFile(pchar(Path), rStructur);
  if INVALID_HANDLE_VALUE <> hFile
  then begin
    Windows.FindClose(hFile);
    { FILETIME in lokales FILETIME-Format konvertieren }
    FileTimeToLocalFileTime(rStructur.ftLastWriteTime, rFileTime);
    { lokales FILETIME-Format ins DOS-Format konvertieren }
    FileTimeToDosDateTime(rFileTime, LongRec(dwLastAccess).Hi, LongRec(dwLastAccess).Lo);
    { DOS-Format in ein Delphi-Format konvertieren }
    Result := FileDateToDateTime(dwLastAccess);
  end;
end; {function GetFileLastAccessDate() ...}

procedure getfilesinserverdir(adir,async_dir: String; aftp: Tidftp; Alist, Alistcl: TStringlist; Achronik: TListbox);
var
  e: Integer;
  aseclist: TStringlist;
begin
    aseclist := TStringlist.Create;
    //Laden des Serverdateibaums
    aftp.list(alist,'',false);
    //achronik.Items.add('ServerlistCL befüllen');
    //Rekursive Abfrage nach Unterordnern
    for e:=0 to alist.Count-1 do
      begin
    // wenn Ordner
      if ((alist[e] <> '.') and (alist[e] <> '..')) then
        begin
        if ansipos('.',alist[e])=0 then
          begin
          //achronik.Items.Add('Ordner entdeckt: '+alist[e]);
          aftp.ChangeDir(alist[e]);
          aftp.List(aseclist,'',false);
          if not directoryexists(pcpath+'/'+async_dir+'/'+alist[e]) then forcedirectories(pcpath+'/'+async_dir+'/'+adir+alist[e]);
          //Rekursiver Aufruf für Unterordner
          getfilesinserverdir(adir+alist[e]+'/',async_dir,aftp,aseclist,alistcl,achronik);
          aftp.ChangeDirUp;
          end
        else
        //Wenn kein Ordner
          begin
          //Wenn in Unterordner
          if not (adir = '') then
            begin
            alistcl.Add(adir+alist[e]);
           // achronik.Items.add('      ServerlistCL hinzufügen: '+adir+ alist[e]);
            end
          else
          //Wenn in Hauptordner
            begin
            alistcl.Add(alist[e]);
           // achronik.Items.add('      ServerlistCL hinzufügen: '+ alist[e]);
            end;
          end;
        end;
      end;
end;

procedure GetFilesInDirectory(ADirectory,ADir: string; AMask: String; AList: TStringlist; ARekursiv: Boolean);
var
  SR: TSearchRec;
begin
  if (ADirectory<>'') and (ADirectory[length(ADirectory)]<>'/') then
    ADirectory:=ADirectory+'/';

  if (FindFirst(ADirectory+AMask,faAnyFile-faDirectory,SR)=0) then begin
    repeat
      if (SR.Name<>'.') and (SR.Name<>'..') and (SR.Attr<>faDirectory) then
        begin
        Alist.Add(ADir+SR.Name);
        end;
    until FindNext(SR)<>0;
    FindClose(SR);
  end;

  if ARekursiv then
    if (FindFirst(ADirectory+'*.*',faDirectory,SR)=0) then
    begin
      repeat
        if (SR.Name<>'.') and (SR.Name<>'..') then
          GetFilesInDirectory(ADirectory+SR.Name,adir+SR.Name+'/',AMask,AList,True);
      until FindNext(SR)<>0;
      FindClose(SR);
    end;

end;

procedure syncthread.configure_buttons;
begin
sync_dirs_max := sync_tool.sync_dirs.Count-1;

end;


procedure syncthread.write_text_1;
begin
sync_tool.chronik.Items.add('---START VERGLEICH---');
end;
procedure syncthread.write_text_2;
begin
sync_tool.chronik.items.Add('Von Server');
end;
procedure syncthread.write_text_3;
begin
sync_tool.chronik.Items.add('Lade runter: '+info);
end;
procedure syncthread.write_text_4;
begin
sync_tool.chronik.Items.Add('              Serverversion ist neuer!');
end;
procedure syncthread.write_text_5;
begin
sync_tool.chronik.Items.Add('              '+datetimetostr(GetFileLastAccessTime(pcpath+'\'+sync_dir+'\'+ info))+' < '+ datetimetostr(dates.ReadDateTime('Files',info, now)));
end;
procedure syncthread.write_text_6;
begin
sync_tool.chronik.Items.add('Lade runter: '+info);
end;
procedure syncthread.write_text_7;
begin
sync_tool.chronik.Items.Add('              PCversion ist neuer!');
end;
procedure syncthread.write_text_8;
begin
sync_tool.chronik.Items.Add('              '+datetimetostr(GetFileLastAccessTime(pcpath+'\'+sync_dir+'\'+ info))+' > '+ datetimetostr(dates.ReadDateTime('Files',info, now)));
end;
procedure syncthread.write_text_9;
begin
sync_tool.chronik.items.add('Lade hoch: '+info);
end;
procedure syncthread.write_text_10;
begin
sync_tool.chronik.items.add('Versionen sind gleich!');
end;
procedure syncthread.write_text_11;
begin
sync_tool.chronik.Items.add('Von PC');
end;
procedure syncthread.write_text_12;
begin
sync_tool.chronik.Items.add('Lade hoch: '+info);
end;
procedure syncthread.write_text_13;
begin
sync_tool.chronik.Items.add('---ENDE VERGLEICH---');
end;
procedure syncthread.write_text_14;
begin
showmessage('Es hat kein Transfer stattgefunden!');
end;
procedure syncthread.write_text_15;
begin
showmessage(info);
end;
procedure syncthread.write_text_16;
begin
sync_tool.chronik.Items.add('Ordner: '+ info);
end;


procedure syncthread.load_settings;
var e: Integer;
begin
setlength(sync_dir_checked,sync_dirs_max);
for e:=0 to sync_tool.sync_dirs.Count-1 do
sync_dir_checked[e] := sync_tool.sync_dirs.Checked[e];

setlength(current_sync_dir,sync_dirs_max);
for e :=0 to sync_tool.sync_dirs.Count-1 do
current_sync_dir[e] := sync_tool.sync_dirs.items[e];
end;

procedure syncthread.Execute;
var
i,e, v,r,p, a: Integer;
done_message: String;
serverlist, serverlistcl, pclist, pclistcl, resultlist: TStringlist;
within: Boolean;
begin
synchronize(configure_buttons);

 try
    // Führe hier irgendwelche Berechnungen aus.

//----------------Erstellen der Stringlisten------------------//
serverlist:= Tstringlist.Create;
//chronik.Items.add('Serverlist erstellt!');
pclist:= Tstringlist.Create;
//chronik.Items.add('PClist erstellt!');
serverlistcl:= Tstringlist.Create;
//chronik.Items.add('ServerlistCL erstellt!');
pclistcl:= Tstringlist.Create;
//chronik.Items.add('PClistCL erstellt!');
resultlist:= TStringlist.Create;
//------Abfrage ob Ordner angekreuzt oder nicht-----//
  synchronize(load_settings);
for i:= 0 to sync_dirs_max do
  begin

  if sync_dir_checked[i] then
    begin
    if not directoryexists(pcpath+'/'+current_sync_dir[i]) then mkdir(pcpath+'/'+current_sync_dir[i]);
//----------Laden der beiden Dateilisten----------------//
    sync_tool.ftp.ChangeDir(sync_tool.sync_dirs.Items[i]);
    synchronize(write_text_16);
//-----Füllen der Listen und "Säubern" von Ordnern
    getfilesinserverdir('',current_sync_dir[i],sync_tool.ftp,serverlist,serverlistcl,sync_tool.chronik);
    GetFilesInDirectory(pcpath+'/'+ current_sync_dir[i],'','*.*',pclist,true);

    //chronik.Items.add('PClistCL befüllen '+ inttostr(pclist.count-1));
    for e:=0 to pclist.Count-1 do
    begin
      if ((pclist[e] <> '.') and (pclist[e] <> '..')) then
        begin
        pclistcl.Add(pclist[e]);
        //chronik.Items.add('      PClistCL hinzufügen: '+ pclist[e]);
        end;
    end;
//Vergleichen der PC mit der Serverliste und holen fehlender Dateien//
    synchronize(write_text_1);
    if local.ReadBool('sync','vonserver',true) then
    begin
//-------------------von Server ausgehender Vergleich-------------------//
    synchronize(write_text_2);
    //Dateien die nur auf Server sind ermitteln//

    differencestrings(serverlistcl, pclistcl, resultlist);

    for v:=0 to resultlist.count-1 do
      begin
      sync_tool.ftp.Get(resultlist[v],pcpath+'/'+current_sync_dir[i]+'/'+ resultlist[v],true,false);
      setfiledate(pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v], incsecond(dates.ReadDateTime('Files',resultlist[v], strtodatetime('02.05.2008 00:00:01')),+1));
      info := resultlist[v];
      synchronize(write_text_3);
      show_done_list.Add('Heruntergeladen: '+resultlist[v]);
      end;
    resultlist.Clear;
    //Dateien die auf PC und Server sind ermitteln und vergleichen//
    InterSectionStrings(serverlistcl, pclistcl, resultlist);
    for v:= 0 to resultlist.Count-1 do
      begin
        if ((GetFileLastAccessTime(pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v]) < dates.ReadDateTime('Files',resultlist[v],now)))    then
          begin
          synchronize(write_text_4);
          sync_dir:=current_sync_dir[i];
          synchronize(write_text_5);
          dates.WriteDateTime('Files',resultlist[v],dates.ReadDateTime('Files',resultlist[v], now));
          sync_tool.ftp.Get(resultlist[v],pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v], true, false);
          setfiledate(pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v], incsecond(dates.ReadDateTime('Files',resultlist[v], now),1));
          synchronize(write_text_6);
          show_done_list.Add('Heruntergeladen: '+resultlist[v]);
         end
         else if (GetFileLastAccessTime(pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v]) > dates.ReadDateTime('Files',resultlist[v], now))then
          begin
          synchronize(write_text_7);
          sync_dir:=current_sync_dir[i];
          synchronize(write_text_8);
          sync_tool.ftp.Put(pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v],resultlist[v],true);
          dates.WriteDateTime('Files',resultlist[v], getfilelastaccesstime(pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v]));
          synchronize(write_text_9);
          show_done_list.Add('Hochgeladen: '+resultlist[v]);
          end
         else if (GetFileLastAccessTime(pcpath+'\'+current_sync_dir[i]+'\'+ resultlist[v]) = dates.ReadDateTime('Files',resultlist[v], now))then
         synchronize(write_text_10);
        end;
      resultlist.clear;
      end;
//-------------------------von PC ausgehender Verlgleich--------------------//
      if local.ReadBool('sync','vonpc',true) then
      begin
      synchronize(write_text_11);
      DifferenceStrings(pclistcl,serverlistcl,resultlist);
      for v:=0 to resultlist.Count-1 do
      begin
        sync_tool.ftp.Put(pcpath+'/'+current_sync_dir[i]+'/'+ resultlist[v],resultlist[v],false);
        dates.WriteDateTime('files',resultlist[v],getfilelastaccesstime(pcpath+'/'+current_sync_dir[i]+'/'+ resultlist[v]));
        synchronize(write_text_12);
        show_done_list.Add('Hochgeladen: '+serverlistcl[v]);
      end;
      resultlist.Clear;
    end;
    synchronize(write_text_13);
//Löschen der Stringlisten//
    serverlist.Clear;
    pclist.clear;
    pclistcl.Clear;
    serverlistcl.Clear;
    sync_tool.ftp.ChangeDirUp;
    end;
  end;
if local.ReadBool('general','show_done',true)then
begin
if show_done_list.Count = 0 then
synchronize(write_text_14)
else
begin
for a := 0 to show_done_list.Count-1 do
done_message := done_message +#13+show_done_list.Strings[a];
info := done_message;
synchronize(write_text_15);

end;
end;

show_done_list.Clear;
done_message := '';
except
    on e: exception do begin
      // mache hier irgendetwas mit dem Fehler.
    application.ShowException(e);
    end;
  end;


end;

end.


Delete - Mi 28.05.08 21:50
user profile iconsmepal hat folgendes geschrieben:
Jetzt bekomme ich irgendwie eine Zugriffsverletzung, die ich aber nicht lokalisieren kann!

Gib mal einen Tipp, wie wir den Grund jetzt finden sollen in 406 geposteten Zeilen Code?


smepal - Mi 28.05.08 21:57
kann ich leider im Moment nicht, da mein Delphi gerade schrott ist... werds morgen mal neu aufspielen und dann weiter sehen!


Bernhard Geyer - Do 29.05.08 07:40
user profile iconsmepal hat folgendes geschrieben:
kann ich leider im Moment nicht, da mein Delphi gerade schrott ist... werds morgen mal neu aufspielen und dann weiter sehen!

Was macht ihr immer? In 99,9% der Fälle braucht man Delphi nicht neu installieren um es wieder zum laufen zu bekommen


smepal - Do 29.05.08 09:28
Ka wodran es lag! Läuft jedenfalls wieder!

Der Fehler lag an dem DynArray. Habs einfach statisch gemacht und dann gings!


jaenicke - Do 29.05.08 10:48

Delphi-Quelltext 
1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:
19:
20:
21:
 
procedure syncthread.load_settings;
var e: Integer;
begin
setlength(sync_dir_checked,sync_dirs_max);
for e:=0 to sync_tool.sync_dirs.Count-1 do
sync_dir_checked[e] := sync_tool.sync_dirs.Checked[e];

setlength(current_sync_dir,sync_dirs_max);
for e :=0 to sync_tool.sync_dirs.Count-1 do
current_sync_dir[e] := sync_tool.sync_dirs.items[e];
end;

procedure syncthread.Execute;

// ...

for i:= 0 to sync_dirs_max do
  begin

  if sync_dir_checked[i] then
    begin
Du setzt die Länge auf sync_dirs_max, in der Schleife in Execute gehst du aber bis zu diesem Wert ohne das -1 und damit ist der letzte Index eins höher als der höchste des Arrays.


Entwickler-Ecke.de based on phpBB
Copyright 2002 - 2011 by Tino Teuber, Copyright 2011 - 2025 by Christian Stelzmann 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!