filesplitter.pas

delphi下的大文件分割控件,在网站有VC++的,这里传一个delphi的

unit FileSplitter;

{------------------------------------------------------------------------------}
{  #7 Components - TFileSplitter v1.03                                         }
{                                                                              }
{  Check http://sedlan.tripod.com for new, updated versions                    }
{------------------------------------------------------------------------------}
{******************************************************************************}
{                                                                              }
{       Component description:                                                 }
{                                                                              }
{       TFileSplitter is an invisible component with a simple task to          }
{  split a file into multiple files of certain size. The most common need      }
{  for this is when you want to put your (big) file on floppy disks, for       }
{  backup or any other purposes. This component also includes method for       }
{  reversing the process - the unsplitting. All existing files will be         }
{  overwritten without warning during the process of splitting/unsplitting.    }
{       When splitting, if the SplitFileName property is empty, a file(s)      }
{  with the same name as FileName will be created, with extension(s) as        }
{  follows: '.SPL', '.001', '.002', etc.                                       }
{       When unsplitting, if the FileName property is empty, a file with       }
{  the same name as SplitFileName will be created, with extension '.XXX'.      }
{                                                                              }
{******************************************************************************}
{                                                                              }
{       Properties:                                                            }
{       -----------                                                            }
{       BufferSize        - Size of buffer used for reading input data and     }
{                           writing to output file(s).                         }
{       FileName          - The name of a file to be split, or the name of a   }
{                           resulting file in case of unsplitting.             }
{       ReduceFirstSizeBy - Size of the first split file will be reduced by    }
{                           this number of bytes                               }
{       Size              - Maximum size (in bytes) of the resulting           }
{                           (splitted) file(s). Not needed in case of          }
{                           unsplitting.                                       }
{       SplitFileName     - The name of a resulting file, or the name of the   }
{                           first file in case of unsplitting.                 }
{                                                                              }
{       Events:                                                                }
{       -------                                                                }
{       OnNeedDisk        - If assigned, this event is fired before the        }
{                           creation of each splitted file. Also, this event   }
{                           is fired before appending each splitted file to    }
{                           the original file, in case of unsplitting.         }
{       OnProgress        - If assigned, this event gets called every time     }
{                           the buffer is written to the resulting file. This  }
{                           applies to both splitting and unsplitting.         }
{                                                                              }
{       Methods:                                                               }
{       --------                                                               }
{       Split             - This method executes the splitting.                }
{       UnSplit           - This method does the unsplitting.                  }
{                                                                              }
{******************************************************************************}
{                                                                              }
{       Known bugs:                                                            }
{                                                                              }
{       There are no known bugs at this time.                                  }
{                                                                              }
{******************************************************************************}
{                                                                              }
{       Version history:                                                       }
{                                                                              }
{       March 08, 2000       - v1.00       - Initial release                   }
{       March 20, 2000       - v1.01       - OnNeedDisk was called one time    }
{                                            AFTER the splitting. Corrected    }
{                                            now.                              }
{                                          - OnProgress event created.         }
{                                          - Signature is placed on the        }
{                                            first split file. This helps      }
{                                            to count files during             }
{                                            unsplitting.                      }
{                                          - OnNeedDisk now has one more       }
{                                            parameter - NumOfDisks. This      }
{                                            parameter is zero for the         }
{                                            first call when unsplitting.      }
{       March 22, 2000       - v1.02       - Boy, was this buggy...            }
{       May   07, 2000       - v1.03       - Property ReduceFirstSizeBy added. }
{                                            This property can be used to      }
{                                            make the first split file smaller }
{                                            by a number of bytes. Helpful if  }
{                                            you are developing some kind of a }
{                                            setup program. Added upon request }
{                                            by Mr. Florian Haag.              }
{                                                                              }
{******************************************************************************}
{                                                                              }
{          Copyright (c) 2000 by Jovan Sedlan. All rights reserved.            }
{                                                                              }
{  Copyright:                                                                  }
{                                                                              }
{  TFileSplitter (hereafter "component") source code, and any other source     }
{  code inside this archive is copyrighted by Jovan Sedlan (hereafter          }
{  "author"), and shall remain the exclusive property of the author.           }
{                                                                              }
{  Distribution Rights:                                                        }
{                                                                              }
{  You are granted a non-exlusive, royalty-free right to produce and           }
{  distribute compiled binary files (executables, DLLs, etc.) that are         }
{  built with this component's source code unless specifically stated          }
{  otherwise.                                                                  }
{  You are further granted permission to redistribute the component source     }
{  code in source code form, provided that the original archive as found on    }
{  our web site (http://sedlan.tripod.com) is distributed unmodified.          }
{  For example, if you create a descendant of TFileSplitter, you must          }
{  include in  the distribution package the FileSpl.zip file in the exact      }
{  form that you downloaded it from http://sedlan.tripod.com                   }
{                                                                              }
{  Restrictions:                                                               }
{                                                                              }
{  Without the express written consent of the author, you may not:             }
{   * Distribute modified versions of any DFS source code by itself. You       }
{     must include the original archive as you found it on the web.            }
{   * Sell or lease any portion of DFS source code. You are, of course,        }
{     free to sell any of your own original code that works with, enhances,    }
{     etc. this component's source code.                                       }
{   * Distribute component's source code for profit.                           }
{                                                                              }
{  Warranty:                                                                   }
{                                                                              }
{  There is absolutely no warranty of any kind whatsoever with this            }
{  component's source code (hereafter "software"). The software is provided    }
{  to you "AS-IS", and all risks and losses associated with it's use are       }
{  assumed by you. In no event shall the author of the softare, Jovan          }
{  Sedlan, be held accountable for any damages or losses that may occur        }
{  from use or misuse of the software.                                         }
{                                                                              }
{  Support:                                                                    }
{                                                                              }
{  Support is provided via email only. The source code for this software is    }
{  provided free of charge. As such, I can not guarantee any support           }
{  whatsoever. While I do try to answer all questions that I receive, and      }
{  address all problems that are reported to me, you must understand that I    }
{  simply cannot guarantee that this will always be so.                        }
{                                                                              }
{------------------------------------------------------------------------------}
{  The latest version of my components are always available on the web at:     }
{    http://sedlan.tripod.com                                                  }
{------------------------------------------------------------------------------}
{  Date last modified:  May 07, 2000.                                          }
{------------------------------------------------------------------------------}
{******************************************************************************}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  DsgnIntf;

type
  TSignature = record
    Copyright: array [1..29] of Char;
    NumberOfFiles: Word;
  end;
  
  EFileError = class(Exception);

  TNeedDiskEvent = procedure(Sender: TObject; DiskID, NumOfDisks: Word; var Continue: Boolean) of object;
  TProgressEvent = procedure(Sender: TObject; PercentDone: Word) of object;

  TFSFilenameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  TFSSplitFilenameProperty = class(TStringProperty)
  public
    procedure Edit; override;
    function GetAttributes: TPropertyAttributes; override;
  end;

  TFileSplitter = class(TComponent)
  private
    FFileName: TFileName;
    FSize: LongInt;
    FSplitFileName: TFileName;
    FOutDifferent: Boolean;
    FFile: TFileStream;
    FSplitFile: TFileStream;
    FBuffer: Pointer;
    FBufferSize: Integer;
    FReduceFirstSizeBy: LongInt;
    Signature: TSignature;

    FOnNeedDisk: TNeedDiskEvent;
    FOnProgress: TProgressEvent;

    procedure SetFileName(Value: TFileName);
    procedure SetSize(Value: LongInt);
    procedure SetReduceFirstSizeBy(Value: LongInt);
    procedure SetBufferSize(Value: Integer);
    procedure SetSplitFileName(Value: TFileName);
  protected
  public
    constructor Create(AOwner: TComponent); override;
    procedure Split;
    procedure UnSplit;
  published
    property FileName: TFileName read FFileName write SetFileName;
    property SplitFileName: TFileName read FSplitFileName write SetSplitFileName;
    property Size: LongInt read FSize write SetSize;
    property BufferSize: Integer read FBufferSize write SetBufferSize;
    property ReduceFirstSizeBy: LongInt read FReduceFirstSizeBy write SetReduceFirstSizeBy;

    property OnNeedDisk: TNeedDiskEvent read FOnNeedDisk write FOnNeedDisk;
    property OnProgress: TProgressEvent read FOnProgress write FOnProgress;
  end;

procedure Register;

implementation

{ TFSFilenameProperty }

procedure TFSFilenameProperty.Edit;
var
  FSFileOpen: TOpenDialog;
  
begin
  FSFileOpen := TOpenDialog.Create(Application);
  FSFileOpen.Filename := GetValue;
  FSFileOpen.Filter := 'All files (*.*)|*.*';
  FSFileOpen.Options := FSFileOpen.Options + [ofShowHelp, ofPathMustExist];
  FSFileOpen.Title := 'Select a file to split';
  try
    if FSFileOpen.Execute then
      SetValue(FSFileOpen.Filename);
  finally
    FSFileOpen.Free;
  end;
end;

function TFSFilenameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end;

{ TFSSplitFilenameProperty }

procedure TFSSplitFilenameProperty.Edit;
var
  FSFileSave: TSaveDialog;

begin
  FSFileSave := TSaveDialog.Create(Application);
  FSFileSave.Filename := GetValue;
  FSFileSave.Filter := 'Split files (*.spl)|*.SPL';
  FSFileSave.Options := FSFileSave.Options + [ofShowHelp, ofPathMustExist];
  FSFileSave.Title := 'Select the first split file (.SPL)';
  try
    if FSFileSave.Execute then
      SetValue(FSFileSave.Filename);
  finally
    FSFileSave.Free;
  end;
end;

function TFSSplitFilenameProperty.GetAttributes: TPropertyAttributes;
begin
  Result := [paDialog, paRevertable];
end;

{ TFileSplitter }

{ Sets the name of the file to split }
procedure TFileSplitter.SetFileName(Value: TFileName);
begin
  if Value <> FFileName then
  begin
    FFileName := Value;