哪位高手给出一个文件分割的小程序？

Question

给你一个完整的文件分割例子;unit UnMain;interfaceuses
  Windows, SysUtils, Classes,  Forms, Dialogs,
  Buttons, StdCtrls, ComCtrls, Spin, math, FileCtrl, Controls, Menus;type
  TfmMain = class(TForm)
    OpenDialog: TOpenDialog;
    PageControl1: TPageControl;
    TabSheet1: TTabSheet;
    TabSheet2: TTabSheet;
    Label6: TLabel;
    DivisionOpen: TSpeedButton;
    edtFileName: TEdit;
    lblFileName: TLabel;
    Label8: TLabel;
    Label9: TLabel;
    DivisionSave: TSpeedButton;
    edtSaveDir: TEdit;
    btnSaveOk: TBitBtn;
    ListBox1: TListBox;
    BitBtn2: TBitBtn;
    edtSize: TEdit;
    cboSize: TComboBox;
    Label1: TLabel;
    ResumeOpen: TSpeedButton;
    Label2: TLabel;
    ResumeSaveDir: TEdit;
    ResumeSave: TSpeedButton;
    PopupMenu1: TPopupMenu;
    N1: TMenuItem;
    N2: TMenuItem;
    StatusBar1: TStatusBar;
    procedure DivisionOpenClick(Sender: TObject);
    procedure DivisionSaveClick(Sender: TObject);
    procedure btnSaveOkClick(Sender: TObject);
    procedure ResumeOpenClick(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure ResumeSaveClick(Sender: TObject);
    procedure edtSizeKeyPress(Sender: TObject; var Key: Char);
    procedure cboSizeKeyPress(Sender: TObject; var Key: Char);
    procedure N2Click(Sender: TObject);
    procedure N1Click(Sender: TObject);
    procedure TabSheet1Enter(Sender: TObject);
  private
    { Private declarations }
    Gi_size:Longint;
    function GetDirectoryName(Dir: string): string;
    procedure DivisionTo(FromFile,ToDir:string;fSize:Longint);
    procedure ResumeTo(ToDir:string);
  public
    { Public declarations }
  end;var
  fmMain: TfmMain;implementation{$R *.DFM}procedure TfmMain.DivisionTo(FromFile,ToDir:string;fSize:Longint);
var
  FromF,ToF:file;
  NumRead,NumWrite,SrcFileSize:Longint;
  Num,i:Integer;
  ss:string[200];
  sste:string[20];
  buf:array[1..2048] of char;
begin
  ToDir:=GetDirectoryName(ToDir);
  AssignFile(FromF,FromFile);
  ReSet(FromF,1);
  SrcFileSize:=FileSize(FromF);
  Num:=Ceil(SrcFileSize/fSize);
  for i:=1 to Num do
  begin
    Str(i,sste);
    sste:=Trim(sste);
    ss:=ToDir+'XX'+sste+'disk.GXH';
    AssignFile(ToF,ss);
    ReWrite(ToF,1);
    ss:='XXSOFT001';
    BlockWrite(ToF,ss,15);               //头标志写入    SrcFileSize:=fSize;
    repeat
      if SrcFileSize>2040 then
      begin
        NumRead:=2040;
        SrcFileSize:=SrcFileSize-2040;
      end else
        begin
          NumRead:=SrcFileSize;
          SrcFileSize:=0;
        end;
      BlockRead(FromF,Buf,NumRead,NumWrite);
      BlockWrite(ToF,Buf,NumWrite);
    until (SrcFileSize<=0);
    CloseFile(ToF);
  end;
  CloseFile(FromF);
end;function TfmMain.GetDirectoryName(Dir: string): string;
begin
  if Dir[Length(Dir)]<>'\' then Result:=Dir+'\'
  else Result:=Dir;
end;procedure TfmMain.DivisionOpenClick(Sender: TObject);
var
  hFile:Integer;
begin
  OpenDialog.Filter:='';
  OpenDialog.Options:=[ofHideReadOnly,ofEnableSizing];
  if OpenDialog.Execute then
  begin
    edtFileName.Text:=OpenDialog.FileName;
    hFile:=_lopen(PChar(OpenDialog.FileName),OF_READ);
    Gi_size:=GetFileSize(hFile,0);
    lblFileName.Caption:='文件长度：'+IntToStr(Gi_size)+' Byte';
  end else lblFileName.Caption:='';
end;procedure TfmMain.DivisionSaveClick(Sender: TObject);
var
  Directory: string;
begin
  SelectDirectory('选择一个目录', '', Directory);
  if Directory='' then Exit;  Directory:=GetDirectoryName(Directory);
  edtSaveDir.Text:=Directory;
end;procedure TfmMain.btnSaveOkClick(Sender: TObject);
var
  size:Longint;
begin
  if edtSize.Text='' then edtSize.Text:='1';
  if (edtFileName.Text<>'')and(edtSaveDir.Text<>'')then
  begin
    if cboSize.Text='K' then size:=StrToInt(edtSize.Text)*1024
    else size:=StrToInt(edtSize.Text)*1024*1024;
    StatusBar1.SimpleText:='正在分割...';
    Cursor:=crHourGlass;
    DivisionTo(edtFileName.Text,edtSaveDir.Text,size);
    Cursor:=crDefault;
    StatusBar1.SimpleText:='';
    Application.MessageBox(PChar('分割成功！'),'提示',MB_OK + MB_DEFBUTTON1);
  end;
end;procedure TfmMain.ResumeOpenClick(Sender: TObject);
begin
  OpenDialog.Filter:='GXH File(*.GXH)|*.GXH';
  OpenDialog.Options:=[ofHideReadOnly,ofAllowMultiSelect,ofEnableSizing];
  if OpenDialog.Execute then
  begin
    ListBox1.Clear;
    ListBox1.Items:=OpenDialog.Files;
  end;
end;procedure TfmMain.ResumeTo(ToDir: string);
var
  FromF,ToF:file;
  ss:string[200];
  NumRead,NumWrite,i:Integer;
  buf:array[1..2048] of char;
begin
  AssignFile(ToF,ToDir);
  ReWrite(ToF,1);  for i:=0 to ListBox1.Items.Count-1 do
  begin
    ss:=ListBox1.Items.Strings[i];
    AssignFile(FromF,ss);
    ReSet(FromF,1);
    BlockRead(FromF,ss,15);
    if ss<>'XXSOFT001' then
    begin
      ShowMessage('不是该系统的文件！');
      CloseFile(FromF);
      Exit;
    end;
    repeat                            //写文件
      BlockRead(FromF,Buf,SizeOf(Buf),NumRead);
      BlockWrite(ToF,Buf,NumRead,NumWrite);
    until (NumRead=0)or(NumWrite<>NumRead);
    CloseFile(FromF);
  end;
  CloseFile(ToF);
end;procedure TfmMain.BitBtn2Click(Sender: TObject);
begin
  if (ListBox1.Items.Count>0)and(ResumeSaveDir.Text<>'')then
  begin
    StatusBar1.SimpleText:='恢复分割...';
    Cursor:=crHourGlass;
    ResumeTo(ResumeSaveDir.Text);
    Cursor:=crDefault;
    StatusBar1.SimpleText:='';
    Application.MessageBox(PChar('恢复成功！'),'提示',MB_OK + MB_DEFBUTTON1);
  end;
end;procedure TfmMain.ResumeSaveClick(Sender: TObject);
begin
  OpenDialog.Filter:='';
  OpenDialog.Options:=[ofHideReadOnly,ofEnableSizing];
  if OpenDialog.Execute then
    ResumeSaveDir.Text:=OpenDialog.FileName;
end;procedure TfmMain.edtSizeKeyPress(Sender: TObject; var Key: Char);
begin
  if not(Key in['0'..'9',#8,#13])then
    key:=#0;
end;procedure TfmMain.cboSizeKeyPress(Sender: TObject; var Key: Char);
begin
  key:=#0;
end;procedure TfmMain.N2Click(Sender: TObject);
begin
  Close;
end;procedure TfmMain.N1Click(Sender: TObject);
var c:string;
begin
  c:='本软件由燕山大学郭贤海设计'+#13+#10;
  c:=c+'E-mail:[email protected]'+#13+#10;
  c:=c+'Version 1.0';
  Application.MessageBox(PChar(c),'关于',MB_OK + MB_DEFBUTTON1);
end;procedure TfmMain.TabSheet1Enter(Sender: TObject);
begin
  //(Sender as TTabSheet).Font.Color:=
end;end.

Answer 1

我来凑凑热闹.自己做的,多批评
unit Main;interfaceuses
  Windows, SysUtils, Classes, Controls, Forms,
  Dialogs, StdCtrls, Buttons, Math, ComCtrls;type
  TForm1 = class(TForm)
    TabControl1: TTabControl;
    EditFile: TEdit;
    BitBtnBrowse: TBitBtn;
    GroupBox1: TGroupBox;
    RadioButton1M: TRadioButton;
    RadioButton2M: TRadioButton;
    RadioButtonSelfDefine: TRadioButton;
    EditDivSize: TEdit;
    BitBtnExecute: TBitBtn;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    procedure TabControl1Change(Sender: TObject);
    procedure EditDivSizeKeyPress(Sender: TObject; var Key: Char);
    procedure BitBtnBrowseClick(Sender: TObject);
    procedure BitBtnExecuteClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;var
  Form1: TForm1;
  vDivSize: integer;implementation{$R *.dfm}procedure MakeExt(Index: integer; var Ext: string);
var
  i: integer;
begin
  Ext := InttoStr(Index);
  for i := Length(Ext) to 2 do
    Ext := '0' + Ext;
end;procedure TForm1.TabControl1Change(Sender: TObject);
begin
  GroupBox1.Visible := TabControl1.TabIndex = 0;
end;procedure TForm1.EditDivSizeKeyPress(Sender: TObject; var Key: Char);
begin
  if not (Key in [#8, '0'..'9']) then
    Key := #0
  else
    RadioButtonSelfDefine.Checked := True;
end;procedure TForm1.BitBtnBrowseClick(Sender: TObject);
begin
  if OpenDialog1.Execute then
    EditFile.Text := OpenDialog1.FileName;
end;procedure TForm1.BitBtnExecuteClick(Sender: TObject);
var
  ReadFile, WriteFile: TFileStream;
  S, S1: string;
  Index, Read: integer;
begin
  while EditFile.Text = '' do
    if OpenDialog1.Execute then
      EditFile.Text := OpenDialog1.FileName
    else
      Exit;
  vDivSize := 0;
  if RadioButton1M.Checked then
    vDivSize := 1024 * 1024;
  if RadioButton2M.Checked then
    vDivSize := 1024 * 1024 * 2;
  if RadioButtonSelfDefine.Checked then
    try
      vDivSize := StrToInt(EditDivSize.Text);
    except
      vDivSize := 0;
    end;
  if vDivSize = 0 then
  begin
    MessageBox(Handle, '请指定文件分隔尺寸或者此数值不能为零！', '消息', MB_OK or MB_ICONINFORMATION);
    Exit;
  end;
  case TabControl1.TabIndex of
    0://分隔
    begin
      ReadFile := TFileStream.Create(EditFile.Text, fmOpenRead);
      Read := MaxInt;
      Index := 0;
      try
        while Read >= vDivSize do
        begin
          MakeExt(Index, S1);
          S := EditFile.Text + '.' + S1;
          WriteFile := TFileStream.Create(S, fmCreate);
          Read := WriteFile.CopyFrom(ReadFile, Min(vDivSize, ReadFile.Size - ReadFile.Position));
          WriteFile.Free;
          Inc(Index);
        end;
      finally
        ReadFile.Free;
      end;
    end;
    1://合并
    begin
      S := ExtractFileExt(EditFile.Text);
      Delete(S, 1, 1);
      try
        StrToInt(S);
      except
        MessageBox(Handle, '请选择带数字形式扩展名的文件。', '消息', MB_OK or MB_ICONINFORMATION);
        Exit;
      end;
      S := EditFile.Text;
      Delete(S, Length(S) - 3, 4);
      Index := 0;
      MakeExt(Index, S1);
      WriteFile := TFileStream.Create(S, fmCreate);
      try
        while FileExists(S + '.' + S1) do
        begin
          ReadFile := TFileStream.Create(S + '.' + S1, fmOpenRead);
          WriteFile.CopyFrom(ReadFile, ReadFile.Size);
          Inc(Index);
          MakeExt(Index, S1);
          ReadFile.Free;
        end;
      finally
        WriteFile.Free;
      end;
    end;
  end;
end;end.下面是窗体文件
object Form1: TForm1
  Left = 219
  Top = 143
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsSingle
  Caption = '文件分隔工具'
  ClientHeight = 195
  ClientWidth = 442
  Color = clBtnFace
  Font.Charset = GB2312_CHARSET
  Font.Color = clWindowText
  Font.Height = -12
  Font.Name = '宋体'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 12
  object TabControl1: TTabControl
    Left = 0
    Top = 0
    Width = 441
    Height = 153
    TabOrder = 0
    Tabs.Strings = (
      '分隔'
      '合并')
    TabIndex = 0
    OnChange = TabControl1Change
    object Label1: TLabel
      Left = 16
      Top = 40
      Width = 48
      Height = 12
      Caption = '选择文件'
    end
    object EditFile: TEdit
      Left = 72
      Top = 32
      Width = 345
      Height = 20
      ImeName = '紫光拼音输入法2.2版'
      TabOrder = 0
    end
    object BitBtnBrowse: TBitBtn
      Left = 344
      Top = 64
      Width = 75
      Height = 25
      Caption = '浏览(&B)...'
      TabOrder = 1
      OnClick = BitBtnBrowseClick
    end
    object GroupBox1: TGroupBox
      Left = 16
      Top = 64
      Width = 249
      Height = 81
      Caption = '分隔尺寸'
      TabOrder = 2
      object TLabel
        Left = 200
        Top = 56
        Width = 24
        Height = 12
        Caption = '字节'
      end
      object RadioButton1M: TRadioButton
        Left = 8
        Top = 24
        Width = 41
        Height = 17
        Caption = '1M'
        Checked = True
        TabOrder = 0
        TabStop = True
      end
      object RadioButton2M: TRadioButton
        Left = 56
        Top = 24
        Width = 33
        Height = 17
        Caption = '2M'
        TabOrder = 1
      end
      object RadioButtonSelfDefine: TRadioButton
        Left = 8
        Top = 56
        Width = 57
        Height = 17
        Caption = '自定义'
        TabOrder = 2
      end
      object EditDivSize: TEdit
        Left = 72
        Top = 48
        Width = 121
        Height = 20
        ImeName = '紫光拼音输入法2.2版'
        TabOrder = 3
        OnKeyPress = EditDivSizeKeyPress
      end
    end
  end
  object BitBtnExecute: TBitBtn
    Left = 344
    Top = 160
    Width = 75
    Height = 25
    Caption = '执行(E)'
    Default = True
    TabOrder = 1
    OnClick = BitBtnExecuteClick
  end
  object OpenDialog1: TOpenDialog
    Filter = '所有文件|*.*'
    Left = 392
    Top = 96
  end
end

Answer 2

文件切割器 界面设计：创建主窗体 XCutForm，保存应用程序为 Xcut.dpr1.选取文件
选取文件就是要弹出一个文件选取对话框给用户一个选择的机会，在Delphi中很容易实现，在Dialog对话框选取项中选取
OpenDialog放到窗体中,名称为OpenDialog.编辑OpenDialog的Filter 属性，如下图所示：2.文件切割大小
放置一个PageControl 控件在主窗体中，添加两个 TabSheet ,分别为 Tbs1和Tbs2.
在Tbs1上放一个RadioGroup,名称为rdgCut,编辑RadioGroup控件的属性，如下图所示：
给用户一个选取常用文件大小的列表
在Tbs2上放一个输入框，让用户可以自己设定文件大小：3.指定切割文件存放位置(目标文件夹)对于选取一个目标文件夹的对话框，在Delphi中没有直接支持，我们可以启用Com扩展打开Windows的标准打开文件夹对话框。为了方便使用，我们把它封装成一个方便使用的单元BrowseFolder(详见程序清单)，在调用的时候只需要几行代码Procedure
var
dlg: TBrowseForFolderDialog;
DestPath:string;
begin
dlg := TBrowseForFolderDialog.Create;
dlg.Title := '请选取目标文件夹:';
if dlg.Execute then
begin
DestPath := dlg.Path;
end;
dlg.Free;
end;4.开始切割根据上边步骤的选择，确定了待切割的原始文件，切割大小和存放位置，下边就可以开始了。
首先我们用一个“文件流”以只读方式打开原始文件
var
fs:TFileStream;
begin
fs:=TfileStream.create(“文件名称”,fmOpenRead)
……………然后我们创建一个“内存流”
var
ms:TmemoryStream;
begin
ms:=TmemoryStream.create;
……………
根据文件切割的大小计算字节数，从“文件流”中向“内存流”中拷贝指定的大小，将内存流存储到目标文件夹下，文件扩展名累计创建（方便合并）分析切割大小：
case rdgCut.ItemIndex of
0: filesize := 2000 * 1024; //2000 K
1: filesize := 1440 * 1024; //1440 K
2: filesize := 1200 * 1024; //1200 K
3: filesize := 1000 * 1024; //1000 K
4: filesize := 720 * 1024; //720 K
5: filesize := 500 * 1024; //500 K
6: filesize := 300 * 1024; //300 K
7: filesize := 200 * 1024; //200 K
else filesize := 100 * 1024; //100 K
在切割过程中应该显示一个进度，让用户了解进度，放置一个ProgressBar控件到主窗体中，设置属性。在切割开始时根据文件大小设定最大最小值和步长，在切割过程中不断根据实际情况修改当前位置，给用户一个运动的状态。代码如下所示：过程化显示切割进程fs := TFileStream.Create(filename, fmopenread);
ms := TMemoryStream.Create;
FileCount := 1;prbCut.Min := 0; 
prbCut.Max := (fs.size div filesize) + 1;
prbCut.step := 1;while fs.Position < fs.Size - 1 do
begin
ms.position := 0;
ms.size := 0;if fs.size - fs.Position < FileSize
then FileSize := fs.size - fs.position;ms.CopyFrom(fs, FileSize);
application.ProcessMessages;prbCut.StepIt;
ms.SaveToFile(DestPath + '\' + extractfilename(filename) + '.' + 
inttostr(FileCount));
memCut.lines.add('正在生成第 ' + inttostr(FileCount) + ' 个文件!');
inc(FileCount);end;
5.创建自动合并文件的批处理命令在 Dos 中有一条命令可以完成文件的合并
Copy file1 /b +file2 /b file3我们只要生成一个批处理命令文件，就可以在需要的时候完成合并工作，代码如下所示：assignfile(bat, DestPath + '\' + 
changefileext(ExtractFileName(filename), '.bat'));
rewrite(bat);
writeln(bat, 'echo off');
writeln(bat,'echo 谢谢使用文件分割 XCut 1.0 .....');
writeln(bat, 'echo .');
writeln(bat,'echo 正在准备生成文件'+extractfilename(filename));
writeln(bat, 'echo .');
writeln(bat,' echo 您可以按 CTRL + Z 键 中止,其他键继续!');writeln(bat,'pause');
for i := 1 to FileCount + 1 do
begin
if i = 1
then writeln(bat, 'copy ' + extractfilename(FileName) + '.1/b ' + 
extractfilename(FileName))
else writeln(bat, 'copy ' + extractfilename(FileName) + '/b +' + 
extractfilename(FileName) + '.' + inttostr(i) + '/b');end;
memCut.lines.add('正在生成合并命令文件: ' + 
changefileext(extractfilename(FileName), '.bat'));closefile(bat);memCut.lines.add('切割成功完成!');
Application.MessageBox('切割成功完成!', '恭喜', MB_OK + MB_ICONINFORMATION);