hmm...sampe sekarang masih aja lom ada kerjaan di kantor ya udah iseng-iseng dah buat aplikasi-aplikasi kecil seperti ini yaitu File Splitter 1.0. aplikasi ini memungkinkan kita untuk memecah file menjadi beberapa bagian tergantung daripada berapa ukuran pecahan file tersebut dan dapat mengembalikannya menjadi satu file utuh kembali.
Mengapa ada kata2 "I" di belakang judul artikel ini???ya karena untuk artikel berikutnya saya akan membuat aplikasi yang sama namun dalam setiap pecahan filenya akan terenkripsi. ya udah gak usah lama-lama lagi berikut ini adalah kode selengkapnya :
[uMain.dfm]
[uMain.pas]
[uProgress.dfm]
[uProgress.pas]
[uMain.dfm]
object frmMain: TfrmMain
Left = 0
Top = 0
BorderStyle = bsDialog
Caption = 'Tigor'#39's File Splitter 1.0'
ClientHeight = 238
ClientWidth = 441
Color = 8816262
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
OldCreateOrder = False
Position = poDesktopCenter
PixelsPerInch = 96
TextHeight = 13
object GroupBox1: TGroupBox
Left = 8
Top = 8
Width = 425
Height = 113
Caption = ' [ Split File ] '
TabOrder = 0
object Label1: TLabel
Left = 24
Top = 73
Width = 68
Height = 13
Caption = 'Split File Size :'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWhite
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
ParentFont = False
end
object edTarget: TLabeledEdit
Left = 98
Top = 16
Width = 295
Height = 21
EditLabel.Width = 61
EditLabel.Height = 13
EditLabel.Caption = 'File Target : '
EditLabel.Font.Charset = DEFAULT_CHARSET
EditLabel.Font.Color = clWhite
EditLabel.Font.Height = -11
EditLabel.Font.Name = 'Tahoma'
EditLabel.Font.Style = []
EditLabel.ParentFont = False
LabelPosition = lpLeft
ReadOnly = True
TabOrder = 0
end
object Button2: TButton
Left = 394
Top = 16
Width = 25
Height = 21
Caption = '...'
TabOrder = 1
OnClick = Button2Click
end
object edSize: TEdit
Left = 98
Top = 70
Width = 39
Height = 21
MaxLength = 4
TabOrder = 2
Text = '100'
OnKeyPress = edSizeKeyPress
end
object Button1: TButton
Left = 345
Top = 82
Width = 75
Height = 25
Caption = 'Split Now!!!'
TabOrder = 3
OnClick = Button1Click
end
object cbSize: TComboBox
Left = 143
Top = 70
Width = 74
Height = 21
Style = csDropDownList
ItemHeight = 13
ItemIndex = 0
TabOrder = 4
Text = 'Kbytes'
Items.Strings = (
'Kbytes'
'Mbytes')
end
object edOutput: TLabeledEdit
Left = 98
Top = 43
Width = 295
Height = 21
EditLabel.Width = 88
EditLabel.Height = 13
EditLabel.Caption = 'Output Directory :'
EditLabel.Font.Charset = DEFAULT_CHARSET
EditLabel.Font.Color = clWhite
EditLabel.Font.Height = -11
EditLabel.Font.Name = 'Tahoma'
EditLabel.Font.Style = []
EditLabel.ParentFont = False
LabelPosition = lpLeft
ReadOnly = True
TabOrder = 5
end
object Button3: TButton
Left = 394
Top = 43
Width = 25
Height = 21
Caption = '...'
TabOrder = 6
OnClick = Button3Click
end
end
object GroupBox2: TGroupBox
Left = 8
Top = 127
Width = 425
Height = 105
Caption = ' [ Join File ] '
TabOrder = 1
object edTargetJoin: TLabeledEdit
Left = 98
Top = 16
Width = 295
Height = 21
EditLabel.Width = 61
EditLabel.Height = 13
EditLabel.Caption = 'File Target : '
EditLabel.Font.Charset = DEFAULT_CHARSET
EditLabel.Font.Color = clWhite
EditLabel.Font.Height = -11
EditLabel.Font.Name = 'Tahoma'
EditLabel.Font.Style = []
EditLabel.ParentFont = False
LabelPosition = lpLeft
ReadOnly = True
TabOrder = 0
end
object Button4: TButton
Left = 394
Top = 16
Width = 25
Height = 21
Caption = '...'
TabOrder = 1
OnClick = Button4Click
end
object edOutputJoin: TLabeledEdit
Left = 98
Top = 43
Width = 295
Height = 21
EditLabel.Width = 88
EditLabel.Height = 13
EditLabel.Caption = 'Output Directory :'
EditLabel.Font.Charset = DEFAULT_CHARSET
EditLabel.Font.Color = clWhite
EditLabel.Font.Height = -11
EditLabel.Font.Name = 'Tahoma'
EditLabel.Font.Style = []
EditLabel.ParentFont = False
LabelPosition = lpLeft
ReadOnly = True
TabOrder = 2
end
object Button5: TButton
Left = 394
Top = 43
Width = 25
Height = 21
Caption = '...'
TabOrder = 3
OnClick = Button5Click
end
object Button6: TButton
Left = 347
Top = 75
Width = 75
Height = 25
Caption = 'Join Now!!!'
TabOrder = 4
OnClick = Button6Click
end
end
end
[uMain.pas]
unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls,FileCTRL;
type
TfrmMain = class(TForm)
GroupBox1: TGroupBox;
edTarget: TLabeledEdit;
Button2: TButton;
Label1: TLabel;
edSize: TEdit;
Button1: TButton;
cbSize: TComboBox;
GroupBox2: TGroupBox;
edOutput: TLabeledEdit;
Button3: TButton;
edTargetJoin: TLabeledEdit;
Button4: TButton;
edOutputJoin: TLabeledEdit;
Button5: TButton;
Button6: TButton;
procedure Button3Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure edSizeKeyPress(Sender: TObject; var Key: Char);
procedure Button1Click(Sender: TObject);
procedure Button4Click(Sender: TObject);
procedure Button5Click(Sender: TObject);
procedure Button6Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;
CONST
PrefPart = '.TSPs'; //Part File Extension
var
frmMain: TfrmMain;
implementation
uses uProgress;
{$R .dfm}
function GetZeroString(s: string): string;
var
str: string;
begin
str:='00000000000';
result:=Copy(str,0,5 - Length(s)) + s;
end;
procedure TfrmMain.Button1Click(Sender: TObject);
var
fsTarget,fsOut: TFileStream;
i: integer;
iPartSize: int64;
sFileName: string;
begin
//simple validation
if not(FileExists(edTarget.Text)) or not(DirectoryExists(edOutput.Text)) then
begin
ShowMessage('Target file or Output directory doesn''t exists.');
exit;
end;
frmMain.Enabled := False;
frmProgress.pbProses.Position := 0;
frmProgress.Show;
Application.ProcessMessages;
fsTarget := TFileStream.Create(edTarget.Text,fmOpenRead or fmShareDenyWrite);
iPartSize := StrToInt64(edSize.Text);
try
case cbSize.ItemIndex of
0: iPartSize := iPartSize 1024; //convert from bytes to Kbytes
1: iPartSize := (iPartSize 1024) 1024;
end;
//start to split file...
for i := 1 to trunc(fsTarget.Size / iPartSize) + 1 do
begin
sFileName := edOutput.Text + ExtractFileName(edTarget.Text) + PrefPart +
GetZeroString(IntToStr(i)); //definition filename first
fsOut := TFileStream.Create(sFileName,fmCreate or fmShareExclusive); //
//create a new file according to the variable "sFileName)
try
if fsTarget.Size - fsTarget.Position < iPartSize then
iPartSize := fsTarget.Size - fsTarget.Position;
fsOut.CopyFrom(fsTarget,iPartSize);
frmProgress.pbProses.Position := Round((fsTarget.Position / fsTarget.Size)
100);
Application.ProcessMessages;
finally
fsOut.Free;
end;
end;
frmMain.Enabled := True;
frmProgress.Close;
finally
fsTarget.Free;
end;
end;
procedure TfrmMain.Button2Click(Sender: TObject);
var
dlg: TOpenDialog;
begin
dlg := TOpenDialog.Create(self);
with dlg do
begin
Title := 'Select File Target...';
Filter := 'Any File | .';
end;
try
if dlg.Execute then
begin
edTarget.Text := dlg.FileName;
edOutput.Text := ExtractFilePath(dlg.FileName);
end;
finally
dlg.Free;
end;
end;
procedure TfrmMain.Button3Click(Sender: TObject);
var
sDest: string;
begin
if SelectDirectory('Output File Part','',sDest) then
edOutput.Text := sDest;
end;
procedure TfrmMain.Button4Click(Sender: TObject);
var
dlg: TOpenDialog;
begin
dlg := TOpenDialog.Create(Self);
with dlg do
begin
Title := 'Search File Part...';
Filter := 'File Part | ' + PrefPart + GetZeroString('1');
end;
try
if dlg.Execute then
begin
edTargetJoin.Text := dlg.FileName;
edOutputJoin.Text := ChangeFileExt(dlg.FileName,'')
end;
finally
dlg.Free;
end;
end;
procedure TfrmMain.Button5Click(Sender: TObject);
var
sDest: string;
begin
if SelectDirectory('Select Output File Join...','',sDest) then
begin
edOutputJoin.Text := sDest + '' + ExtractFileName(ChangeFileExt(
edTargetJoin.Text,''));
end;
end;
procedure TfrmMain.Button6Click(Sender: TObject);
var
i,iCount: integer;
fsInput,fsOutput: TFileStream;
sFile: string;
begin
//simple validation
if not(FileExists(edTargetJoin.Text)) then
begin
ShowMessage('Target File doesn''t exists.');
exit;
end;
fsOutput := TFileStream.Create(edOutputJoin.Text,fmCreate);
try
iCount := 1;
sFile := ChangeFileExt(edTargetJoin.Text,PrefPart + GetZeroString(IntToStr(
iCount)));
//count file manually
while FileExists(sFile) do
begin
inc(iCount);
sFile := ChangeFileExt(edTargetJoin.Text,PrefPart + GetZeroString(IntToStr(
iCount)));
end;
//set form focused
frmMain.Enabled := False;
frmProgress.pbProses.Position := 0;
frmProgress.Show;
Application.ProcessMessages;
//start merge file
for i := 1 to iCount - 1 do
begin
sFile := ChangeFileExt(edTargetJoin.Text,PrefPart + GetZeroString(IntToStr(
i)));
fsInput := TFileStream.Create(sFile,fmOpenRead or fmShareExclusive);
try
fsInput.Position := 0;
fsOutput.Position := fsOutput.Size;
fsOutput.CopyFrom(fsInput,fsInput.Size);
frmProgress.pbProses.Position := Round((i / iCount) 100);
Application.ProcessMessages;
finally
fsInput.Free;
end;
end;
frmMain.Enabled := True;
frmProgress.Close;
finally
fsOutput.Free;
end;
end;
procedure TfrmMain.edSizeKeyPress(Sender: TObject; var Key: Char);
begin
if not(Key in['0'..'9',#10,#8]) then
Key :=#0;
end;
end.
[uProgress.dfm]
object frmProgress: TfrmProgress
Left = 0
Top = 0
BorderStyle = bsNone
Caption = 'frmProgress'
ClientHeight = 49
ClientWidth = 320
Color = 14399415
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = []
FormStyle = fsStayOnTop
OldCreateOrder = False
Position = poMainFormCenter
PixelsPerInch = 96
TextHeight = 13
object Label1: TLabel
Left = 8
Top = 5
Width = 105
Height = 13
Caption = 'Please Wait ...'
Font.Charset = DEFAULT_CHARSET
Font.Color = clWindowText
Font.Height = -11
Font.Name = 'Tahoma'
Font.Style = [fsBold]
ParentFont = False
end
object pbProses: TProgressBar
Left = 8
Top = 24
Width = 304
Height = 17
TabOrder = 0
end
end
[uProgress.pas]
unit uProgress;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ComCtrls;
type
TfrmProgress = class(TForm)
pbProses: TProgressBar;
Label1: TLabel;
private
{ Private declarations }
public
{ Public declarations }
end;
var
frmProgress: TfrmProgress;
implementation
{$R .dfm}
end.
klo masih males "kopi-paste" (ckk..ckk...ckk) ya udah download DisiniLast Articles
Recent Topic
- PascalTalk #6: (Podcast) Kuliah IT di luar negeri, susah gak sih?
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #5: UX: Research, Design and Engineer
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #4: Obrolan Ringan Seputar IT
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #2: Membuat Sendiri SMART HOME
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #3: RADically Fast and Easy Mobile Apps Development with Delphi
by LuriDarmawan in Tutorial & Community Project more 3 years ago - PascalTalk #1: Pemanfaatan Artificial Intelligence di Masa Covid-19
by LuriDarmawan in Tutorial & Community Project more 3 years ago - Tempat Latihan Posting
by LuriDarmawan in OOT more 4 years ago - Archive
- Looping lagi...
by idhiel in Hal umum tentang Pascal Indonesia more 11 years ago - [ask] koneksi ke ODBC user Dsn saat runtime dengan ado
by halimanh in FireBird more 11 years ago - Validasi menggunakan data tanggal
by mas_kofa in Hal umum tentang Pascal Indonesia more 11 years ago