Division 文件分割/合並控件演示，作者：杜偉(vber) 。窗體使用了TAB選項卡的布局，這也是亮點之一，將分割文件與合並文件整合到了一起，操作起來挺方便。窗體下邊會顯示進度條，還可以生成合並或分割時的批處理文件，方便以後用。
程序最終運行效果如下圖所示：
Delphi文件分割器、文件合並程序代碼：
001
unit Division_Unit;
002
interface
003
uses
004
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
005
ComCtrls, StdCtrls, Division, Buttons, SHLOBJ;
006
type
007
TfrmDivision = class(TForm)
008
PageControl1: TPageControl;
009
TabSheet1: TTabSheet;
010
TabSheet2: TTabSheet;
011
Label1: TLabel;
012
Edit1: TEdit;
013
Button1: TButton;
014
Label2: TLabel;
015
Edit2: TEdit;
016
Button2: TButton;
017
Label3: TLabel;
018
Edit3: TEdit;
019
CheckBox1: TCheckBox;
020
Label4: TLabel;
021
Label5: TLabel;
022
ProgressBar1: TProgressBar;
023
OpenDialog1: TOpenDialog;
024
SaveDialog1: TSaveDialog;
025
Button3: TButton;
026
Division1: TDivision;
027
Button4: TButton;
028
GroupBox1: TGroupBox;
029
RadioButton1: TRadioButton;
030
Edit4: TEdit;
031
SpeedButton1: TSpeedButton;
032
RadioButton2: TRadioButton;
033
SpeedButton2: TSpeedButton;
034
SpeedButton3: TSpeedButton;
035
ProgressBar2: TProgressBar;
036
Label6: TLabel;
037
ListBox1: TListBox;
038
TabSheet3: TTabSheet;
039
procedure Button1Click(Sender: TObject);
040
procedure Button2Click(Sender: TObject);
041
procedure Edit1Change(Sender: TObject);
042
procedure CheckBox1Click(Sender: TObject);
043
procedure Button3Click(Sender: TObject);
044
procedure Division1BeginCombine(FileCount: Integer);
045
procedure Division1BeginDivision(SectionTotal: Integer);
046
procedure Division1DoingCombine(Sender: TObject);
047
procedure Division1DoingDivision(Sender: TObject);
048
procedure Division1EndCombine(Sender: TObject);
049
procedure Division1EndDivision(Sender: TObject);
050
procedure FormShow(Sender: TObject);
051
procedure SpeedButton3Click(Sender: TObject);
052
procedure SpeedButton1Click(Sender: TObject);
053
procedure RadioButton1Click(Sender: TObject);
054
procedure RadioButton2Click(Sender: TObject);
055
procedure SpeedButton2Click(Sender: TObject);
056
procedure Button4Click(Sender: TObject);
057
procedure PageControl1Change(Sender: TObject);
058
private
059
{ Private declarations }
060
public
061
{ Public declarations }
062
end;
063
var
064
frmDivision: TfrmDivision;
065
implementation
066
{$R *.DFM}
067
// 浏覽文件夾
068
function SelectDirectory(var InitPath : String;szTitle: String) : Boolean;
069
var BROWSEINFO:TBROWSEINFO;
070
vPath : PItemIDList;
071
Path : PChar;
072
begin
073
BROWSEINFO.hwndOwner := Application.Handle;
074
BROWSEINFO.lpfn := nil;
075
BROWSEINFO.lpszTitle := PChar(szTitle);
076
BROWSEINFO.pidlRoot := nil;
077
BROWSEINFO.pszDisplayName := nil;
078
BROWSEINFO.lParam := BFFM_INITIALIZED;
079
BROWSEINFO.ulFlags := BIF_RETURNONLYFSDIRS;
080
vPath := SHBrowseForFolder(BROWSEINFO);
081
Result := False;
082
if vPath <> nil then begin
083
GetMem(Path, 255);
084
SHGetPathFromIDList(vPath, Path);
085
InitPath := StrPas(Path);
086
FreeMem(Path);
087
Result := True;
088
end;
089
end;
090
procedure TfrmDivision.Button1Click(Sender: TObject);
091
begin
092
with OpenDialog1 do
093
begin
094
if Execute then
095
Edit1.Text := FileName;
096
end;
097
end;
098
procedure TfrmDivision.Button2Click(Sender: TObject);
099
begin
100
with SaveDialog1 do
101
begin
102
if Execute then
103
begin
104
Edit2.Text := ChangeFileExt(FileName, ExtractFileExt(Edit1.Text));
105
end;
106
end;
107
end;
108
procedure TfrmDivision.Edit1Change(Sender: TObject);
109
begin
110
if Edit1.Text <> '' then
111
Edit2.Text := Edit1.Text;
112
end;
113
procedure TfrmDivision.CheckBox1Click(Sender: TObject);
114
begin
115
if CheckBox1.Checked then Division1.CreateType := ctBat
116
else Division1.CreateType := ctNone;
117
end;
118
procedure TfrmDivision.Button3Click(Sender: TObject);
119
begin
120
Button3.Enabled := False;
121
Screen.Cursor := crHourGlass;
122
// 開始分割
123
Division1.DivisionSize := StrToInt(Edit3.Text);
124
Division1.FileName := Edit1.Text;
125
Division1.SavePathName := Edit2.Text;
126
Division1.Execute;
127
end;
128
procedure TfrmDivision.Division1BeginCombine(FileCount: Integer);
129
begin
130
ProgressBar2.Max := FileCount;
131
end;
132
procedure TfrmDivision.Division1BeginDivision(SectionTotal: Integer);
133
begin
134
ProgressBar1.Max := SectionTotal;
135
end;
136
procedure TfrmDivision.Division1DoingCombine(Sender: TObject);
137
begin
138
ProgressBar2.StepIt;
139
end;
140
procedure TfrmDivision.Division1DoingDivision(Sender: TObject);
141
begin
142
ProgressBar1.StepIt;
143
end;
144
procedure TfrmDivision.Division1EndCombine(Sender: TObject);
145
begin
146
Button4.Enabled := True;
147
Screen.Cursor := crDefault;
148
ProgressBar2.Position := 0;
149
Application.MessageBox('合並完成!', '信息', MB_OK + MB_ICONINFORMATION);
150
end;
151
procedure TfrmDivision.Division1EndDivision(Sender: TObject);
152
begin
153
Button3.Enabled := True;
154
Screen.Cursor := crDefault;
155
ProgressBar1.Position := 0;
156
Application.MessageBox('分割完成!', '信息', MB_OK + MB_ICONINFORMATION);
157
end;
158
procedure TfrmDivision.FormShow(Sender: TObject);
159
begin
160
ProgressBar1.Step := 1;
161
ProgressBar2.Step := 1;
162
end;
163
procedure TfrmDivision.SpeedButton3Click(Sender: TObject);
164
begin
165
ListBox1.Clear;
166
end;
167
procedure TfrmDivision.SpeedButton1Click(Sender: TObject);
168
var
169
sPath: String;
170
begin
171
if SelectDirectory(sPath, '浏覽文件夾:') then
172
Edit4.Text := sPath;
173
end;
174
procedure TfrmDivision.RadioButton1Click(Sender: TObject);
175
begin
176
if RadioButton1.Checked then
177
begin
178
Edit4.Enabled := True;
179
SpeedButton1.Enabled := True;
180
SpeedButton2.Enabled := False;
181
SpeedButton3.Enabled := False;
182
ListBox1.Enabled := False;
183
end
184
else
185
begin
186
SpeedButton2.Enabled := True;
187
SpeedButton3.Enabled := True;
188
ListBox1.Enabled := True;
189
Edit4.Enabled := False;
190
SpeedButton1.Enabled := False;
191
end;
192
end;
193
procedure TfrmDivision.RadioButton2Click(Sender: TObject);
194
begin
195
if RadioButton2.Checked then
196
begin
197
Edit4.Enabled := False;
198
SpeedButton1.Enabled := False;
199
SpeedButton2.Enabled := True;
200
SpeedButton3.Enabled := True;
201
ListBox1.Enabled := True;
202
end
203
else
204
begin
205
SpeedButton2.Enabled := False;
206
SpeedButton3.Enabled := False;
207
ListBox1.Enabled := False;
208
Edit4.Enabled := True;
209
SpeedButton1.Enabled := True;
210
end;
211
end;
212
procedure TfrmDivision.SpeedButton2Click(Sender: TObject);
213
var i: Integer;
214
begin
215
with OpenDialog1 do
216
begin
217
Options := [ofAllowMultiSelect];
218
if Execute then
219
begin
220
ListBox1.Clear;
221
for i:=0 to Files.Count-1 do
222
ListBox1.Items.Add(Files.Strings[i]);
223
end;
224
end;
225
end;
226
procedure TfrmDivision.Button4Click(Sender: TObject);
227
begin
228
// 開始合並
229
Button4.Enabled := False;
230
Screen.Cursor := crHourGlass;
231
if RadioButton1.Checked then
232
begin
233
Division1.WorkType := ttCombine;
234
Division1.CombineSource := csPath;
235
Division1.CombinePath := Edit4.Text;
236
Division1.Execute;
237
end
238
else if RadioButton2.Checked then
239
begin
240
Division1.WorkType := ttCombine;
241
Division1.CombineSource := csFiles;
242
Division1.CombineFileList.Assign(ListBox1.Items);
243
Division1.Execute;
244
end;
245
end;
246
procedure TfrmDivision.PageControl1Change(Sender: TObject);
247
begin
248
if PageControl1.ActivePageIndex = 2 then
249
begin
250
Division1.About;
251
PageControl1.ActivePageIndex := 0;
252
end;
253
end;
254
end.
這是主要的代碼文件，可以在Delphi7中編譯運行。
