みなさん、こんにちは。十兵衛です。

TMemoryStreamを継承して作ったファイル分割/復元のクラスです。
皆さんの添削をお願いします。



----------------------------始まり------------------------------------
unit SeparateStream;

interface

uses
  SysUtils, Classes;

type
  TSeparateStream = class(TMemoryStream)
  private
    FSize: Integer;
    procedure SetOwnSize(const Value: Integer);
    function GetCount: Integer;
  public
    constructor Create;

    //指定されたストリームを現在のストリームの最後に追加する
    function Add(AStream:TMemoryStream):Integer;

    //指定されたファイル名を現在のストリームの最後に追加する
    function AddFromFile(AFileName:TFileName):Integer;

    //指定されたIndexの部分ストリームを指定されたファイル名で保存する
    procedure SaveToSeparateFile(const Index:Integer;
                                 AFileName:TFileName);

    //指定されたストリームに指定されたIndexの部分ストリームをコピーする
    procedure Copy(AStream:TMemoryStream;Index:Integer);

    //SeparateSizeプロパティで指定されたサイズに従い、
    //現在の部分ストリームの個数を返します。
    property Count:Integer read GetCount;

    //分割したいサイズを指定します
    property SeparateSize:Integer read FSize write SetOwnSize;
  end;


implementation

{ TSeparateStream }

constructor TSeparateStream.Create;
begin
 inherited Create;
 FSize := 1;
end;

function TSeparateStream.GetCount: Integer;
begin
  if Size = 0 then Result := 0
  else  begin
    Result := (Size div FSize);
    if (Size mod FSize) > 0 then Inc(Result);
  end;
end;

procedure TSeparateStream.SetOwnSize(const Value: Integer);
begin
  if Value < 1 then begin
     EStreamError.Create('サイズが不正です');
     Exit;
  end else FSize := Value;
end;

function TSeparateStream.Add(AStream: TMemoryStream): Integer;
begin
 Position := Size;
 CopyFrom(AStream,0);
 Result := Count-1;
end;

function TSeparateStream.AddFromFile(AFileName: TFileName): Integer;
var
  FStream:TMemoryStream;
begin
  FStream := TMemoryStream.Create;
  try
    FStream.LoadFromFile(AFileName);
    Result := Add(FStream);
  finally
    FStream.Free;
  end;
end;

procedure TSeparateStream.Copy(AStream: TMemoryStream; Index: Integer);
var
 FFSize,FPos:Integer;
begin
  if Index > Count-1 then begin
     EStreamError.Create('インデックスが不正です');
     Exit;
  end;
  FPos := Position;
  Position := FSize * Index;
  FFSize := Size - Position;
  if FFSize > FSize then FFSize := FSize;
  AStream.Clear;
  AStream.CopyFrom(Self,FFSize);
  Position := FPos;
end;

procedure TSeparateStream.SaveToSeparateFile(const Index: Integer;
  AFileName: TFileName);
var
 FStream:TMemoryStream;
begin
  if Index > Count-1 then begin
     EStreamError.Create('インデックスが不正です');
     Exit;
  end;
  FStream := TMemoryStream.Create;
  try
    Copy(FStream,Index);
    FStream.SaveToFile(AFileName);
  finally
    FStream.Free;
  end;
end;

end.
-----------------------------終わり-----------------------------------

使い方例です。

【アプリケーション機能】
分割したいファイルを一つ選択し、分割してアプリケーションで設定した任意の
ファイル名で順次保存します。
分割されたファイルを順次読み込み一つのファイルとして復元し、任意のファイ
ル名で保存します。

【アプリケーション設計】
フォームにTOpenDialog、TSaveDialogをそれぞれ一つずつ、TButtonを二つ貼り
付けます。

フォームのprivate部にTSeparateStreamクラスの宣言を行ないます。
  private
    { Private 宣言 }
    MyStream:TSeparateStream;

フォームの生成時と破棄時にTSeparateStreamの生成と破棄を行ないます。
procedure TForm1.FormCreate(Sender: TObject);
begin
  MyStream := TSeparateStream.Create;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
  MyStream.Free;
end;

Button1のクリックイベントハンドラで対象のファイルを読み込み、分割して保
存します。ここでの分割サイズはFD一枚分とします（1440000byte）
保存するファイル名はもとファイルの名前にインデックスの番号を付与し、拡張
子を「.dat」にしています。（復元する際の順序を決定するためにインデックス
を使用しています）

procedure TForm1.Button1Click(Sender: TObject);
var
  IDX:Integer;
  FFileName:TFileName;
begin
  OpenDialog1.InitialDir := 'I:\Temp';
  if not OpenDialog1.Execute then Exit;
  FFileName := ChangeFileExt(OpenDialog1.FileName,'');
  MyStream.LoadFromFile(OpenDialog1.FileName);
  MyStream.SeparateSize := 1440000;
  for IDX := 0 to MyStream.Count-1 do begin
      MyStream.SaveToSeparateFile(
               IDX,Format('%s%.3d%s',[FFileName,IDX,'.dat']));
  end;
end;

Button2のクリックイベントハンドラで分割分割されているファイルを読み込み
一つのファイルとして復元します。複数個読み込めるようにOpenDialog1の
OptionsプロパティにAllowMultiSelectを追加しています。
保存するファイル名はSaveDialog1で指定されたファイル名にしています。

　一端TSeparateStreamクラスの保持しているメモリをクリアします。
　OpenDialog1.FilesをTStringListクラスにコピーしファイル名でソートします。
　ソート順に従ってファイルの追加を行なわないと復元ファイルの内容がおかし
　くなるためです。

procedure TForm1.Button2Click(Sender: TObject);
var
  FFileList:TStringList;
  IDX:Integer;
begin
  OpenDialog1.InitialDir := 'I:\Temp';
  if not OpenDialog1.Execute then Exit;
  FFileList := TStringList.Create;
  try
    MyStream.Clear;
    FFileList.Assign(OpenDialog1.Files);
    FFileList.Sort;
    for IDX := 0 to FFileList.Count-1 do begin
        MyStream.AddFromFile(FFileList[IDX]);
    end;
    SaveDialog1.InitialDir := 'I:\Temp';
    if SaveDialog1.Execute then
       MyStream.SaveToFile(SaveDialog1.FileName);
  finally
    FFileList.Free;
  end;
end;

                                     99/01/11(月) 02:10 十兵衛(BZT01311)

Original document by 十兵衛          氏 ID:(BZT01311)

ここにあるドキュメントは NIFTY SERVEの Delphi Users' Forum の16番会議室「玉石混淆みんなで作るSample蔵」に投稿されたサンプルです。これらのサンプルはボーランド株式会社がサポートする公式のものではありません。また、必ずしも動作が検証されているものではありません。これらのサンプルを使用したことに起因するいかなる損害も投稿者、およびフォーラムスタッフはその責めを負いません。使用者のリスクの範疇でご使用下さい。