Execução De Exe´s Externos Pelo Delphi

[adilsonpazzini]

Fiz uma rotina pra compactar com o Winrar , porem funciona corretamente no Windows Sevem mais não funciona no Windows XP , pelo que vi , quando ta no windows

XP , Ele não reconhece o diretorio como "Arquivos de programas" e sim como "arquiv~1" , por isso acaba nao funcionando corretamente no XP  , se alguem tiver alguma sujestao agradeço . Pelo XP . se eu fizer o teste em Diretorios com ate 8 digitos . fuciona direito , mais ao fazer em diretorios com mais de 8 digitos

ai ja da erro . se alguem puder ajudar agradesço . Adilson Pazzini.

 

 

************************** FUNCAO PRA PEGAR OS DIRETORIOS ARQUIVOS DE PROGRAMAS E DESKTOP  **************************

 

type
  TSystemPath = (Desktop, StartMenu,
    Programs, Startup, Personal, AppData,
    Fonts, SendTo, Recent, Favorites, Cache,
    Cookies, History, NetHood, PrintHood,
    Templates, LocADat, WindRoot, WindSys,
    TempPath, RootDir, ProgFiles, ComFiles,
    ConfigPath, DevicePath, MediaPath, WallPaper);

var
  livm02: Tlivm02;

implementation

uses UDMNFE, MODULO, ufrmStatus;

{$R *.dfm}


function GetSystemPath(SystemPath: TSystemPath): string;
var
  ph: PChar;
