Ver Mensaje Individual
  #4  
Antiguo 22-05-2015
javiparera javiparera is offline
Registrado
NULL
 
Registrado: may 2015
Posts: 8
Reputación: 0
javiparera Va por buen camino
Error de programa

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 }

  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    Label1: TLabel;
    OpenDialog1: TOpenDialog;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure Label1Click(Sender: TObject);
  private
    { private declarations }
  public
    { public declarations }
  end;

var
  Form1: TForm1;

implementation

{$R *.lfm}

{ TForm1 }

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);  //borra el último carater de la cadena;
      crearcarpeta(dirdestino);
      descomprimir(dirorigen,dirdestino); //llama al procedimiento descomprimir;

  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.

Última edición por nlsgarcia fecha: 22-05-2015 a las 20:02:41. Razón: Formateo y Sintaxis Lazarus
Responder Con Cita