this slowpoke moves

Advanced File Splitter

Unit FileSplitter.pas
{$WARN SYMBOL_PLATFORM OFF}

unit FileSplitter;

interface

uses
  SysUtils, Classes;

// Filesplitter error constants
const
  EEMPTYFILE = 1;  // no filename specified
  EFILEDONTEXISTS = 2;  // file does not exists
  EPARTZISE = 3;  // desired size is zero or less
  EEMPTYDIR = 4;  //  no destination folder is specified
  EDIRNOTEXISTS = 5;  // destination folder does not exists

type
  // Error event prototype
  TOnError = procedure(Sender: TObject; ECode: Integer; EMessage: string) of
    object;
  EFileSplitterError = class(Exception)
  FErrorCode : Integer;
  public
    // overidden constructores
    constructor Create(const AMessage: String); reintroduce; virtual;
    constructor CreateFmt(const AErrCode: Integer; const AMessage: string;
      const Arg: array of const); reintroduce; virtual;
    property ErrorCode: Integer read FErrorCode;
  end;

type
  // Progress event prototype
  TOnProgress = procedure(Sender: TObject; PartFilename: string; Total, Done:
    Int64) of object;

  TFileSplitter = class
  private
    FFilename: string;
    FPartSize: Integer;
    FDestFolder: string;
    // Progress event
    FOnProgress: TOnProgress;
    // Error event
    FSError: TOnError;
  protected
    function GetCntParts(FileSize, PartSize: Cardinal): Cardinal; virtual;
    function BuildPartFilename(Filename: string; PartCnt: Cardinal): string; virtual;
    function SplitFile(Filename, DestFolder: string; PartSize, CntParts:
      Cardinal): Integer; virtual;
  public
    constructor Create;
    procedure Execute;
    property Filename: string read FFilename write FFilename;
    property PartSize: Integer read FPartSize write FPartSize;
    property DestFolder: string read FDestFolder write FDestFolder;
    // Eventhandlers
    property OnProgress: TOnProgress read FOnProgress write FOnProgress;
    property OnError: TOnError read FSError write FSError;
  end;

implementation

function GetFileSize(Filename: String): Int64;
var
  fs: TFileStream;
begin
  fs.Create(Filename, fmOpenRead);
  try
    result := fs.Size;
  finally
    FreeAndNil(fs);
  end;
end;

function Min(x, y: Cardinal): Integer;
begin
  if x < y then
    result := x
  else
    result := y;
end;

constructor EFileSplitterError.Create(const AMessage: String);
begin
  inherited Create(AMessage);
end;

constructor EFileSplitterError.CreateFmt(const AErrCode: Integer;
     const AMessage: string; const Arg: array of const);
begin
  inherited CreateFmt(AMessage, Arg);
  FErrorCode := AErrCode;
end;

constructor TFileSplitter.Create;
begin
  inherited;
  FFilename := '';
  FPartSize := 0;
  FDestFolder := '';
end;

function TFileSplitter.GetCntParts(FileSize, PartSize: Cardinal): Cardinal;
begin
  result := 0;
  if (PartSize = 0) or (FileSize = 0) then
    exit
  else
    result := FileSize div PartSize + 1;
end;

function TFileSplitter.BuildPartFilename(Filename: string; PartCnt: Cardinal):
  string;
begin
  result := ExtractFileName(Filename) + '.' + Format('%.3d', [PartCnt]);
end;

function TFileSplitter.SplitFile(Filename, DestFolder: string; PartSize,
  CntParts: Cardinal): Integer;
var
  inFile, outFile: TFileStream;
  PartFilename: string;
  Loop: Cardinal;
  BytesToRead, BytesRead, BytesWritten: Integer;
  Buffer: array[0..4096] of Byte;
begin
  inFile := TFileStream.Create(Filename, fmOpenRead);
  try
    for Loop := 1 to CntParts do
    begin
      PartFilename := DestFolder + '\' + BuildPartFilename(Filename, Loop);
      BytesToRead := PartSize;
      outFile := TFileStream.Create(PartFilename, fmCreate);
      try
        repeat
          BytesRead := inFile.Read(Buffer, Min(sizeof(Buffer), BytesToRead));
          BytesWritten := outFile.Write(Buffer, BytesRead);
          Dec(BytesToRead, sizeof(Buffer));
          if Assigned(OnProgress) then
          begin
            OnProgress(self, PartFilename, inFile.Size, inFile.Position);
          end;
        until BytesToRead < 0;
      finally
        FreeAndNil(outFile);
      end;
    end;
  finally
    FreeAndNil(inFile);
  end;
  result := GetLastError();
