Ir para conteúdo
  • Cadastre-se

dev botao

  • Este tópico foi criado há 3025 dias atrás.
  • Talvez seja melhor você criar um NOVO TÓPICO do que postar uma resposta aqui.

Recommended Posts

Postado

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 .

Postado

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 .

  • 2 anos depois...
Postado

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 ?

Postado

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. 

  • Fundadores
Postado

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);
Consultor SAC ACBr

Daniel Simões de Almeida
O melhor TEF, é com o Projeto ACBr - Clique e Conheça
Ajude o Projeto ACBr crescer - Assine o SAC

Projeto ACBr     Telefone:(15) 2105-0750 WhatsApp(15)99790-2976.

Postado

 

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.

  • 1 ano depois...
Postado
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?

Sistemas para toda área Goumert, pequeno varejo e baladas.

www.controleautomacao.com.br

  • Este tópico foi criado há 3025 dias atrás.
  • Talvez seja melhor você criar um NOVO TÓPICO do que postar uma resposta aqui.

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar Agora
×
×
  • Criar Novo...

Informação Importante

Colocamos cookies em seu dispositivo para ajudar a tornar este site melhor. Você pode ajustar suas configurações de cookies, caso contrário, assumiremos que você está bem para continuar.

The popup will be closed in 10 segundos...