[Tutorial/Delphi] - Packer (Compactor) de arquivos.

[sumonee 0]

Olá, WC, depois de MUITOS me enxerem o saco no msn eu vou voltar a postar algumas coisas úteis aqui na WC agora, então aproveitem esse Packer :rs:

 

Indice

 

• Requisitos
  
• Começando
  
• Códigos
  
• Entendendo o código

-----------------------------------------------------------------------------------

 

Requisitos

 

• Não copiar e colar os códigos.
  
• Procurar ao MÁXIMO entender o tópico.
  
• Conhecimento intermediário em Delphi.
  
• raise exeception.create('NUNCA rippar nada.');

 

 

Começando

 

• Abra um novo projeto no delphi normalmente.
  
• Vá até ao Pascal Editor (Unit) e na seção "Uses" declare: "zLib" & "FileCtrl" (Sem aspas)
  
• declare essas variáveis globais abaixo de "Form1: TForm1"
   
  FileIni, FileOut: TFileStream;
  Zip: TCompressionStream;
  Dir: string;
  ProgressBarStyle: integer;
   
  
• Cole em sua form:
  object lblArquivo: TLabel
  Left = 8
  Top = 8
  Width = 43
  Height = 14
  Caption = 'Arquivo'
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Arial'
  Font.Style = [fsBold]
  ParentFont = False
  end
  object BtnArquivo: TSpeedButton
  Left = 424
  Top = 23
  Width = 23
  Height = 22
  Caption = '...'
  OnClick = BtnArquivoClick
  end
  object lblSalvar: TLabel
  Left = 8
  Top = 56
  Width = 53
  Height = 14
  Caption = 'Salvar Em'
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Arial'
  Font.Style = [fsBold]
  ParentFont = False
  end
  object BtnLocal: TSpeedButton
  Left = 424
  Top = 70
  Width = 23
  Height = 22
  Caption = '...'
  OnClick = BtnLocalClick
  end
  object lblNovoTamanho: TLabel
  Left = 8
  Top = 144
  Width = 80
  Height = 14
  Caption = 'Novo Tamanho'
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Arial'
  Font.Style = [fsBold]
  ParentFont = False
  end
  object lblTamanhoAtual: TLabel
  Left = 8
  Top = 104
  Width = 116
  Height = 14
  Caption = 'Tamanho do Arquivo:'
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Arial'
  Font.Style = [fsBold]
  ParentFont = False
  end
  object lblTamanhoAtual1: TLabel
  Left = 24
  Top = 120
  Width = 25
  Height = 14
  Caption = '0 MB'
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Arial'
  Font.Style = [fsItalic]
  ParentFont = False
  end
  object lblNovoTamanho1: TLabel
  Left = 24
  Top = 160
  Width = 25
  Height = 14
  Caption = '0 MB'
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Arial'
  Font.Style = [fsItalic]
  ParentFont = False
  end
  object Bevel1: TBevel
  Left = -1
  Top = 100
  Width = 455
  Height = 2
  end
  object EditArquivo: TEdit
  Left = 8
  Top = 24
  Width = 409
  Height = 21
  ReadOnly = True
  TabOrder = 0
  end
  object EditSalvar: TEdit
  Left = 8
  Top = 72
  Width = 409
  Height = 21
  ReadOnly = True
  TabOrder = 1
  end
  object Progresso: TProgressBar
  Left = 176
  Top = 120
  Width = 129
  Height = 17
  TabOrder = 2
  end
  object StatusBar: TStatusBar
  Left = 0
  Top = 185
  Width = 453
  Height = 20
  Panels = <
  item
  Width = 320
  end
  item
  Style = psOwnerDraw
  Width = 500
  end>
  OnDrawPanel = StatusBarDrawPanel
  end
  object BtnCompactar: TButton
  Left = 372
  Top = 154
  Width = 75
  Height = 25
  Caption = 'Compactar'
  TabOrder = 4
  OnClick = BtnCompactarClick
  end
  object OS: TXPManifest
  end
  object DialogArquivo: TOpenDialog
  Filter =
  'Execut'#225'veis (*.exe)|*.exe|Extens'#245'es de Aplicativos (*.dll)|*.dll' +
  '|Controle ActiveX (*.ocx)|*.ocx|Arquivos do WinRAR (*.rar)|*.rar' +
  '|Arquivos do WinZIP (*.zip)|*.zip|Todos os Arquivos (*.*)|*.*'
  Title = 'Selecione um arquivo '#224' ser comprimido...'
  Left = 32
  end
   
   
  
