unit1.pas

分割文件程序 可一将一个大文件分成若干个小文件 也可以再把它们合并恢复

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls, ToolWin, Menus, Buttons, StdCtrls, ExtCtrls, FileCtrl, Grids,
  Outline, DirOutln;

type
  TForm1 = class(TForm)
    ToolBar1: TToolBar;
    SpeedButton1: TSpeedButton;
    SpeedButton2: TSpeedButton;
    SpeedButton3: TSpeedButton;
    SpeedButton4: TSpeedButton;
    SpeedButton5: TSpeedButton;
    GroupBox1: TGroupBox;
    Memo1: TMemo;
    GroupBox2: TGroupBox;
    Edit1: TEdit;
    OpenDialog1: TOpenDialog;
    Button4: TButton;
    Edit2: TEdit;
    Panel1: TPanel;
    Panel2: TPanel;
    Panel3: TPanel;
    Panel4: TPanel;
    Panel5: TPanel;
    Panel6: TPanel;
    Edit4: TEdit;
    GroupBox3: TGroupBox;
    GroupBox4: TGroupBox;
    CheckBox4: TCheckBox;
    Panel7: TPanel;
    Panel9: TPanel;
    Edit5: TEdit;
    Button2: TButton;
    Button5: TButton;
    GroupBox5: TGroupBox;
    CheckBox1: TCheckBox;
    BitBtn1: TBitBtn;
    Button1: TButton;
    GroupBox6: TGroupBox;
    ToolButton1: TToolButton;
    ToolButton2: TToolButton;
    ToolButton3: TToolButton;
    ToolButton4: TToolButton;
    UpDown1: TUpDown;
    Edit3: TEdit;
    SaveDialog1: TSaveDialog;
    Edit6: TEdit;
    Button3: TButton;
    SpeedButton6: TSpeedButton;
    SpeedButton7: TSpeedButton;
    SpeedButton8: TSpeedButton;
    Memo2: TMemo;
    Memo3: TMemo;
    Memo4: TMemo;
    ProgressBar1: TProgressBar;
    procedure Button4Click(Sender: TObject);
    procedure SpeedButton4Click(Sender: TObject);
    procedure SpeedButton1Click(Sender: TObject);
    procedure SpeedButton2Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure Edit3Exit(Sender: TObject);
    procedure Button1Click(Sender: TObject);
    procedure Button5Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure SpeedButton3Click(Sender: TObject);
    procedure UpDown1Changing(Sender: TObject; var AllowChange: Boolean);
    procedure SpeedButton6Click(Sender: TObject);
    procedure SpeedButton7Click(Sender: TObject);
    procedure SpeedButton8Click(Sender: TObject);
    procedure SpeedButton9Click(Sender: TObject);
    procedure SpeedButton10Click(Sender: TObject);
    procedure SpeedButton5Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
  sf,df:file of byte;
  sfn,dfn:string;
  ec,cl:integer;
  fl:longint;
  exp,fn1,path:string;
implementation

{$R *.DFM}

procedure TForm1.Button4Click(Sender: TObject);
var rea:real;
begin
   opendialog1.filter:='任何文件|*.*';
   if opendialog1.execute then
   begin sfn:=opendialog1.FileName;
         assignfile(sf,sfn);
         {$i-}reset(sf);{$i+}
          ec:=ioresult;
         if ec<>0 then
             begin if ec=32 then showmessage('读文件错误!文件正被使用('+inttostr(ec)+').');
                   if ec=5 then showmessage('读文件错误!文件是只读文件('+inttostr(ec)+').');
                   if ((ec<>5)and(ec<>32)) then showmessage('错误('+inttostr(ec)+').');
               end
             else begin

                    edit1.text:=sfn;
                    fl:=filesize(sf);
                    rea:=fl;
                    rea:=rea/100000;
                    str((rea+0.1):10:1,path);
                    edit2.text:=path;
                    str(rea:10:0,path);
                    updown1.Max:=strtoint(path)+1;
                    closefile(sf);
                    path:=extractfiledir(edit1.text);
                    path:=path+'\';
                    fn1:=extractfilename(edit1.text);
                    exp:=extractfileext(edit1.text);
                    delete(fn1,length(fn1)-length(exp)+1,length(exp));
                    edit4.text:=path+fn1;
                    edit3.Text:='1';
                   end;
     end;
   end;
