Arsip: File Splitter 1.0 - OpenSource I


by n3o_cybertech in TipDanTrik more 11 years ago 1980
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] 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 Disini
Local Business Directory, Search Engine Submission & SEO Tools FreeWebSubmission.com SonicRun.com