 |
ActiveDelphi
.: O site do programador Delphi! :.
|
| Exibir mensagem anterior :: Exibir próxima mensagem |
| Autor |
Mensagem |
Zerocalt
Novato
Registrado: Sábado, 12 de Mai de 2007
Mensagens: 13
|
 Enviada: Qua Mai 16, 2007 1:44 pm Assunto: Backup sem Componente Externos. Help-me |
 |
|
Estou utilizando o Delphi 7, terminando um trabalho para faculdade, mas estou com um grande problema, consigo fazer o backup do banco de dados FireBird todo certinho, mas eu tenho uma pasta com as fotos dos clientes, o qual teria que ir no backup tb.
Lembrando que não posso usar componente externos no meu projeto, então estava tentando utilizar a biblioteca Zlib, o problema é que a mesma só compacta de um em um arquivo e não a pasta... Mas tudo bem é simples, compacta vários arquivos no mesmo arquivo, ir adicionando por uma array, mas o problema está para descompactar os arquivos...
Se alguém tiver um exemplo parecido ou outra dica, que não precise de usar componentes extras fico muito grato...
Para Comprimir:
| Código: | procedure Comprimir(FileOutName: TFileName; Files: array of TFileName);
var
FileInName: TFileName;
FileIn, FileOut: TFileStream;
Zip: TCompressionStream;
NumArquivos, I, Len, Size: Integer;
Fim: Byte;
begin
FileOut := TFileStream.Create(FileOutName, fmCreate or fmShareExclusive);
Zip := TCompressionStream.Create( clMax, FileOut);
NumArquivos := Length(Files);
Zip.Write(NumArquivos, SizeOf(Integer));
try
for I := Low(Files) to High(Files) do
begin
FileIn := TFileStream.Create(Files[I], fmOpenRead and fmShareExclusive);
try
FileInName := ExtractFileName(Files[I]);
Len := Length(FileInName);
Zip.Write(Len, SizeOf(Integer));
Zip.Write(FileInName[1], Len);
Size := FileIn.Size;
Zip.Write(Size, SizeOf(Integer));
Zip.CopyFrom(FileIn, FileIn.Size);
Fim := 0;
Zip.Write(Fim, SizeOf(Byte));
finally
FileIn.Free;
end;
end;
finally
Zip.Free;
FileOut.Free;
end;
end; |
Ao Clicar no Botão Comprimir:
| Código: | procedure TForm1.CompactarClick(Sender: TObject);
var
SR: TSearchRec;
I: integer;
Origem:String;
Arquivos : String;
begin
I := FindFirst(edit1.Text+'*.*', faAnyFile, SR);
while I = 0 do begin
if (SR.Attr and faDirectory) <> faDirectory then
begin
Origem := edit1.Text+SR.Name;
memo1.Lines.Add(origem);
Arquivos := Arquivos+',' + Quotedstr(Origem);
end;
I := FindNext(SR);
end;
Comprimir(edit2.Text, ['C:\AgendaX\Fotos\2904.bmp','C:\AgendaX\Fotos\632.bmp','C:\AgendaX\Fotos\Thumbs.db']);
//Comprimir(edit2.Text, [Arquivos]);
end; |
Problema, é para entrar um array, mas não sei quandos arquivos estarão na pasta, achei melhor jogar para um memo e do memo enviar para a função, mas não consegui... |
|
| Voltar ao Topo |
|
 |