procedure TForm1.SpeedButton4Click(Sender: TObject);
begin
GROUPBOX6.VISIBLE:=FALSE;
 groupbox2.visible:=false;
 groupbox3.visible:=false;
 groupbox1.visible:=true;
end;

procedure TForm1.SpeedButton1Click(Sender: TObject);
begin
 GROUPBOX6.VISIBLE:=FALSE;
 groupbox1.visible:=false;
 groupbox3.visible:=false;
 groupbox2.visible:=true;
                   end;

procedure TForm1.SpeedButton2Click(Sender: TObject);
begin
GROUPBOX6.VISIBLE:=FALSE;
groupbox1.visible:=false;
groupbox2.visible:=false;
groupbox3.visible:=true;
end;
function fileexist(filename:string):boolean;
  var f:file;
  begin  {$i-}
  assignfile(f,filename);
  filemode:=0;
  reset(f);
  closefile(f);
  {$i+}
  fileexist:=(ioresult=0)and(filename<>'');
  end;
procedure fenjie;
type ee3=record
              ee1:string[255];
              ee2:word;
              ee5:word;
        end;
var  ss:string;
     ff,de:file;
     ee:file of ee3;
     nr,nw:integer;
     buf:array[1..50000]of byte;
     i,j:integer;
     ee4:ee3;
     we:longint;
begin
      assignfile(ff,form1.edit1.text);
      reset(ff,1);
      ee4.ee1:=extractfilename(form1.edit1.text);
      ee4.ee2:=strtoint(form1.edit3.text);
      we:=100000*ee4.ee2;
      we:=(filesize(ff)div we)+1;
      ee4.ee5:=we;
      assignfile(ee,FORM1.EDIT4.TEXT+'.101');
      {$i-} rewrite(ee);{$i+}
      if (ioresult<>0) then begin showmessage('不能创建文件!(1)');
                           exit;
                     end;
      write(ee,ee4);
      closefile(ee);
      j:=1;
      repeat
      j:=j+1;
      str(j+100,ss);
      ss:=FORM1.EDIT4.TEXT+'.'+ss;
      assign(de,ss);
      rewrite(de,1);
    for i:=1 to ee4.ee2*2 do
      begin {$i-}
          blockread(ff,buf,sizeof(buf),nr);
          blockwrite(de,buf,nr,nw);
          {$I+}
          if ioresult<>0 then begin showmessage('不能创建文件(2)!');
                                         exit;
                                   end;
      end;
      closefile(de);
      if (j<>we)and(form1.CheckBox1.Checked) then showmessage('第'+inttostr(j-1)+'个文件分解完成，继续......');
      form1.ProgressBar1.Position:=round(100*j/we);
      until (nr=0);
      closefile(ff);
      showmessage('分解完成!');
      form1.ProgressBar1.Position:=0;
end;
procedure hecheng;
type ee3=record
           ee1:string[255];
           ee2:word;
           ee5:word;
         end;
var  sp,dn,ss,sn,snew:string[255];
     dd,ee:file;
     ee4:ee3;
     ff:file of ee3;
     ww,nr,nw:integer;
     buf:array[1..50000]of byte;
     i,j:integer;
     we:longint;
begin assignfile(ff,FORM1.EDIT5.TEXT);
      reset(ff);
      sp:=extractfilepath(form1.Edit5.Text);
      read(ff,ee4);
      ss:=ee4.ee1;
      ww:=ee4.ee2;
      we:=ee4.ee5;
      closefile(ff);
      if form1.checkbox4.checked then erase(ff);
      assignfile(dd,form1.edit6.text+ss);
      with form1.Edit5 do
        begin snew:=extractfilename(text);
              sfn:=copy(snew,1,length(snew)-length(extractfileext(text)));
        end;
      for i:=2 to we do
      begin str(100+i,sn);
            dn:=sp+sfn+'.'+sn;
            assignfile(ee,dn);
            {$I-}reset(ee,1);{$I+}
            if ioresult<>0 then begin showmessage('原文件已被破坏!');
                                      exit;
                                end;
             closefile(ee);
       end;
       j:=1;
       rewrite(dd,1);
      repeat
      j:=j+1;
      str(100+j,sn);
      dn:=sp+sfn+'.'+sn;
      assignfile(ee,dn);
      reset(ee,1);

    for i:=1 to ww*2 do
      begin
          blockread(ee,buf,sizeof(buf),nr);
          blockwrite(dd,buf,nr,nw);
      end;
      closefile(ee);
      if form1.checkbox4.checked then erase(ee);
      form1.ProgressBar1.Position:=round(100*j/we);
      until (nr=0);
      closefile(dd);
      if form1.checkbox4.checked then form1.Edit5.text:='';
      showmessage('文件合成完毕!!') ;
      form1.ProgressBar1.Position:=0;
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
  opendialog1.filter:='分割头文件(*.101)|*.101';
 if opendialog1.Execute then
    begin edit5.text:=opendialog1.filename;
          path:=extractfilepath(edit5.text);
          edit6.text:=path;
    end;

