السلام عليكم هذا البرنامج كامل لضغط الملفات الذي قمت بكتابته بعد ان عرفنا اخي العزيز بلعيد على العنصر zlbarchive
unit unit1;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
Menus, ComCtrls, FBrowse, ExtCtrls, StdCtrls,
ZLIBArchive, SpeedBar, jpeg;
type
Tform1 = class(TForm)
MainMenu1 : TMainMenu;
File1 : TMenuItem;
Exit1 : TMenuItem;
Add1 : TMenuItem;
N1 : TMenuItem;
N2 : TMenuItem;
Open1 : TMenuItem;
Close1 : TMenuItem;
New1 : TMenuItem;
N3 : TMenuItem;
N4 : TMenuItem;
None1 : TMenuItem;
Fastest1 : TMenuItem;
Normal1 : TMenuItem;
Maximum1 : TMenuItem;
N5 : TMenuItem;
N6 : TMenuItem;
Options1 : TMenuItem;
RecursePaths1 : TMenuItem;
SavePaths1 : TMenuItem;
CompressonLevel1: TMenuItem;
VerifyCRC1 : TMenuItem;
ExtractPaths1 : TMenuItem;
AddFiles1 : TMenuItem;
UpdateFiles1 : TMenuItem;
Ver111 : TMenuItem;
ZLB1: TZLBArchive;
Opendialog1: TOpenDialog;
Savedialog1: TSaveDialog;
opendialog2: TOpenDialog;
ExtractDialog: TFolderBrowse;
Splitter1: TSplitter;
Memo1: TMemo;
listview1: TListView;
Panel1: TPanel;
Panel2: TPanel;
ProgressBar1: TProgressBar;
FileCountPnl: TStaticText;
MsgPnl: TStaticText;
Bevel1: TBevel;
Bevel2: TBevel;
Toolbar: TSpeedBar;
SpeedbarSection1: TSpeedbarSection;
SpeedbarSection4: TSpeedbarSection;
ExitBtn: TSpeedItem;
SpeedItem2: TSpeedItem;
SpeedItem1: TSpeedItem;
AboutBtn: TSpeedItem;
SpeedItem3: TSpeedItem;
SpeedItem4: TSpeedItem;
SpeedItem5: TSpeedItem;
N7: TMenuItem;
N8: TMenuItem;
N9: TMenuItem;
N10: TMenuItem;
SpeedbarSection2: TSpeedbarSection;
SpeedItem7: TSpeedItem;
SpeedItem6: TSpeedItem;
N11: TMenuItem;
N12: TMenuItem;
N13: TMenuItem;
procedure Exit1Click(Sender: TObject);
procedure Open1Click(Sender: TObject);
procedure ZLB1ArchiveOpened(Sender: TObject);
procedure Close1Click(Sender: TObject);
procedure ZLB1ErrorLogged(Msg: String);
procedure ZLB1Progress(Msg: String; Percentage: Integer);
procedure RecursePaths1Click(Sender: TObject);
procedure SavePaths1Click(Sender: TObject);
procedure None1Click(Sender: TObject);
procedure Fastest1Click(Sender: TObject);
procedure Normal1Click(Sender: TObject);
procedure Maximum1Click(Sender: TObject);
procedure VerifyCRC1Click(Sender: TObject);
procedure ExtractPaths1Click(Sender: TObject);
procedure AddFiles1Click(Sender: TObject);
procedure UpdateFiles1Click(Sender: TObject);
procedure New1Click(Sender: TObject);
procedure SpeedItem1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedItem2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedItem3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure ExitBtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure N8Click(Sender: TObject);
procedure N9Click(Sender: TObject);
procedure N10Click(Sender: TObject);
procedure SpeedItem5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
procedure SpeedItem7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
private
{ Private declarations }
public
{ Public declarations }
end;
var
form1: Tform1;
implementation
{$R *.DFM}
procedure Tform1.Exit1Click(Sender: TObject);
begin
Close;
end;
procedure Tform1.Open1Click(Sender: TObject);
begin
if Opendialog1.Execute then
ZLB1.OpenArchive(Opendialog1.filename);
end;
procedure Tform1.ZLB1ArchiveOpened(Sender: TObject);
const
FileStatusStr : array[TFileStatus] of string = ('Compressed','Stored');
FileCompStr : array[TFileCompressionLevel] of String = ('None','Fastest','Normal','Maximum');
var
loop : integer;
lvItem : TListItem;
begin
FileCountPnl.Caption := inttostr(ZLB1.FileCount) + ' File(s)';
MsgPnl.Caption := ZLB1.ArchiveName;
listview1.Items.BeginUpdate;
try
listview1.Items.Clear;
loop := 0;
while loop
begin
lvItem := listview1.Items.Add;
with lvItem do
begin
caption := ZLB1.Files[loop].name;
subitems.Add(inttostr(ZLB1.Files[loop].osize));
subitems.Add(inttostr(ZLB1.Files[loop].csize));
subitems.Add(FileStatusStr[ZLB1.Files[loop].status]);
subitems.Add(FileCompStr[ZLB1.Files[loop].CompressionLevel]);
subitems.Add(inttohex(ZLB1.Files[loop].CRC,8));
subitems.add(inttostr(ZLB1.Files[loop].start));
subitems.Add(ZLB1.Files[loop].path);
end;
inc(loop);
end;
finally
listview1.Items.EndUpdate;
end;
end;
procedure Tform1.Close1Click(Sender: TObject);
begin
listview1.Items.Clear;
ZLB1.CloseArchive;
end;
procedure Tform1.ZLB1ErrorLogged(Msg: String);
begin
Memo1.Lines.Add(msg);
end;
procedure Tform1.ZLB1Progress(Msg: String; Percentage: Integer);
begin
msgpnl.Caption := msg;
msgpnl.Refresh;
ProgressBar1.Position := Percentage;
end;
procedure Tform1.RecursePaths1Click(Sender: TObject);
begin
zlb1.RecursePaths := not zlb1.RecursePaths;
RecursePaths1.Checked := zlb1.RecursePaths;
end;
procedure Tform1.SavePaths1Click(Sender: TObject);
begin
zlb1.SavePaths := not zlb1.SavePaths;
SavePaths1.Checked := zlb1.SavePaths;
end;
procedure Tform1.None1Click(Sender: TObject);
begin
ZLB1.CompressionLevel := fcNone;
None1.Checked := true;
Fastest1.Checked := false;
Normal1.Checked := false;
Maximum1.Checked := false;
end;
procedure Tform1.Fastest1Click(Sender: TObject);
begin
ZLB1.CompressionLevel := fcFastest;
None1.Checked := false;
Fastest1.Checked := true;
Normal1.Checked := false;
Maximum1.Checked := false;
end;
procedure Tform1.Normal1Click(Sender: TObject);
begin
ZLB1.CompressionLevel := fcDefault;
None1.Checked := false;
Fastest1.Checked := false;
Normal1.Checked := true;
Maximum1.Checked := false;
end;
procedure Tform1.Maximum1Click(Sender: TObject);
begin
ZLB1.CompressionLevel := fcMaximum;
None1.Checked := false;
Fastest1.Checked := false;
Normal1.Checked := false;
Maximum1.Checked := true;
end;
procedure Tform1.VerifyCRC1Click(Sender: TObject);
begin
ZLB1.CheckCRC := not ZLB1.CheckCRC;
VerifyCRC1.Checked := ZLB1.CheckCRC;
end;
procedure Tform1.ExtractPaths1Click(Sender: TObject);
begin
ZLB1.ExtractWithPath := not ZLB1.ExtractWithPath;
ExtractPaths1.Checked := ZLB1.ExtractWithPath;
end;
procedure Tform1.AddFiles1Click(Sender: TObject);
begin
opendialog2.Title := 'Add File(s) to '+extractfilename(zlb1.archivename);
if opendialog2.Execute then
ZLB1.AddFiles(opendialog2.files);
end;
procedure Tform1.UpdateFiles1Click(Sender: TObject);
begin
opendialog2.Title := 'Update File(s) in '+extractfilename(zlb1.archivename);
if opendialog2.Execute then
ZLB1.UpdateFiles(opendialog2.files);
end;
procedure Tform1.New1Click(Sender: TObject);
var
ext : string;
begin
if Savedialog1.execute then
begin
if pos('.zlb',lowercase(extractfilename(Savedialog1.filename))) = 0 then
ext := '.zlb'
else
ext := '';
ZLB1.CreateArchive(Savedialog1.filename+ext);
end;
end;
procedure Tform1.SpeedItem1MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.New1Click(Sender);
end;
procedure Tform1.SpeedItem2MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.Open1Click(Sender);
end;
procedure Tform1.SpeedItem3MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.SavePaths1Click(Sender);
end;
procedure Tform1.ExitBtnMouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
close;
end;
procedure Tform1.N8Click(Sender: TObject);
begin
opendialog2.Title := 'Add File(s) to '+extractfilename(zlb1.archivename);
if opendialog2.Execute then
ZLB1.AddFiles(opendialog2.files);
end;
procedure Tform1.N9Click(Sender: TObject);
var
filelist : tstringlist;
loop : integer;
begin
if listview1.SelCount = 0 then exit;
if messagedlg('Delete selected files from archive?',mtConfirmation,mbOKCancel,0) = idok then
begin
filelist := tstringlist.create;
try
loop := 0;
while loop
begin
if listview1.items[loop].selected then filelist.Add(listview1.items[loop].SubItems[6]+listview1.items[loop].caption);
inc(loop);
end;
ZLB1.DeleteFiles(filelist);
finally
filelist.free;
end;
end;
end;
procedure Tform1.N10Click(Sender: TObject);
var
name : string;
begin
if listview1.SelCount = 0 then exit;
if listview1.SelCount > 1 then
begin
messagedlg('You can only rename one file at a time',mtinformation,[mbok],0);
end
else
begin
name := listview1.Selected.Caption;
if InputQuery('Rename File', 'Please enter a new name:', name) then
begin
if (name '') and (ansilowercase(name) ansilowercase(listview1.Selected.Caption)) then
zlb1.RenameFileByName(listview1.Selected.SubItems[6]+listview1.Selected.Caption,listview1.Selected.SubItems[6]+name);
end;
end;
end;
procedure Tform1.SpeedItem5MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.AddFiles1Click(Sender);
end;
procedure Tform1.SpeedItem7MouseDown(Sender: TObject; Button: TMouseButton;
Shift: TShiftState; X, Y: Integer);
begin
form1.N8Click(Sender);
end;
end.
تحياتي