end;

procedure TFileSplitter.Execute;
var
  FileSize: Int64;
resourcestring
  EEmptyFileMsg = 'Keine Datei angegeben.';
  EFileDontExistsMsg = 'Datei %s existiert nicht.';
  EPartSizeMsg = 'Dateigröße der Teildateien muss größer 0 sein.';
  EEmptyDestFolerMsg = 'Kein Zielverzeichnis angegeben.';
  EDirNotExistsMsg = 'Verzeichnis %s existiert nicht.';
begin
  if FFilename = '' then
  begin
    // if caller handles the exceptions
    if Assigned(OnError) then
    begin
      OnError(self, EEMPTYFILE, EEmptyFileMsg);
      exit;
    end
    else  // else class raises exception it self
      raise EFileSplitterError.Create(EEmptyFileMsg);
  end;
  if not FileExists(FFilename) then
  begin
    if Assigned(OnError) then
    begin
      OnError(self, EFILEDONTEXISTS, EFileDontExistsMsg);
      exit;
    end
    else
      raise EFileSplitterError.CreateFmt(EFILEDONTEXISTS, EFileDontExistsMsg, [FFilename]);
  end;
  if FPartSize <= 0 then
  begin
    if Assigned(OnError) then
    begin
      OnError(self, EPARTZISE, EPartSizeMsg);
      exit;
    end
    else
      raise EFileSplitterError.Create(EPartSizeMsg);
  end;
  if FDestFolder = '' then
  begin
    if Assigned(OnError) then
    begin
      OnError(self, EEMPTYDIR, EEmptyDestFolerMsg);
      exit
    end
    else
      raise EFileSplitterError.Create(EEmptyDestFolerMsg);
  end;
  if not DirectoryExists(FDestFolder) then
  begin
    if Assigned(OnError) then
    begin
      OnError(self, EDIRNOTEXISTS, EDirNotExistsMsg);
      exit;
    end
    else
      raise EFileSplitterError.CreateFmt(EDIRNOTEXISTS, EDirNotExistsMsg, [FDestFolder]);
  end;

  FileSize := GetFileSize(FFilename);
  FDestFolder := ExcludeTrailingBackslash(FDestFolder);

  SplitFile(FFilename, FDestFolder, FPartSize, GetCntParts(FileSize, FPartSize));
end;

end.

Unit1:
{$A+,B-,C+,D+,E-,F-,G+,H+,I+,J-,K-,L+,M-,N+,O+,P+,Q-,R-,S-,T-,U-,V+,W-,X+,Y+,Z1}
{$MINSTACKSIZE $00004000}
{$MAXSTACKSIZE $00100000}
{$IMAGEBASE $00400000}
{$APPTYPE GUI}

uses ComCtrls, FileSplitter

private
    { Private-Deklarationen }
    procedure SplitProgress(Sender: TObject; PartFilename: String; Total, Done: Int64);
    procedure SplitError(Sender: TObject; ECode: Integer; EMessage: String);
    
//

procedure TForm1.SplitError;
var
  s: String;
begin
  s := 'Fehlercode: '+IntToStr(ECode)+#13#10;
  s := s + EMessage;
  Messagebox(Handle, PChar(s), 'Fehler', MB_ICONSTOP);
end;

procedure TForm1.SplitProgress;
begin
  ProgressBar1.Max := 100;
  ProgressBar1.Position := Done * 100 div Total;
  Label1.Caption := PartFilename;
  Application.ProcessMessages;
end;

procedure TForm1.Button1Click(Sender: TObject);
var
  fs: TFileSplitter;
begin
  fs := TFileSplitter.Create;
  try
    fs.Filename := Edit1.Text;  // Original Datei
    fs.DestFolder := Edit2.Text; // Ziel Ordner
    fs.PartSize := StrToInt(Edit3.Text) * 1024; // Teilgröße in KB
    fs.OnError := SplitError;
    fs.OnProgress := SplitProgress;
    fs.Execute;
  finally
    FreeAndNil(fs);
  end;
end;

Keine Kommentare:

Kommentar veröffentlichen

Beliebte Posts

Translate