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. |