begin
  with TRegistry.Create do
    try
      RootKey := HKEY_CURRENT_USER;
      OpenKey('\Software\Microsoft\Windows\CurrentVersion\' +
        'Explorer\Shell Folders', True);
      case SystemPath of
        Desktop: Result   := ReadString('Desktop');
        StartMenu: Result := ReadString('Start Menu');
        Programs: Result  := ReadString('Programs');
        Startup: Result   := ReadString('Startup');
        Personal: Result  := ReadString('Personal');
        AppData: Result   := ReadString('AppData');
        Fonts: Result     := ReadString('Fonts');
        SendTo: Result    := ReadString('SendTo');
        Recent: Result    := ReadString('Recent');
        Favorites: Result := ReadString('Favorites');
        Cache: Result     := ReadString('Cache');
        Cookies: Result   := ReadString('Cookies');
        History: Result   := ReadString('History');
        NetHood: Result   := ReadString('NetHood');
        PrintHood: Result := ReadString('PrintHood');
        Templates: Result := ReadString('Templates');
        LocADat: Result   := ReadString('Local AppData');
        WindRoot:
          begin
            GetMem(ph, 255);
            GetWindowsDirectory(ph, 254);
            Result := Strpas(ph);
            Freemem(ph);
          end;
        WindSys:
          begin
            GetMem(ph, 255);
            GetSystemDirectory(ph, 254);
            Result := Strpas(ph);
            Freemem(ph);
          end;
        TempPath:
          begin
            GetMem(ph, 255);
            GetTempPath(254, ph);
            Result := Strpas(ph);
            Freemem(ph);
          end;
        RootDir:
          begin
            GetMem(ph, 255);
            GetSystemDirectory(ph, 254);
            Result := (Copy(Strpas(ph), 1, 2));
            Freemem(ph);
          end;
      end;
      RootKey := HKEY_LOCAL_MACHINE;
      OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion', True);
      case SystemPath of
        ProgFiles: Result := ReadString('ProgramFilesDir');
        ComFiles: Result := ReadString('CommonFilesDir');
        ConfigPath: Result := ReadString('ConfigPath');
        DevicePath: Result := ReadString('DevicePath');
        MediaPath: Result := ReadString('MediaPath');
        WallPaper: Result := ReadString('WallPaperDir');
      end;
    finally
      CloseKey;
      Free;
    end;
  if (Result <> '') and (Result[Length(Result)] <> '\') then
    Result := Result + '\';
end;

 

 

************************* FUNCAO PRA EXCUÇÃO DO COMANDO ***********************

function CreateProcessSimple_novo(cmd: string;esconde:boolean=true): boolean;
var
  SUInfo: TStartupInfo;
  ProcInfo: TProcessInformation;
begin
  FillChar(SUInfo, SizeOf(SUInfo), #0);
  SUInfo.cb      := SizeOf(SUInfo);
  SUInfo.dwFlags := STARTF_USESHOWWINDOW;
  SUInfo.wShowWindow := iif(ESCONDE,SW_HIDE,SW_SHOWNORMAL);

  Result := CreateProcess(nil,
                          PChar(cmd),
                          nil,
                          nil,
                          false,
                          CREATE_NEW_CONSOLE or
                          NORMAL_PRIORITY_CLASS,
                          nil,
                          nil,
                          SUInfo,
                          ProcInfo);

  if (Result) then
  begin
    WaitForSingleObject(ProcInfo.hProcess, INFINITE);

    CloseHandle(ProcInfo.hProcess);
    CloseHandle(ProcInfo.hThread);
  end;
end;

 

 

*********************************** FUNCAO PRA GERAR O ARQUIVO WINRAR ***************************************

procedure COMPACTA_WINRAR(NOMEDIR:String);
Var
 cmd, Arquivos , Destino : String;
 i: Integer;
begin

 if not FileExists(IncludeTrailingPathDelimiter(GetSystemPath(ProgFiles))+'winrar\winrar.exe') then
  begin
   MSGI('Arquivo ['+IncludeTrailingPathDelimiter(GetSystemPath(ProgFiles))+'winrar\winrar.exe] não Encontrado !!!');
   Abort;
  end;

   Arquivos := IncludeTrailingPathDelimiter(NOMEDIR)+'*.xml';

   Destino := IncludeTrailingPathDelimiter(NOMEDIR)+'xmlnfe.rar';
   Cmd := IncludeTrailingPathDelimiter(GetSystemPath(ProgFiles))+'winrar\winrar.exe' + ' a "' + Destino + '"' + ' ' + Arquivos;

   livm02.listbox1.Items.Add(cmd);
   
   CreateProcessSimple_novo(CMD,false);

   if not FileExists(Destino) then
     Msgi('Arquivo ['+Destino+'] não Gerado !!!');

//   WinExec( PAnsiChar(AnsiString(Cmd)), SW_HIDE);

end;

 

 

//********************* AGORA A FUNCAO PARA COMPACTAR OS ARQUIVOS **************************************************

 

begin

 

 Caminho := GetSystemPath(Desktop); //===> PEGANDO O DESKTOP como Padrao ...

 if SelectDirectory(CAMINHO, [sdAllowCreate, sdPerformCreate, sdPrompt],1000) then
 CAMINHO := IncludeTrailingPathDelimiter(CAMINHO) + CODEMP.text +'_'+ textotonum(DTI.TEXT)+'_'+ textotonum(DTF.TEXT);

 if not DirectoryExists(CAMINHO) then
  begin
   CreateDir(CAMINHO);
  end;

 

 GerarArquivosParaCompactacao; //==> funcao que envia arquivos XML pra dentro da pasta acima . pra logo abaixo ser compactada pelo winrar .
 COMPACTA_WINRAR(CAMINHO); //==> funcao pra compactar pelo Winrar ...

 

end;

 

Adilson Pazzini .

[Régys Silveira]

Eu acho desnecessário chamar o winrar para compactar, temos excelentes componentes gratuitos como por exemplo o ZipMaster (http://www.delphizip.org/) e o delphi também possui rotinas de compactação nativas a partir da versão 2010 (TCompressionStream) que utilizam ZLib que é muito bom também.

[adilsonpazzini]

Então Regys , na verdade , eu tava ate usando ele , por que o zlib compacta num formato proprio , e so da pra ser descompactado por ele mesmo , pelo menos a ultima vez q tentei utilizalo era assim , ref ao DelphiZip , vou ver se tem compatibilidade com o Lazarus , pois to tambem migrando meu sistema de Delphi pra lazarus ... mais valeuuuu

 

 

Adilson .

[Daniel Simoes]

O FPC (Lazarus) tem suporte nativo a .Zip

Procure na pagina Wikipedia do Lazarus por TZipper

[adilsonpazzini]

hum . Beleza Daniel . vou ver . muito Obrigado .

[Daniel Jose Sobrinho]

Olá, tenho um programa em delphi que funciona muito bem no winrar, so que estou migrando para o lazarus e nao achei um componente que faça o mesmo papel do winrar.No meu programa o winrar guarda a senha e usa pra descompactar saindo de dentro do executável em um arquivo .res. Alguem sabe se tem como instalar algum componente do winrar no lazarus ? Ou algum outro que faça essa mesma função ?

[Daniel Simoes]

Não compreendi... Você quer adicionar arquivos no .exe como resources ?

[Daniel Jose Sobrinho]

Não compreendi... Você quer adicionar arquivos no .exe como resources ?

sim, o arquivo que quero colocar dentro do .exe é um arquivo do winrar. No delphi já consigo fazer isso, mas quero fazer no lazarus. E também quero usar o winrar como componente no lazarus como faço no delphi, pois ele precisa descompactar o arquivo pra fazer a instalação, e neste arquivo do winrar tá com a senha que eu coloco pra evitar de alguem descompactar, ou seja, só o meu programa que faz a descompactação. 

[Daniel Simoes]

Use FPC resources...

http://wiki.freepascal.org/Lazarus_Resources

 

Como executar um programa externo:

http://wiki.freepascal.org/Executing_External_Programs/pt

 

Na ACBrUtil.pas você tem a função:

{-----------------------------------------------------------------------------
 - Executa programa Externo descrito em "Command", adcionando os Parametros
   "Params" na linha de comando
 - Se "Wait" for true para a execução da aplicação para esperar a conclusao do
   programa externo executado por "Command"
 - WindowState apenas é utilizado na plataforma Windows
 ---------------------------------------------------------------------------- }
procedure RunCommand(const Command: String; const Params: String;
   Wait : Boolean; WindowState : Word);

[Daniel Jose Sobrinho]

 

Use FPC resources...

http://wiki.freepascal.org/Lazarus_Resources

 

Como executar um programa externo:

http://wiki.freepascal.org/Executing_External_Programs/pt

 

Na ACBrUtil.pas você tem a função:

{-----------------------------------------------------------------------------
 - Executa programa Externo descrito em "Command", adcionando os Parametros
   "Params" na linha de comando
 - Se "Wait" for true para a execução da aplicação para esperar a conclusao do
   programa externo executado por "Command"
 - WindowState apenas é utilizado na plataforma Windows
 ---------------------------------------------------------------------------- }
procedure RunCommand(const Command: String; const Params: String;
   Wait : Boolean; WindowState : Word);

Valeu Daniel Simões, era isso mesmo que eu precisava. No lazarus consegui aproveitar quase todo o codigo do delphi, so que ao apertar o F9 pra compilar o projeto, o arquivo .res caia de 17 megas para 135 kb e o programa mostrava a mensagem de erro dizendo que não achou o res. Isso aconteceu devido eu não essa informação que vc achou. Agora será que é possivel usar o winrar nesse processo pra usar o conteúdo do arquivo .res que está compactado em .rar e com senha, pra descompactar no momento da instalação ?

 

To dando o exemplo do winrar mas poderia ser qualquer programa que eu pudesse compactar com senha e só extrair se usar o meu programa.

 

Valeu pela ajuda, vou tentar implementar no meu programa.

[Daniel Paixão-Cascavel]

Em 13/06/2015 at 18:46, Daniel Simoes disse:

Use FPC resources...

http://wiki.freepascal.org/Lazarus_Resources

 

Como executar um programa externo:

http://wiki.freepascal.org/Executing_External_Programs/pt

 

Na ACBrUtil.pas você tem a função:

{-----------------------------------------------------------------------------
 - Executa programa Externo descrito em "Command", adcionando os Parametros
   "Params" na linha de comando
 - Se "Wait" for true para a execução da aplicação para esperar a conclusao do
   programa externo executado por "Command"
 - WindowState apenas é utilizado na plataforma Windows
 ---------------------------------------------------------------------------- }
procedure RunCommand(const Command: String; const Params: String;
   Wait : Boolean; WindowState : Word);

Daniel, desculpa se estou fazendo algo errado mas... o comando:

RunCommand('c:\ProgramFiles (x86)\WinRAR\WinRAR.exe a c:\NFE\Arquivos\072016.rar c:\NFE\Arquivos\072016','',True) não funciona nem a pau. O que pode ser?

[Daniel Simoes]

Separe o comando dos parâmetros (Command  e Params)