• Adicione a Function abaixo de {$R *.dfm}
   
  function FormatByteSize(const bytes: Longint): string;
  const
  B = 1;
  KB = 1024 * B;
  MB = 1024 * KB;
  GB = 1024 * MB;
  begin
  if bytes > GB then
  result := FormatFloat('#.## GB', bytes / GB)
  else
  if bytes > MB then
  result := FormatFloat('#.## MB', bytes / MB)
  else
  if bytes > KB then
  result := FormatFloat('#.## KB', bytes / KB)
  else
  result := FormatFloat('#.## Byte(s)', bytes) ;
  end;
   
  
• Pronto, já podemos começar a codar!
  

 

Códigos

 

# OnClick BtnArquivo #

 

 

var

Arq: TSearchRec;

begin

DialogArquivo.Execute;

EditArquivo.Text:= ExtractFileName(DialogArquivo.FileName);

 

Arq.Name:= DialogArquivo.FileName;

lblTamanhoAtual1.Caption:= FormatByteSize(Arq.Size);

end;

 

 

# OnClick BtnLocal #

 

 

Dir:= '';

SelectDirectory('Selecione a Pasta','',Dir);

EditSalvar.Text:= Dir;

 

 

# OnClick BtnCompactar #

 

 

var

Fim: TSearchRec;

begin

FileIni:=TFileStream.Create(DialogArquivo.FileName, fmOpenRead and fmShareExclusive);

FileOut:=TFileStream.Create(EditSalvar.Text+'\'+EditArquivo.Text, fmCreate or fmShareExclusive);

try

Zip:=TCompressionStream.Create(clMax, FileOut);

Zip.CopyFrom(FileIni, FileIni.Size);

Progresso.Position:= Zip.Position;

Fim.Name:= EditSalvar.Text+EditArquivo.Name;

lblNovoTamanho1.Caption:= FormatByteSize(Fim.Size);

finally

Zip.Free;

FileOut.Free;

FileIni.Free;

end;

 

 

# OnDrawPanel StatusBar #

 

 

if Panel = StatusBar.Panels[1] then

with Progresso do

begin

Top := Rect.Top;

Left := Rect.Left;

Width := Rect.Right - Rect.Left - 2;

Height := Rect.Bottom - Rect.Top;

end;

 

 

# OnCreate MainForm #

 

 

StatusBar.Panels[1].Style := psOwnerDraw;

Progresso.Parent := StatusBar;

ProgressBarStyle := GetWindowLong(Progresso.Handle,GWL_EXSTYLE);

ProgressBarStyle := ProgressBarStyle - WS_EX_STATICEDGE;

SetWindowLong(Progresso.Handle, GWL_EXSTYLE, ProgressBarStyle);

 

 

Entendendo os Códigos

 

Variáveis Globais: Servem para não precisar ficar declarando em cada evento de alguma coisa o "var variavel: tipo;".

zLib: É uma Unit específica para esse tipo aplicativo. (Compress/Uncompress).

Função TSearchRec: Pode ser retirado se modificar um pouco, porém eu coloquei para verificar o tamanho do arquivo.

Eventos OnCreate & OnDrawPanel: Servem para alinhas a ProgressBar no Painel 1 da StatusBar.

FileCtrl: Serve para o "SelectDirectory" funcionar.

----------------------------------------------------------------------------------

 

Bom, é isso, se você não entendeu ou tem alguma dúvida RELACIONADA ao tópico, apenas pergunte aqui mesmo que eu vou responder.

Créditos: Zaphey por enxer o saco pra eu ensinar...

 

(Tópico, Codes, Método TOTALMENTE meus).

 

 

NOTA: Se você for esperto o suficiente, você vai ver que é possível se criar uma espécie de WinRAR porém com a extensão que você quiser (.000 , .lll , .sky).

[l-XMarceloX-l 1]

fiz um codigo parecido esses dias para 1 sistema de backup *-* Gostei belo topico sumonee!!

[sumonee 0]

fiz um codigo parecido esses dias para 1 sistema de backup *-* Gostei belo topico sumonee!! [/size][/color]

 

Obrigado, mais tarde eu posto como fazer o inverso, Unpacker ;)

[Zaphey 2]

EAUEAHEUEHAUHEUHEAUHEAHUE'

Eu nem enche o saco, só pedi uma vez =) RAIRIARIRAIRAAR

Obrigado mesmo manolo do meu S2

Sabe que te amo né Miranda?

 

Abraços!