Zerocalt
Novato
Registrado: Sábado, 12 de Mai de 2007
Mensagens: 13
|
| Enviada: Qua Mai 16, 2007 4:20 pm Assunto: |
|
|
| A função de Descompactar ainda estou tentando organizar... |
|
| Voltar ao Topo |
|
|
gilsonnrodrigues
Moderador
Registrado: Quinta-Feira, 14 de Abril de 2005
Mensagens: 9009
Localização: Governador Valadares-MG
|
| Enviada: Qua Mai 16, 2007 10:01 pm Assunto: |
|
|
vc pensou quase certo!!
mas no lugar do memo use um Tstringlist.
e mude a procedure
procedure Comprimir(FileOutName: TFileName; Files: array of TFileName);
para
| Código: |
procedure Comprimir(FileOutName: TFileName; Files : TStrings);
var
FileInName: TFileName;
FileIn, FileOut: TFileStream;
Zip: TCompressionStream;
NumArquivos, I, Len, Size: Integer;
Fim: Byte;
begin
FileOut := TFileStream.Create(FileOutName, fmCreate or fmShareExclusive);
Zip := TCompressionStream.Create( clMax, FileOut);
NumArquivos := Length(Files);
Zip.Write(NumArquivos, SizeOf(Integer));
try
for I := 0 to Files.Copunt - 1 do
begin
FileIn := TFileStream.Create(Files[I], fmOpenRead and fmShareExclusive);
try
FileInName := ExtractFileName(Files[I]);
Len := Length(FileInName);
Zip.Write(Len, SizeOf(Integer));
Zip.Write(FileInName[1], Len);
Size := FileIn.Size;
Zip.Write(Size, SizeOf(Integer));
Zip.CopyFrom(FileIn, FileIn.Size);
Fim := 0;
Zip.Write(Fim, SizeOf(Byte));
finally
FileIn.Free;
end;
end;
finally
Zip.Free;
FileOut.Free;
end;
end;
|
a descompactação ta facinha!!
amanha se nao tiver resolvido te passo pq nao tenho delhi aki em casa!!! |
|
| Voltar ao Topo |
|
|
gilsonnrodrigues
Moderador
Registrado: Quinta-Feira, 14 de Abril de 2005
Mensagens: 9009
Localização: Governador Valadares-MG
|
| Enviada: Qui Mai 17, 2007 7:17 pm Assunto: |
|
|
se ja tiver resolvido blz!!!
mas se ainda tiver precisando de ajuda te passo a rotina de descompactação!!! |
|
| Voltar ao Topo |
|
|
faccruz
Colaborador
Registrado: Terça-Feira, 20 de Julho de 2010
Mensagens: 1563
|
| Enviada: Qui Dez 30, 2010 8:13 am Assunto: |
|
|
| gilsonnrodrigues escreveu: | vc pensou quase certo!!
mas no lugar do memo use um Tstringlist.
e mude a procedure
procedure Comprimir(FileOutName: TFileName; Files: array of TFileName);
para
| Código: |
procedure Comprimir(FileOutName: TFileName; Files : TStrings);
var
FileInName: TFileName;
FileIn, FileOut: TFileStream;
Zip: TCompressionStream;
NumArquivos, I, Len, Size: Integer;
Fim: Byte;
begin
FileOut := TFileStream.Create(FileOutName, fmCreate or fmShareExclusive);
Zip := TCompressionStream.Create( clMax, FileOut);
NumArquivos := Length(Files);
Zip.Write(NumArquivos, SizeOf(Integer));
try
for I := 0 to Files.Copunt - 1 do
begin
FileIn := TFileStream.Create(Files[I], fmOpenRead and fmShareExclusive);
try
FileInName := ExtractFileName(Files[I]);
Len := Length(FileInName);
Zip.Write(Len, SizeOf(Integer));
Zip.Write(FileInName[1], Len);
Size := FileIn.Size;
Zip.Write(Size, SizeOf(Integer));
Zip.CopyFrom(FileIn, FileIn.Size);
Fim := 0;
Zip.Write(Fim, SizeOf(Byte));
finally
FileIn.Free;
end;
end;
finally
Zip.Free;
FileOut.Free;
end;
end;
|
a descompactação ta facinha!!
amanha se nao tiver resolvido te passo pq nao tenho delhi aki em casa!!! |
Moderadores, desculpa reabir esse tópico antigo, é que gostei da função e gostaria de saber se alguem possui a procedure para descompactar!
_________________
Facc System - Sistemas para Computador |
|
| Voltar ao Topo |
|
|
|
|
Enviar Mensagens Novas: Proibido.
Responder Tópicos Proibido
Editar Mensagens: Proibido.
Excluir Mensagens: Proibido.
Votar em Enquetes: Proibido.
|
|
FAQ
Pesquisar
Membros
Grupos
Registrar
Perfil
Entrar e ver Mensagens Particulares
Entrar