end;

procedure TForm1.BitBtn1Click(Sender: TObject);
var j,jjj:integer;
    f:file;
begin  //检测原文件是否存在
      assignfile(f,edit1.text);
      {$i-}reset(f);
      j:=filesize(f);{$i+}
      if (ioresult<>0) then
          begin
               showmessage('请选择文件!');
               exit;
          end;
       closefile(f);
       //检测子文件长度合法性
       val(edit3.text,j,jjj);
        if (jjj<>0)or(j=0) THEN
          BEGIN
               showmessage('非法的子文件长度!');
               exit;
          end;
       //检测目标文件是否合法
       if edit4.text='' then begin showmessage('目标文件名非法!');
                                   exit;
                             end;
       path:=extractfiledir(edit4.text);
       path:=path+'\';
       fn1:=extractfilename(edit4.text);
       exp:=extractfileext(edit4.text);
       delete(fn1,length(fn1)-length(exp)+1,length(exp));
       showmessage('开始分解......');
       fenjie;
 end;

procedure TForm1.Edit3Exit(Sender: TObject);
begin
  val(edit3.text,cl,ec);
  if ec<>0 then showmessage('非法的子文件长度!');
end;

procedure TForm1.Button1Click(Sender: TObject);
VAR SS:STRING;
begin
  if savedialog1.Execute then
     BEGIN  SS:=savedialog1.FileName;
            EDIT4.TEXT:=COPY(SS,1,LENGTH(SS)-LENGTH(EXTRACTFILEEXT(EDIT4.TEXT)));
     END;
end;


procedure TForm1.Button5Click(Sender: TObject);
begin
   if edit5.text='' then
      begin
      showmessage('请选择原文件!');
      exit;
      end;
   if edit6.text='' then begin
      showmessage('请选择保存位置!');
      exit;
      end;
   hecheng;
end;

procedure TForm1.Button3Click(Sender: TObject);
var str:string;
begin savedialog1.title:='选择路径';
      savedialog1.filter:='合成文件|%%%%.##';
      savedialog1.filename:='原文件名(请不要改动)';
    if savedialog1.Execute then
      begin str:=savedialog1.FileName;
            form1.edit6.text:=extractfilepath(str);
      end;
   end;

procedure TForm1.SpeedButton3Click(Sender: TObject);
begin
  GROUPBOX1.VISIBLE:=FALSE;
  GROUPBOX2.VISIBLE:=FALSE;
  GROUPBOX3.VISIBLE:=FALSE;
  GROUPBOX6.VISIBLE:=TRUE;
end;

procedure TForm1.UpDown1Changing(Sender: TObject;
  var AllowChange: Boolean);
begin
  IF updown1.position <>0 THEN
     edit3.text:=inttostr(updown1.position);
end;


procedure TForm1.SpeedButton6Click(Sender: TObject);
begin
  memo3.visible:=false;
  memo4.visible:=false;
  memo2.visible:=true;
end;

procedure TForm1.SpeedButton7Click(Sender: TObject);
begin
  memo2.visible:=false;
  memo4.visible:=false;
  memo3.visible:=true;
end;

procedure TForm1.SpeedButton8Click(Sender: TObject);
begin
  memo3.visible:=false;
  memo2.visible:=false;
  memo4.visible:=true;
end;

procedure TForm1.SpeedButton9Click(Sender: TObject);
begin
   close;
end;

procedure TForm1.SpeedButton10Click(Sender: TObject);
begin
  GROUPBOX6.VISIBLE:=TRUE;
end;

procedure TForm1.SpeedButton5Click(Sender: TObject);
begin
  IF (Application.MessageBox('真的要退出吗？','三陀工作室',MB_YESNO + MB_DEFBUTTON1) = IDYES) then
     close;
end;




end.