Hola ecfisa...el programa está hecho con Lazarus, es un programa portable. Está corriendo sobre Windows XP y no se porque motivo dejó de funcionar... el código interno es este:
Código Delphi
[-]
unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Paszlib, ShellApi, Process, Windows, Zipper, FileUtil, Forms, Controls,
Graphics, Dialogs, StdCtrls;
type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Label1: TLabel;
OpenDialog1: TOpenDialog;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure Label1Click(Sender: TObject);
private
public
end;
var
Form1: TForm1;
implementation
{$R *.lfm}
procedure descomprimir(const origen:string; const destino:string);
var
UnZipper: TUnZipper;
begin
UnZipper:=TUnZipper.Create;
try
UnZipper.FileName:=origen;
UnZipper.OutputPath:=destino;
UnZipper.Examine;
UnZipper.UnZipAllFiles;
finally
UnZipper.Free;
end;
end;
procedure crearcarpeta(var dircarpeta:string);
begin
MkDir('C:\carpeta ZIP');
dircarpeta:='C:\carpeta ZIP';
end;
procedure crearfile(var D:string);
var
f:textfile;
begin
D:=D+'\convertir.bat';
Assign(f, D);
rewrite(f);
write(f, 'ren *.dbf *.tmp');
close(f);
end;
procedure copiarfiles(sourceFolder, targetFolder: string);
const
FOF_NORECURSION = $1000;
var
SHFOS: SHFILEOPSTRUCT;
begin
sourceFolder:= IncludeTrailingPathDelimiter(sourceFolder)+'\*.*';
targetFolder := ExcludeTrailingPathDelimiter(targetFolder);
ZeroMemory(@SHFOS, SizeOf(SHFOS));
SHFOS.wFunc:= FO_COPY;
SHFOS.fFlags:= FOF_FILESONLY or FOF_NORECURSION;
SHFOS.hNameMappings:= nil;
SHFOS.pFrom:= PChar(sourceFolder+#0+#0);
SHFOS.pTo:= PChar(targetFolder+#0+#0);
SHFileOperation(SHFOS);
end;
function DelDir(dir: string): Boolean;
var
fos: TSHFileOpStruct;
begin
ZeroMemory(@fos, SizeOf(fos));
with fos do
begin
wFunc := FO_DELETE;
fFlags := FOF_SILENT or FOF_NOCONFIRMATION;
pFrom := PChar(dir + #0);
end;
Result := (0 = ShFileOperation(fos));
end;
procedure TForm1.Button1Click(Sender: TObject);
var
dirorigen, dirdestino,diror,dirdes,borrardir:string;
begin
dirorigen:='';diror:='';dirdes:='';
dirdestino:='';
dirdestino:=IncludeTrailingPathDelimiter('C:\Windows');
dirorigen:='C:\Windows';
if OpenDialog1.Execute then
begin
dirorigen:=IncludeTrailingPathDelimiter(OpenDialog1.FileName);
delete(dirorigen, length(dirorigen), 1); crearcarpeta(dirdestino);
descomprimir(dirorigen,dirdestino);
end;
borrardir:=dirdestino;
dirdestino:=dirdestino+'\tmp';
diror:=dirdestino;
if SetCurrentDir(dirdestino) then
begin
crearfile(dirdestino);
ExecuteProcess(dirdestino,'');
Showmessage('Los archivos se han renombrado exitosamente');
DeleteFile(Pchar(dirdestino));
dirdes:='C:\ASYS\HONORARI\BASES';
Copiarfiles(diror,dirdes);
end;
if DelDir(borrardir) then
showmessage('Los archivos se han añadido correctamente');
end;
procedure TForm1.Button2Click(Sender: TObject);
begin
Application.Terminate;
end;
procedure TForm1.Label1Click(Sender: TObject);
begin
end;
end.