CopyFrom von Streams mit Abbrechen ?

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

Hallo,
gibt es eine möglichkeit oder eine bereist vorhanden(Freeware) lösung, wie ich es schaffen könnte einen TFilestream
in einen andren zu kopieren und dabei habe ich dann die möglichkeit das kopieren abzubrechen(sofort) und mir auch die bis jetzt kopierten byts ständig zurückgibt ???

_________________
MFG
Michael Springwald, "kann kein englisch...."

wulfskin · Verfasst: Sa 15.01.05 22:42

Hallo,

sowas kann man sich leicht selber basteln. Einfach in einer Schleife immer einen Teil einlesen und diesen in den nächsten Teil schreiben. Da du dann eine feste Größe hast, die geschrieben wird und die gesamte Größe kennst, kannst du das ganze auch in einer ProgressBar darstellen lassen.

Gruß Hape!

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

das habe ich versucht aber meine procedure geht leider nur wenn der dateizeiger am anfang steht, da ich habe einen archiver schreibe wollte ich ganz gerne es schaffen, dass es auch mitten drin funktioniert, hier mein code:

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

function CopyFrom(Qulle, Ziel:TFileStream; CopyByt, Status:Integer):Integer;
const
  BufferSize=30;
var
  i,Count:Integer;
  Buffer: array[0..BufferSize-1] of Byte;
begin
  while True do begin
    Qulle.position:=0;
    Count:=Qulle.Read(Buffer, BufferSize);
    if Count <> 0 then
      Ziel.WriteBuffer(Buffer, Count)
    else
      Break;
  end;

end;

_________________
MFG
Michael Springwald, "kann kein englisch...."

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

habs hinbekommen, in dieser funtkion funktioniert noch nicht das abbrechen(das kommt später)
hier ist mal die lösung

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:
18:

function CopyFrom(Qulle, Ziel:TFileStream; CopyByt, Status:Integer):Integer;
const
  BufferSize=30;
var
  i,Count:Integer;
  Buffer: array[0..BufferSize-1] of Byte;
begin
  i:=0;
  while True do begin
    Count:=Qulle.Read(Buffer, BufferSize);
    i:=i+count;
    if (i <= CopyByt) and (Count <> 0) then
      Ziel.WriteBuffer(Buffer, Count)
    else
      Break;
  end;

end;

problem war nur: ich hatte vorher den qull stream auf 0 gesetzt, dann kannst es ja auch nicht funktionieren.

_________________
MFG
Michael Springwald, "kann kein englisch...."

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

die funktion von oben hat leider noch einen kleinen fehler dort war keine byt beschrängung ich wollte nur so und so viele byt koopieren und nicht alles kopieren !
dise funtkion hat einen kleinen fehler un zwar: bei der zieldatei fehlen 30 byts, ich habe jetzt noch einies versucht aber komme leider nicht auf die lösung:

markieren

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:

function CopyFrom(Qulle, Ziel:TFileStream; CopyByt, Status:Integer):Integer;
const
  BufferSize=30;
var
  i,z,Count:Integer;
  Buffer: array[0..BufferSize-1] of Byte;
begin
  i:=0;
  while True do begin
    Count:=Qulle.Read(Buffer, BufferSize);

    inc(i);
    if (i > CopyByt div 30) and (Count <> 0) then begin
      count:=CopyByt-(i * 30);
      i:=0;
      Ziel.WriteBuffer(Buffer, Count);
      break;
    end
    else begin
      if Count <> 0 then
        Ziel.WriteBuffer(Buffer, Count)
      else
        Break;
    end;
  end;
end;

_________________
MFG
Michael Springwald, "kann kein englisch...."

BenBE · Verfasst: Sa 22.01.05 01:24

markieren

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:

TOnProgressHandler = procedure (Src, Dest:TStream; Curr, Total:Integer; var Continue:Boolean);

Procedure CopyFrom(Src, Dest:TStream; OnProgress: TOnProgressHandler);
var
    Continue:Boolean;
    BufSize: Integer;
    Buf: Array of Byte;
begin
    SetLength(Buf, 65536);
    
    Continue := True;
    Src.Position := 0;
    While Src.Position < Src.Size Do
    Begin
        BufSize := Src.Read(Buf[0], Length(Buf));
        If Assigned(OnProgress) Then
            OnProgress(Src, Dest, Src.Position, Src.Size, Continue);
        Continue := Continue and (BufSize <> 0);
        If Continue Then
            Dest.WriteBuffer(Buf[0], BufSize)
        else
            Exit;
    end;
