盒子 - 文件分割器的代码

			捐赠 \| 广告 \| 注册 \| 发布 \| 上传 \| 关于我们
		粤ICP备10103342号-1	DELPHI盒子 \| 盒子文章 \| 盒子问答悬赏 \| 最新更新 \| 盒子检索 \| 下载中心 \| 高级搜索
		粤ICP备10103342号-1	精品专区 \| 繁體中文 \| 奖励公告栏 \| 直通车账号登陆 \| 关闭GOOGLE广告 \| 临时留言

盒子资源分类

全部展开 - 全部合拢

文件分割器的代码

关键字：文件分割器 FileDivision
来　自：原创
平　台：Win9x,Win2k/NT,WinXP	下载所需：0 火柴
深浅度：初级	完成时间：2004/6/10
发布者：wangjian4936	发布时间：2004/6/10
编辑器：D5-7	语　　种：简体中文
分　类：其他	下载浏览：154/9918

加入到我的收藏

下载错误报错

登陆以后才能下载

用户名：

密　码：

自动登陆(30天有效)

无图片

unit Main;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, Buttons, FileCtrl, ActnList, ExtCtrls, ComCtrls;

type
  TMain_Form = class(TForm)
    Label1: TLabel;
    SpdButn_selectsource: TSpeedButton;
    SpdButn_selectecausefile: TSpeedButton;
    Label2: TLabel;
    Label3: TLabel;
    Butn_Ok: TButton;
    Butn_Exit: TButton;
    Edit_SourceFileName: TEdit;
    Edit_TargetDircetory: TEdit;
    ActionList1: TActionList;
    ExitAction: TAction;
    Label6: TLabel;
    Edit_PartitionFileSize: TEdit;
    Label7: TLabel;
    GroupBox_Size: TGroupBox;
    RadBtn_Mb: TRadioButton;
    RadBtn_Kb: TRadioButton;
    procedure SpdButn_selectsourceClick(Sender: TObject);
    procedure Butn_ExitClick(Sender: TObject);
    procedure SpdButn_selectecausefileClick(Sender: TObject);
    procedure Edit_TargetDircetoryMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure ExitActionExecute(Sender: TObject);
    procedure Butn_OkClick(Sender: TObject);
    procedure Edit_SourceFileNameMouseMove(Sender: TObject; Shift: TShiftState; X,
      Y: Integer);
    procedure RadBtn_KbClick(Sender: TObject);
    procedure RadBtn_MbClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    sourceF, TargetF: file;
    TargetFileDircetory, SourceFileDircetory, TargetFileC, SourceDircetory, SourceDircetorFind: string;
    ReadBufSize: integer;
    Buf: array[1..10485760] of Char;
    WriteResult, ReadResult, TargetDirectorySize, SecondWriteResult: integer;
    FileSe, HadWriteSize: longint; {文件长度}
    A, B: Boolean;
    SearchResult: TSearchRec;
  end;

var
  Main_Form: TMain_Form;

implementation

{$R *.dfm}

