logo

.
Wednesday 08th of September 2010    

Ankety

Co tu není dobré ?
 

Přihlášení



Provoz stránek

návštěv dnes: 56
návštěv včera: 62
návštěv za měsíc: 483
návštěv celkem: 17787

Home Tipy, triky, návody DISK, SLOŽKA, SOUBOR Soubor - rozdělení a sloučení souboru
Soubor - rozdělení a sloučení souboru Tisk Email
Hodnocení uživatelů: / 0
NejhoršíNejlepší 
Napsal uživatel Administrator   
Pondělí, 08 Červen 2009 06:32
procedure Rozdelit(FileName: String; part:integer);
var
    Source, Target : TFileStream;
    Fname, Ext : String;
    Count, Rest,
    Size : Integer;
    F : TextFile;
begin
    Source := TFileStream.Create(FileName, fmOpenRead);
    Fname := copy(FileName,1,Length(FileName) - 4);
    Count := 0;
    Size := Source.Size;
    if Source.Size <= Part then
    begin
        ShowMessageFmt(`Vybraný soubor je menší než %d bajtů. Není třeba jej dělit.`,[Part]);
        Exit;
    end;
    repeat
        Rest := 0;
        Inc(Count);
        Ext := copy(`000`, 1, 3 - Length(IntToStr(count))) + IntToStr(Count);
        Target := TFilestream.Create(Fname + `.` + Ext, fmCreate);
        try
            if (count * Part) <= Size then Rest := Target.CopyFrom(Source, Part)
            else Rest := Target.CopyFrom(Source,Size mod Part);
        except
        end;
        Target.Free;
    until Rest <> Part;
    AssignFile(f, Fname + `.crc`);
    Rewrite(f);
    WriteLn(f,`filename=`+ExtractFileName(FileName));
    WriteLn(f,`size=`+IntToStr(Size));
    WriteLn(f,`crc32=`);
    CloseFile(f);
    Source.Free;
    ShowMessageFmt(`Soubor byl rozdělen na %d souborů`,[count]);
end;

function Sloucit(FileName: String): String;
var
    Source, Target : TFileStream;
    Count : Integer;
    Rect : LongInt;
    Line, FName, AName, Size, CRC, CRC32, Dir, Files : String;
    F : textFile;
begin
    CRC := copy(FileName,1,Length(FileName)-3)+`crc`;
    Dir := ExtractFilePath(FileName);
    Files := ExtractFileName(FileName);
    Count := 0;
    if FileExists(CRC) then
    begin
        AssignFile(F, CRC);
        Reset(F);
        while not EOF(F) do
        begin
            ReadLn(F, Line);
            if copy(Line, 1, 8) = `filename` then FName := copy(Line,10,Length(Line));
            if copy(Line, 1, 4) = `size` then Size := copy(Line, 6, Length(Line));
            if copy(Line, 1, 5) = `crc32` then CRC32 := copy(Line, 7, Length(Line));
        end;
        CloseFile(F);
    end
    else
      begin
        FName := copy(Files, 1, length(Files)-3) + `out`;
        Size := `0`;
        CRC32 := `0`;
      end;
    Target := TFileStream.Create(Dir + FName, fmCreate);
    Rect := 0;
    repeat
        inc(Count);
        AName := copy(Files, 1, length(Files)- 3);
        AName := AName + copy(`000`,1,3-Length(IntToStr(Count)))+IntTostr(Count);
        Source := TFileStream.Create(Dir + AName, fmOpenRead);
        try
            Rect := rect + Target.CopyFrom(Source, Source.Size);
        except
            Result := Format(`Chyba při čtení svazku %s.`,[FName]);
            Source.Free;
            Target.Free;
            Exit;
        end;
        Source.Free;
        AName := copy(Files, 1, length(Files)- 3);
        AName := AName + copy(`000`,1,3-Length(IntToStr(Count+1)))+IntTostr(Count+1);
    until not(FileExists(Dir + AName));
    Target.Free;
    if Rect = StrToInt(Size) then Result := `Soubory byly úspěšně sloučeny (CRC souhlasí).`
    else
    begin
        if (Size > `0`) then Result := `Chybná velikost sloučeného souboru.`
        else Result := `Soubory byly úspěšně sloučeny (bez CRC kontroly).`;
    end;
end;
 
Zdroj: http://www.zive.cz/Clanky/Tipy-a-triky-v-Delphi-dil-33/sc-3-a-105613/default.aspx 
Aktualizováno Středa, 10 Červen 2009 06:42
 

Přidejte svůj komentář

Vaše jméno:
Titulek:
Komentář:
yvComment v.1.24.0
bottom

top

kolik vás je ?

Právě připojeni - hostů: 3 

bottom

Založeno na Joomla!. Designed by: Free Joomla 1.5 Template, dns. Valid XHTML and CSS.