end;

Um diese Routine abzubrechen übergibt man eine "Progress"-Handler und setz in diesem einfach den Wert von Continue auf False ... Dat war's auch schon ;-)

BTW: Für OOP müsste noch "of object" bei der Type-Deklaration ergänzt werden ...

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

Danke für deime mühe geht aber leider nicht so wie ich sie haben wollte, sie sollte so funktionieren wie die "richtig copyFrom" funktion von delphi d.h. er soll vom qullstream nur das kopieren was ich ihn an byts übergbe und nicht gleich alles....

Beispiel:
ich habe zwei Stream(in meinem archiver) einen Goblan der ist in ai.a und nun möchte ich z.b. gerne entpacken dann habe ich einen staik stream in der entpack funktion, nämlich datei. und nun setze ich die pos von ai.a und ermittele aus dem dateiheader die größe der datei (die ich entpacken möchte). hier der qullcode(das berechnen der pos geht wenn ich die funktion von delphi nehm zum kopieren geht es):

markieren

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:

procedure TArchiver.ExtractFile(dir:String);

function GetFileName(FileName:String):Integer;
var
  i,z:Integer;
begin
  z:=-1;
  for i:=0 to AI.Header.Count-1 do begin
    if GetToken(AI.Header.Strings[i],';',1) = FileName then begin
      z:=i;
      break;
    end;
  end;
  result:=z;
end;

var
  i:Integer;
  Datei:TFileStream;
  FN,dir1:String;
  s:string;
begin
 try
   if ai.A = nil then
     OpenArchiv(ai.Name);
   finally
     for i:=0 to AI.FileListe.Count-1 do begin
       dir1:=Hauptverzeichnis(AI.FileListe);
       s:=GetToken(ai.FileListe.strings[i],';',1);
       Delete(s,1,StrLen(Pchar(dir1)));
       dir1:=dir + s;

       FN:=GetToken(AI.FileListe.Strings[i],';',Integer(FIFileName));
       if DirectoryExists(extractFileDir(dir1)) = False then
         ForceDirectories(extractFileDir(dir1));

       Datei:=TFileStream.Create(dir1,fmCreate);
       AI.A.Position:=AI.Header_EndPos + GetFilePos(fn);
//       Datei.CopyFrom(AI.A,StrToInt(GetToken(ai.Header.strings[GetFileName(fn)],';',Integer(FiFileSize))));
       CopyFrom(AI.a,Datei,AI.A.Position+StrToInt(GetToken(ai.Header.strings[GetFileName(fn)],';',Integer(FiFileSize))),nil);
       Datei.Free;
     end;
   end;
end;

_________________
MFG
Michael Springwald, "kann kein englisch...."

BenBE · Verfasst: Sa 22.01.05 14:59

Was ist daran ddas Problem, sowas zu implementieren?

markieren

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:

TOnProgressHandler = procedure (Src, Dest:TStream; Curr, Total:Integer; var Continue:Boolean);

Procedure CopyFrom(Src, Dest:TStream; Size: Integer; OnProgress: TOnProgressHandler);
var
    Continue:Boolean;
    BufSize: Integer;
    Buf: Array of Byte;
begin
    SetLength(Buf, 65536);
    
    Continue := True;
    Src.Position := 0;
    While (Src.Position < Src.Size) and (Size > 0)Do
    Begin
        BufSize := Size;
        If BufSize > Length(Buf) Then
            BufSize := Length(Buf);
        BufSize := Src.Read(Buf[0], BufSize);
        If Assigned(OnProgress) Then
            OnProgress(Src, Dest, Src.Position, Src.Size, Continue);
        Continue := Continue and (BufSize <> 0);
        If Continue Then
            Dest.WriteBuffer(Buf[0], BufSize)
        else
            Exit;
        Dec(Size, BufSize);
    end;
end;

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