procedure TMain_Form.SpdButn_selectsourceClick(Sender: TObject); //选择源目录
begin
  SelectDirectory('请选择要复制的目录', ', SourceDircetory);
  Edit_SourceFileName.Text := SourceDircetory;
end;

procedure TMain_Form.Butn_ExitClick(Sender: TObject);
begin
  close; //退出程序
end;

procedure TMain_Form.SpdButn_selectecausefileClick(Sender: TObject);
var //选择目标目录
  aPath: string;
begin
  aPath := ';
  if SelectDirectory('选择保存目录:', 'E:\testfile', aPath) then
    Edit_TargetDircetory.Text := aPath;
end;

procedure TMain_Form.Edit_SourceFileNameMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Edit_SourceFileName.Hint := Edit_SourceFileName.Text;
end;

procedure TMain_Form.Edit_TargetDircetoryMouseMove(Sender: TObject; Shift: TShiftState; X,
  Y: Integer);
begin
  Edit_TargetDircetory.Hint := Edit_TargetDircetory.Text; //Edit2的Hint事件
end;

procedure TMain_Form.ExitActionExecute(Sender: TObject);
begin
  close; //退出程序
end;

procedure TMain_Form.Butn_OkClick(Sender: TObject); //开始拷贝按钮
var
  FileAttrs, I: integer;
begin
  A := True;
  b := A;
  HadWriteSize := 0;
  I := (-1);
  if DirectoryExists(Edit_SourceFileName.text) = false then
  begin
    ShowMessage('指定的文件夹不存在请正确的选择文件夹');
    Edit_SourceFileName.text := ';
    A := false;
    Edit_SourceFileName.SetFocus;
  end; //end if
  if DirectoryExists(Edit_TargetDircetory.text) = false then
  begin
    ShowMessage('所选的文件夹不存在，请重新选择');
    Edit_TargetDircetory.text := ';
    B := false;
    Edit_TargetDircetory.SetFocus;
  end; {end if}
  try
    StrToInt(Edit_PartitionFileSize.Text);
  except
    showmessage('你输入的数字不正确，请正确输入！');
    B := false;
  end;

  FileAttrs := faReadOnly + faHidden + faSysFile + faArchive; //确定要复制文件类型

  if (A = true) and (B = true) then
  begin
    SourceDircetory := Edit_SourceFileName.Text;
    if RadBtn_Mb.Checked then //确定一下要分割多大的文件
      ReadBufSize := (StrToInt(Edit_PartitionFileSize.Text)) * 1048576
    else
      ReadBufSize := (StrToInt(Edit_PartitionFileSize.Text)) * 1024;
  end; {end if} //确定结束
  SourceDircetorFind := (SourceDircetory + '\*.*');
  TargetDirectorySize := Length(Edit_TargetDircetory.Text);
  TargetFileDircetory := Edit_TargetDircetory.Text; {确认下目标路径名}
  Delete(TargetFileDircetory, TargetDirectorySize, 1);
  if (TargetFileDircetory + '\') = Edit_TargetDircetory.Text then
  begin {begin if}
    TargetFileDircetory := (Edit_TargetDircetory.Text);
  end {end if}
  else
  begin
    TargetFileDircetory := (Edit_TargetDircetory.Text + '\');
  end; {end else}
  if FindFirst(SourceDircetorFind, FileAttrs, SearchResult) = 0 then //找寻文件
  begin
    repeat
      Main_form.Enabled := false;
      begin
        SourceFileDircetory := SourceDircetory + '\' + SearchResult.Name;
    {打个找到的文件，确定要不要分割，先做不要分割的，不要分割的拿来复制}
        try
          AssignFile(SourceF, SourceFileDircetory); {打开源文件}
          Reset(SourceF, 1);
          FileSe := fileSize(SourceF);
          if FileSe <= ReadBufSize then {如果文件小于指定的大小拿来复制}
          begin
            TargetFileC := TargetFileDircetory + SearchResult.Name;
            AssignFile(TargetF, TargetFileC);
            Rewrite(TargetF, 1);
            BlockRead(SourceF, Buf, SizeOf(Buf), ReadResult);
            BlockWrite(TargetF, Buf, ReadResult, WriteResult);
            CloseFile(TargetF);
          end {end Begin}
    {下边写的是要分割的并且分割的第一个文件名是000的，以此类推}
          else
          begin
            repeat
              BlockRead(SourceF, Buf, ReadBufSize, ReadResult);
              if ReadResult > 0 then
              begin
                I := I + 1;
                TargetFileC := TargetFileDircetory + SearchResult.Name + Format('%.3d', [I]);
                AssignFile(TargetF, TargetFileC);
                Rewrite(TargetF, 1);
                BlockWrite(TargetF, Buf, ReadResult, WriteResult);
                CloseFile(TargetF);
              end;
            until
              (ReadResult = 0) or (WriteResult < ReadResult);
          end; {end begin}
        finally
          CloseFile(SourceF);
          I := (-1);
        end; {end try....finally....}
      end; {repeat}
    until
      FindNext(SearchResult) <> 0;
    FindClose(SearchResult);
    ShowMessage('复制分割完成');
    Main_form.Enabled := True;
  end; {end begin}
end;

procedure TMain_Form.RadBtn_KbClick(Sender: TObject);
begin
  try
    StrToInt(Edit_PartitionFileSize.Text);
    Edit_PartitionFileSize.Text := IntToStr(1024 * (StrToInt(Edit_PartitionFileSize.Text)));
  except
    ShowMessage('你输入的数字不正确，请正确输入！');
  end;
end;

procedure TMain_Form.RadBtn_MbClick(Sender: TObject);
begin
  try
    StrToInt(Edit_PartitionFileSize.Text);
    Edit_PartitionFileSize.Text := IntToStr((StrToInt(Edit_PartitionFileSize.Text) div 1024));
  except
    ShowMessage('你输入的数字不正确，请正确输入！');
  end;
end;

end.

本站原创作品，未经作者许可，严禁任何方式转载；转载作品，如果侵犯了您的权益，请联系我们！

龙脉加密锁 15元起

Grid++Report 报表

申请支付@网

文件合并隐藏 v0.5
hfhappy 2006/6/13 下+1654/浏+9826 评+4

利用文件流进行分割和合并
fghyxxe 2006/4/11 下+1711/浏+10928 评+4

简易文件分割器(纯PASCAL编写)
liumazi 2004/11/23 下+1057/浏+11554 评+20

文件分割器的代码
wangjian4936 2004/6/10 下+154/浏+9919 评+7

			捐赠 \| 广告 \| 注册 \| 发布 \| 上传 \| 关于我们
		粤ICP备10103342号-1	DELPHI盒子 \| 盒子文章 \| 盒子问答悬赏 \| 最新更新 \| 盒子检索 \| 下载中心 \| 高级搜索
		粤ICP备10103342号-1	精品专区 \| 繁體中文 \| 奖励公告栏 \| 直通车账号登陆 \| 关闭GOOGLE广告 \| 临时留言


		DELPHI盒子版权所有技术支持:深圳市麟瑞科技有限公司 1999-2024 V4.01 粤ICP备10103342号-1