marianzo ha scritto:
Scusa +m2+
come creare un file compresso zip con una serie di fatture elettroniche in delphi. E' possibile un'aiutino
Grazie Marianzo
Qui c'è più o meno tutto, a parte funzioni di contorno.
La logica è
- controlla la presenza di 7z.exe e 7z.dll nella stessa cartella del programma
- se non ci sono, scaricali da internet (ho tolto il codice, c'è URL del mio sito, evitiamo cazziatoni per pubblicità)
program tpresso;
{$APPTYPE CONSOLE}
uses
ExceptionLog,
shellapi,
windows,
SysUtils;
function prendiDimensioneFile(i_nomefile:string):int64;
/// questa funzione ritorna int64, non int32
var
SearchRec : TSearchRec;
begin
if FindFirst(i_nomefile, faAnyFile, SearchRec ) = 0 then
Result := Int64(SearchRec.FindData.nFileSizeHigh) shl Int64(32) +
Int64(SearchREc.FindData.nFileSizeLow)
else
Result := 0;
sysutils.FindClose(SearchRec);
end;
procedure logganow(i_stringa:string);
/// qui c'è la funzione di logging, in questo caso tenuto al minimo
begin
writeln(i_stringa);
end;
function WaitExecute(i_executefile:string;i_parametri:string;i_flagEsecuzione:cardinal):integer;
/// esegue un programma ed aspetta che termini (con busy waiting). Triste, ma pazienza
var
SEInfo: TShellExecuteInfo;
ExitCode: DWORD;
begin
Result:=0;
if i_executefile='' then
begin
logganow('Errore 25 i_executefile vuoto');
Exit;
end;
if not FileExists(i_executefile) then
begin
logganow('Errore 24 non esiste i_executefile '+i_executefile);
exit;
end;
FillChar(SEInfo, SizeOf(SEInfo), 0) ;
SEInfo.cbSize := SizeOf(TShellExecuteInfo) ;
with SEInfo do
begin
fMask := SEE_MASK_NOCLOSEPROCESS;
lpFile := PChar(i_ExecuteFile) ;
lpParameters:=pchar(i_parametri);
nShow := i_flagEsecuzione;
end;
if ShellExecuteEx(@SEInfo) then
begin
repeat
GetExitCodeProcess(SEInfo.hProcess, ExitCode) ;
until (ExitCode <> STILL_ACTIVE);
end
else
logganow('Errore 50 avviando '+i_executefile);
result:=ExitCode;
end;
function prendiEstensione(i_nomefile:string):string;
/// torna estensione del file
/// anche nel caso di estensioni multiple.
var
i:integer;
punto:integer;
begin
Result:='';
if i_nomefile='' then
exit;
i_nomefile:=extractfilename(i_nomefile);
punto:=pos('.',i_nomefile);
if punto=0 then
exit;
punto:=length(i_nomefile);
while (i_nomefile[punto]<>'.') and (punto>1) do
dec(punto);
if punto=0 then
exit;
result:='';
for i:=punto+1 to length(i_nomefile) do
result:=result+i_nomefile[i];
end;
function isEstensione(i_nomefile:string;i_estensione:string):boolean;
/// verifica semplicemente estensione con confronto case-insensitive
begin
result:=false;
if i_nomefile='' then Exit;
if i_estensione='' then Exit;
Result:=UpperCase(prendiEstensione(i_nomefile))=UpperCase(i_estensione);
end;
function saggiaScrivibilitaCartella(i_cartella:string):boolean;
/// questa funzione controlla che la cartella passata esista,
/// e se non esiste la crea. controlla inoltre che sia scrivibile,
/// cioè che possa scriverci dentro un piccolo file di test
/// è una verifica per intercettare cartelle sola lettura, privilegi
/// insufficienti eccetera.
var
f: textfile;
begin
result:=false;
if i_cartella='' then exit;
try
if not directoryexists(i_cartella) then
forcedirectories(i_cartella);
except
Exit;
end;
try
if not directoryexists(i_cartella) then
exit;
except
Exit;
end;
i_cartella:=includetrailingbackslash(i_cartella)+'knb-file_di_prova.txt';
try
assignFile(f,i_cartella);
rewrite(f);
writeln(f,'Prova (questo file può essere cancellato senza rischi');
CloseFIle(f);
deletefile(pchar(i_cartella));
result:=true;
except
end;
end;
function saggiascrivibilitafile(i_nomefile:string;i_flagsilente:boolean=false):boolean;
/// in questo caso voglio controllare di poter scrivere un
/// certo file. provo scrivendone uno di test
/// nel contempo mi creo anche le eventuali sottocartelle
begin
result:=false;
if i_nomefile='' then
begin
if not i_flagsilente then
logganow('Errore 2799 nomefile vuoto');
exit;
end;
i_nomefile:=lowercase(i_nomefile);
if extractfilepath(i_nomefile)=extractfilename(i_nomefile) then
begin
if not i_flagsilente then
logganow('Errore 2806 invece di un file passata una cartella');
exit;
end;
result:=saggiascrivibilitacartella(extractfilepath(i_nomefile));
if not i_flagsilente then
if not result then
logganow('Impossibile scrivere nella cartella di '+i_nomefile);
end;
function g_verificascaricafile(i_nomefile:string):boolean;
begin
/// in realtà scarica da internet i file qualora mancanti.
/// in questo caso taglio, perchè ci sarebbe URL del mio sito
/// in sostanza se il file non esiste scaricatelo dal tuo sito
result:=True;
end;
function g_opera7z(i_listafile:string;i_filecompresso:string;i_comando:string;i_cartellatemp:string='';i_flagvisibile:cardinal=SW_HIDE):boolean;
/// ho reso la funzione più verbosa del normale, ovviamente si può
/// ridurre. attenzione a /// ove ci sono le porzioni per riga di comando
var
inizio:tdatetime;
///cursore:tcursor;
compressore:string;
dll:string;
s:string;
function g_virgoletteelencofile(i_stringa:string):string;
/// questa altra funzione triste, ma serve per gli spazi all'interno
/// dell'elenco dei file. non molto raffinata, ma sono pigro
begin
Result:='';
if i_stringa='' then exit;
i_stringa:='"'+i_stringa+'"';
result:=StringReplace(i_stringa,' ','" "',[rfreplaceall]);
end;
begin
result:=false;
if i_listafile='' then
begin
logganow('Errore 4448 i_listafile vuota');
exit;
end;
if i_comando='' then
begin
logganow('Errore 4462 i_comando vuoto');
Exit;
end;
if i_filecompresso='' then
begin
logganow('Errore 4453 i_filecompresso vuoto');
exit;
end;
if (not isEstensione(i_filecompresso,'zip')) and (not isEstensione(i_filecompresso,'7z')) then
begin
logganow('Errore 4458 i_filecompresso non ha estensione zip o 7z');
Exit;
end;
if not saggiascrivibilitafile(i_filecompresso) then
begin
logganow('Errore 4476 non posso saggiare '+i_filecompresso);
Exit;
end;
if i_cartellatemp<>'' then
begin
i_cartellatemp:=IncludeTrailingBackslash(i_cartellatemp);
if not saggiaScrivibilitaCartella(i_cartellatemp) then
begin
logganow('Errore 334 non posso saggiare cartella temp '+i_cartellatemp);
Exit;
end;
end;
compressore:=includetrailingbackslash(ExtractFilePath(ParamStr(0)))+'7z.exe';
dll:=includetrailingbackslash(ExtractFilePath(ParamStr(0)))+'7z.dll';
///compressore:=includetrailingbackslash(ExtractFilePath(Application.exename))+'7z.exe';
///dll:=includetrailingbackslash(ExtractFilePath(Application.exename))+'7z.dll';
g_verificascaricafile(compressore);
g_verificascaricafile(dll);
if not FileExists(compressore) then
begin
logganow('Errore 527 non esiste '+compressore);
Exit;
end;
if not FileExists(dll) then
begin
logganow('Errore 528 non esiste '+dll);
Exit;
end;
if not fileexists(compressore) then
begin
logganow('ERRORE compressore non trovato');
exit;
end;
///application.processmessages;
inizio:=now;
///cursore:=screen.cursor;
///screen.cursor:=crhourglass;
logganow('Inizio compressione molti file esterno. Attendere senza fare nulla!');
///application.processmessages;
try
logganow('Elenco file '+i_listafile);
i_listafile:=g_virgoletteelencofile(i_listafile);
logganow('Elenco file virgolette '+i_listafile);
s:=i_comando+' "'+i_filecompresso+'" '+i_listafile;
if i_cartellatemp<>'' then
s:=s+' -w"'+i_cartellatemp+'"';
logganow('Lancio compressore esterno '+compressore+' '+s);
///application.processmessages;
WaitExecute(compressore,s,i_flagvisibile);
logganow('Ritornato da compressore esterno');
///application.processmessages;
except
on e:exception do
begin
logganow('Eccezione 4515 |'+s+'| '+e.Message);
end;
end;
///screen.cursor:=cursore;
result:=prendidimensionefile(i_filecompresso)>10;
if result then
logganow('7z esterno OK '+TimeToStr(now-inizio))
else
logganow('ERRORE 7z file esterno');
end;
function g_comprimi7z(i_listafile:string;i_filecompresso:string;i_password:string='';i_cartellatemp:string='';i_flagvisibile:cardinal=SW_HIDE):boolean;
var
s:string;
begin
s:='';
if i_password<>'' then
s:='-p'+i_password;
Result:=g_opera7z(i_listafile,i_filecompresso,'a '+s,i_cartellatemp,i_flagvisibile);
end;
function g_estrai7z(i_listafile:string;i_filecompresso:string;i_cartellaoutput:string;i_password:string='';i_cartellatemp:string='';i_flagvisibile:cardinal=SW_HIDE):boolean;
var
s:string;
begin
s:='';
if i_password<>'' then
s:='-p'+i_password;
Result:=g_opera7z(i_listafile,i_filecompresso,'x -y '+s+' -o"'+i_cartellaoutput+'"',i_cartellatemp,i_flagvisibile);
end;
begin
{ TODO -oUser -cConsole Main : Insert code here }
/// aggiungo a z:\filecompresso.zip tutti i file c:\*.eml e c:\*.xml
/// non faccio cose particolari un semplice a con opzioni di default
/// notare ultimo parametro: è la cartella temp utilizzata.
/// serve nel caso si operi con file davvero grandi e si necessiti di più spazio
/// di temp. Usualmente elaborando qualche centinaio di GB di email
g_opera7z('c:\*.eml c:\*.xml','z:\filecompresso.zip','a','z:\cartellona\temp');
/// in questo caso creo banalmente un file zip, con dentro un singolo file
g_opera7z('c:\1.pdf','z:\filecompresso.zip','a');
/// adesso estraggo un singolo file, forzando con -y la sovrascrittura
/// siccome l'opzione di default è NON MOSTRARE la finestra di 7z, tipicamente la consiglio
g_opera7z('1.pdf','z:\filecompresso.zip','x -y -o"z:\extracto"');
/// questo è un caso diverso: oltre alla certella TEMP impostata manualmente, c'è
/// SW_NORMAL e manca -y. In sostanza se trova un file già presente in estrazione, si blocca
/// aspettando che si decida cosa fare (sovrascrivi, ferma eccetera)
/// chiaramente nel mondo "normale" userò -y
g_opera7z('1.pdf','z:\filecompresso.zip','x -o"z:\extracto"','z:\tantibeitemp',SW_NORMAL);
/// un paio di funzioni semplificate, con inserimento di password
g_comprimi7z('c:\*.pdf','z:\provona.7z','lamiapassword');
g_estrai7z('*.*','z:\provona.7z','z:\messiqui','lamiapassword');
/// come sopra, ma senza password. diciamo il minimo sindacale
g_comprimi7z('c:\*.pdf','z:\nopassword.7z');
g_estrai7z('*.*','z:\nopassword.7z','z:\estrattinopassword');
end.
In alternativa c'è il componente ZipForge, che non richiede 7z e 7z.dll.
http://www.componentace.com/zip_component_zip_delphi_zipforge.htm
Personalmente lo uso, talvolta, e talvolta no.
7z è più veloce e consente di gestire quantità smisurate di file (100.000+ per singolo file, senza rallentamenti).
Se per te è importante non avere questi due file... scaricatelo