das problem ist folgendes: ich habe einen stream dort ist das gesammte archiv drin d.h. auch der heade jetzt setzte ich die pos auf das header ende und nimm ihn plus die berechnete datei anfans pos. und wenn ich jetzt deine funktion nehme macht sie die datei groß eine datei im archiv ist z.b. 23.634 Bytes groß und deine funktion macht davon 64 KB groß ich habe sie etwas umgebaut aber ohne erfolgt:

markieren

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:

Procedure TArchiver.CopyFrom(Src, Dest:TStream; Size: Integer; OnProgress: TOnProgressHandler);
var
    Continue:Boolean;
    BufSize: Integer;
    Buf: Array of Byte;
begin
    SetLength(Buf, 65536);
    
    Continue := True;
    While (Src.Position <= Src.Position+Size) Do
    Begin
        BufSize := Size;
        If BufSize > Length(Buf) Then
            BufSize := Length(Buf);
        BufSize := Src.Read(Buf[0], BufSize);
        If Assigned(OnProgress) Then
            OnProgress(Src, Dest, Src.Position, Src.Size, Continue);
        Continue := Continue and (BufSize <> 0);
        If Continue Then
            Dest.WriteBuffer(Buf[0], BufSize)
        else
            Exit;
        Dec(Size, BufSize);
    end;
end;

_________________
MFG
Michael Springwald, "kann kein englisch...."

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

es hat funktioniert

danke BenBe ich habe einen aufruf fehler gemacht und ich habe noch etwas an deiner funktion geändert jetzt sieht sie so aus:

markieren

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:

Procedure TArchiver.CopyFrom(Src, Dest:TStream; Size: Integer; OnProgress: TOnProgressHandler);
var
    Continue:Boolean;
    BufSize: Integer;
    Buf: Array of Byte;
begin
    SetLength(Buf, size);
    
    Continue := True;
    While (Src.Position <= Src.Position+Size) Do Begin

        BufSize := Size;
        If BufSize > Length(Buf) Then
            BufSize := Length(Buf);
        BufSize := Src.Read(Buf[0], BufSize);
        If Assigned(OnProgress) Then
            OnProgress(Src, Dest, Src.Position, Src.Size, Continue);
        Continue := Continue and (BufSize <> 0);
        If Continue Then
            Dest.WriteBuffer(Buf[0], BufSize)
        else
            Exit;
        Dec(Size, BufSize);
    end;
end;

_________________
MFG
Michael Springwald, "kann kein englisch...."

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

so packen und entpacken funktiniert prima aber was ich nicht verstehe ist jetzt folgendes:
wenn ich nun dateien hinzufügen möchte gibts einen Stream schreib fehler und ich weiß einfach nicht warum. so sieht deine funktion aus:

markieren

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:

Procedure TArchiver.CopyFrom(Src, Dest:TStream; Size: Integer; OnProgress: TOnProgressHandler);
var
    Continue:Boolean;
    BufSize: Integer;
    Buf: Array of Byte;
begin
    SetLength(Buf, Size);
    if Size = 0 then Src.Position:=0;
    Continue := True;
    While (Src.Position <= Src.Position+Size) and (Size > 0) Do Begin
        BufSize := Size;
        If BufSize > Length(Buf) Then
            BufSize := Length(Buf);
        BufSize := Src.Read(Buf[0], BufSize);

        If Assigned(OnProgress) Then
            OnProgress(Src, Dest, Src.Position, Src.Size, Continue);
        Continue := Continue and (BufSize <> 0) or (Size <> 0);
        If Continue Then
            Dest.WriteBuffer(Buf[0], BufSize)
        else
            Exit;
        Dec(Size, BufSize);
    end;
end;

und so rufe ich sie auf:

markieren

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:

procedure TArchiver.AddFile;
var
  SData,adate,SHeader,F:TFileStream;
  SHeader1:TWriter;
  i:Integer;
  NH:TStringList;
  fn:String;
