文件切割器

Pascal编程基础

下载此实例

开发语言：Pascal
实例大小：8.52KB
下载次数：6
浏览次数：86
发布时间：2022-01-22
实例类别：Pascal编程基础
发布人：279577244
文件格式：.7z
所需积分：2

实例介绍

[下载地址]

【实例简介】文件切割器

实现将大文件切割成很多小文件，可以自定义文件大小

【实例截图】

from clipboard

【核心代码】unit MainUnit;

interface

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

type
TXCutForm = class(TForm)
Button1: TButton;
Button2: TButton;
Button3: TButton;
Button4: TButton;
PageControl1: TPageControl;
TabSheet1: TTabSheet;
RadioGroup1: TRadioGroup;
TabSheet2: TTabSheet;
Memo1: TMemo;
OpenDialog1: TOpenDialog;
Label1: TLabel;
Edit1: TEdit;
Label2: TLabel;
PrbCut: TProgressBar;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Button3Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
XCutForm: TXCutForm;
FilePath:String; //存放文件名和路径
Dir:String; //存放目标文件夹路径

implementation

uses Math;

{$R *.dfm}

procedure TXCutForm.Button1Click(Sender: TObject);
begin
if OpenDialog1.Execute
then
begin
FilePath:=OpenDialog1.FileName;
Button2.Enabled:=true;
Button3.Enabled:=true;
end;
end;

procedure TXCutForm.Button2Click(Sender: TObject);
begin
DestPathForm.Show;
end;

procedure TXCutForm.Button3Click(Sender: TObject);
var
fs:TFileStream;
ms:TmemoryStream;
filesize,filecount:integer;
bat:TextFile;
i:integer;
begin
if PageControl1.ActivePage=TabSheet1
then
begin
case RadioGroup1.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
end;
end
else filesize:= StrToInt(Edit1.text)*1024;

fs := TFileStream.Create(filepath, 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(dir '\' extractfilename(filepath) '.' inttostr(FileCount));
memo1.lines.add('正在生成第 ' inttostr(FileCount) ' 个文件!');
inc(FileCount);
end;

assignfile(bat, dir '\' changefileext(ExtractFileName(filepath), '.bat'));
rewrite(bat);
writeln(bat, 'echo off');
writeln(bat,'echo 谢谢使用文件分割 XCut 1.0 .....');
writeln(bat, 'echo .');
writeln(bat,'echo 正在准备生成文件' extractfilename(filepath));
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(Filepath) '.1/b ' extractfilename(Filepath))
else writeln(bat, 'copy ' extractfilename(Filepath) '/b ' extractfilename(Filepath) '.' inttostr(i) '/b');

end;

memo1.lines.add('正在生成合并命令文件: ' changefileext(extractfilename(Filepath), '.bat'));

closefile(bat);

memo1.lines.add('切割成功完成!');
Application.MessageBox('切割成功完成!', '恭喜', MB_OK MB_ICONINFORMATION);

end;
procedure TXCutForm.Button4Click(Sender: TObject);
begin
close;
end;

end.

.
├── 好例子网_文件切割器.7z
└── 文件切割器
├── DestPath.dcu
├── DestPath.ddp
├── DestPath.dfm
├── DestPath.pas
├── MainUnit.dcu
├── MainUnit.ddp
├── MainUnit.dfm
├── MainUnit.pas
├── MainUnit.~ddp
├── MainUnit.~dfm
├── MainUnit.~pas
├── XCut.cfg
├── XCut.dof
├── XCut.dpr
└── XCut.res

1 directory, 16 files

标签： 切割文件

实例下载地址