begin

  SData:=TFileStream.Create(TempDir + 'SDateAdd.txt',fmCreate);
  SHeader:=TFileStream.Create(TempDir + 'SHeaderAdd.txt',fmCreate);
  SHeader1:=TWriter.Create(SHeader,10);
  NH:=TStringList.Create;

  // Header daten hinzufügen
  for i:=0 to AI.Header.Count-1 do
    NH.Add(AI.Header.Strings[i]);

  for i:=0 to AI.FileListe.Count-1 do begin
    fn:=GetToken(AI.FileListe.Strings[i],';',Integer(FIFileName));
    NH.Add( FN + ';' + IntToStr(GetFileSize1(FN)) + ';' + GetToken(AI.FileListe.Strings[i],';',2) + ';' + GetToken(AI.FileListe.Strings[i],';',3)+ ';' + GetFileInfo(fn,';') + ';');
  end;

  SHeader1.WriteString(ASignatur);
  SHeader1.FlushBuffer;

  SHeader1.WriteString(NH.Text + #0);
  SHeader1.FlushBuffer;
  
  // Datei Daten hinzufügen
  ai.A.Position:=AI.Header_EndPos;
  CopyFrom(AI.A,SData,ai.A.Size,onProsess);
  for i:=0 to AI.FileListe.Count-1 do begin
    f:=TFileStream.Create(GetToken(AI.FileListe.Strings[i],';',Integer(FIFileName)),fmOpenRead);
    f.position:=0;
    CopyFrom(f,ai.a,f.Size,onProsess) // Screhibfehler bei der ersten datei gleich, warum ???
  end;

  // Rätzelst lösung, nicht Free sondern "FreeAndNil"
  FreeAndNil(AI.RArchiv);
  FreeAndNil(AI.WArchiv);
  FreeAndNil(AI.A);
    
  DelFile(ai.Name);

  // Header und Daten zusammenbringen
  adate:=TFileStream.Create(TempDir + ExtractFileName(AI.Name),fmCreate);
  CopyFrom(SHeader,ADate,0,onProsess);
  CopyFrom(SData,ADate,0,onProsess);
  ADate.Free;

  CopyFile(PChar(TempDir + ExtractFileName(ai.Name)),PChar(ai.Name),True);

  AI.FileListe.Clear;
end;

_________________
MFG
Michael Springwald, "kann kein englisch...."

BenBE · Verfasst: Sa 22.01.05 19:37

mimi hat folgendes geschrieben:

markieren

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:

Procedure TArchiver.CopyFrom(Src, Dest:TStream; Size: Integer; OnProgress: TOnProgressHandler);
var
    Continue:Boolean;
    BufSize: Integer;
    Buf: Array of Byte;
begin
    SetLength(Buf, Size);
    if Size = 0 then Src.Position:=0;
    Continue := True;
    While (Src.Position <= Src.Position+Size) and (Size > 0) Do Begin
        BufSize := Size;
        If BufSize > Length(Buf) Then
            BufSize := Length(Buf);
        BufSize := Src.Read(Buf[0], BufSize);

        If Assigned(OnProgress) Then
            OnProgress(Src, Dest, Src.Position, Src.Size, Continue);
        Continue := Continue and (BufSize <> 0) or (Size <> 0);
        If Continue Then
            Dest.WriteBuffer(Buf[0], BufSize)
        else
            Exit;
        Dec(Size, BufSize);
    end;
end;

Wie, bitte schön, kann man meinen Source so verunstalten? :twisted:

So kann das nicht funktionieren!

markieren

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:

Procedure TArchiver.CopyFrom(Src, Dest:TStream; Size: Integer; OnProgress: TOnProgressHandler);
var
    Continue:Boolean;
    BufSize: Integer;
    Buf: Array of Byte;
begin
    SetLength(Buf, 65536);
    if Size = 0 then Src.Position:=0;
    Continue := True;
    While (Src.Position < Src.Size) and (Size > 0) Do 
    Begin
        BufSize := Size;
        If BufSize > Length(Buf) Then
            BufSize := Length(Buf);
        BufSize := Src.Read(@Buf[0], BufSize);

        If Assigned(OnProgress) Then
            OnProgress(Src, Dest, Src.Position, Src.Size, Continue);

        Continue := Continue and (BufSize <> 0);
        If Continue Then
            Dest.Write(@Buf[0], BufSize)
        else
            Exit;
        Dec(Size, BufSize);
    end;
end;

_________________

Anyone who is capable of being elected president should on no account be allowed to do the job.
Ich code EdgeMonkey - In dubio pro Setting.

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

Geht immer noch nicht, "Stream Lese Fehler"
ich habe das @ entfernt weil da hat der complier fehlermeldungen raußgeben

_________________
MFG
Michael Springwald, "kann kein englisch...."

Alstar · Beiträge: 827

Hi!

Wenn ein Stream Lesefehler auftritt kann man getorst davon ausgehen, dass der Zeiger am Dateiende steht und somit die Datei nicht weiter ausgelesen werden kann.

Alstar

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

habe mich verschrieben ich meinte Schreibfehler und nicht Lesefehler :oops:

_________________
MFG
Michael Springwald, "kann kein englisch...."

Ehemaliges Mitglied Erhaltene Danke: 1

Demo mit Fortschrittsanzeige und Abbrechen: www.luckie-online.de/Delphi/Sonstiges/ -> TStreamProgressAdapter

Oder ohne Streams mit Suche im MSDN

COPYFILEEX: www.luckie-online.de...iges/CopyFileEx.html

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

danke werde ich mir gleich mal anschauen !

_________________
MFG
Michael Springwald, "kann kein englisch...."

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

habs getestet und es geht nicht

markieren

Delphi-Quelltext

1:
2:
3:
4:
5:
6:
7:
8:
9:
10:
11:
12:
13:
14:
15:
16:
17:

var
  i:integer;
  Datei:TStreamProgressAdapter;
begin
  AI.WArchiv.Position:=0;
  AI.WArchiv.WriteString(ASignatur);

  WriteHeader;

  for i:=0 to AI.FileListe.count-1 do begin
    Datei:=TStreamProgressAdapter(TFileStream.Create(GetToken(AI.FileListe.strings[i],';', Integer(FiFileName)),fmOpenRead));
//    AI.A.CopyFrom(Datei,Datei.Size);
    Datei.OnProgress:=Test;

    Ai.A.CopyFrom(Datei,Datei.Size);
    Datei.Free;
  end;

Ai.A ist das archiv und datei ist der QuellStream.
1. Es wird das ereignis nicht ausgelöst
2. Beim Beeneden kommen zwei fehlermeldung:

Zitat:

---------------------------
Anwendungsfehler
---------------------------
Exception EAccessViolation in Modul mfa.exe bei 00019CD9.

Zugriffsverletzung bei Adresse 00419CD9 in Modul 'mfa.exe'. Lesen von Adresse 1170E938.

---------------------------
OK
---------------------------

Zitat:

---------------------------
Benachrichtigung über Debugger-Exception
---------------------------
Im Projekt mfa.exe ist eine Exception der Klasse EAccessViolation aufgetreten. Meldung: 'Zugriffsverletzung bei Adresse 00419CD9 in Modul 'mfa.exe'. Lesen von Adresse 0000002C'. Prozess wurde angehalten. Mit Einzelne Anweisung oder Start fortsetzen.
---------------------------
OK Hilfe
---------------------------

Edit:
gibst es sowas nicht ales eine einfache kleine funktion die man so auruft: copyForm(qull, ziel:TStream; ereignis:TEreignis)
und fertig ?
setzt eine variable WieWeitBinIch ? soll abgebruchen werden ?

_________________
MFG
Michael Springwald, "kann kein englisch...."

wulfskin · Verfasst: So 30.01.05 12:15

Hallo Mimi,

was willst du den genau haben (ich blick noch nicht genau durch). Willst du etwas an einer bestimmten Stelle einfügen, oder willst du etwas ans Ende einfügen oder was genau?

Gruß Hape!

_________________
Manche antworten um ihren Beitragszähler zu erhöhen, andere um zu Helfen.

mimi · Beiträge: 3458 Ubuntu, Win XP Lazarus

beides, ich möchte die möglichkeit haben aus einem Stream danten an einer bestimmten position zu schreiben und auch wieder lesen aber dann auch nur ein teil z.b. ich habe ein stream der ist 1000 byts groß und jetzt möchte ich von byt 500 50 byt lesen oder aber von 600 bis 1000 byts lesen jenachdem. das ist für ein archiver eigentlich kann ich ja auch die funktion von Delphi nehmen nur leider kann man die nicht abbrechen oder pausieren. kurtz ich möchte einfach nur die copyFrom funktion von delphi nach schreiben mit einer Abbrechen funktion und sie soll ein ereignis auslösen wo der status angeben ist z.b. wie viel muss sie noch kopieren und sowas halt....

_________________
MFG
Michael Springwald, "kann kein englisch...."

	Mitgliederliste
	Gruppen
	Das Team
	Richtlinien
	Synonyme