knrocha99
commented
5 months ago *****Segue correção do UCSWInstall para Delphi 12.2 Athens**
{ **** } { Projeto: Componentes User Control ShowDelphi Edition } { Biblioteca multiplataforma de componentes Delphi para o controle de usuários } { } { Baseado nos pacotes Open Source User Control 2.31 RC1 } { Autor da versão Original: Rodrigo Alves Cordeiro
Colaboradores da versão original Alexandre Oliveira Campioni - alexandre.rural@netsite.com.br Bernard Grandmougin Carlos Guerra Daniel Wszelaki Everton Ramos [BS2 Internet] Francisco Dueñas - fduenas@flashmail.com Germán H. Cravero Luciano Almeida Pimenta [ClubeDelphi.net] Luiz Benevenuto - luiz@siffra.com Luiz Fernando Severnini Peter van Mierlo Rodolfo Ferezin Moreira - rodolfo.fm@bol.com.br Rodrigo Palhano (WertherOO) Ronald Marconi Sergiy Sekela (Dr.Web) Stefan Nawrath Vicente Barros Leonel [ Fknyght ]
*** } { Versão ShowDelphi Edition } { } { Direitos Autorais Reservados (c) 2015 Giovani Da Cruz } { } { Colaboradores nesse arquivo: } { } { Você pode obter a última versão desse arquivo na pagina do projeto } { User Control ShowDelphi Edition } { Componentes localizado em http://infussolucoes.github.io/usercontrol-sd/ } { } { Esta biblioteca é software livre; você pode redistribuí-la e/ou modificá-la } { sob os termos da Licença Pública Geral Menor do GNU conforme publicada pela } { Free Software Foundation; tanto a versão 2.1 da Licença, ou (a seu critério) } { qualquer versão posterior. } { } { Esta biblioteca é distribuída na expectativa de que seja útil, porém, SEM } { NENHUMA GARANTIA; nem mesmo a garantia implícita de COMERCIABILIDADE OU } { ADEQUAÇÃO A UMA FINALIDADE ESPECÍFICA. Consulte a Licença Pública Geral Menor } { do GNU para mais detalhes. (Arquivo LICENÇA.TXT ou LICENSE.TXT) } { } { Você deve ter recebido uma cópia da Licença Pública Geral Menor do GNU junto } { com esta biblioteca; se não, escreva para a Free Software Foundation, Inc., } { no endereço 59 Temple Street, Suite 330, Boston, MA 02111-1307 USA. } { Você também pode obter uma copia da licença em: } { http://www.opensource.org/licenses/lgpl-license.php } { } { } { Comunidade Show Delphi - www.showdelphi.com.br } { } { Giovani Da Cruz - giovani@infus.inf.br - www.infus.inf.br } { } { **** }
{ AJUDE O PROJETO COM UMA XÍCARA DE CAFÉ OU DUAS. CONSIDERE UMA DOAÇÃO! } { } { VIA PAGSEGURO: https://pag.ae/7VccpnuCN } { APOIE COM BITCOIN: 13JUHQpT7zAU7pC1q6cQBYGpq5EF8XoLcL } {
{ ** | Historico | | 01/07/2015: Giovani Da Cruz | - Criação e distribuição da Primeira Versao ShowDelphi | | 06/02/2016: Giovani Da Cruz | - Ajuste para a adição automática no library do delphi. | | 31/08/2019: Gioavni Da Cruz | - Revisão para a instalação do DWCore Conector **** }
unit Visual.Main;
interface
uses JclIDEUtils, JclCompilerUtils,
Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics, Vcl.Controls, Vcl.Forms, Vcl.Dialogs, JvWizard, JvWizardRouteMapNodes, ShlObj, JvExControls, Vcl.StdCtrls, Vcl.Buttons, Vcl.ComCtrls, uFrameLista, Vcl.ExtCtrls, Vcl.Imaging.pngimage, JvComponentBase, JvCreateProcess;
type TDestino = (tdSystem, tdDelphi, tdNone);
TFrmPrincipal = class(TForm) wizPrincipal: TJvWizard; wizPgConfiguracao: TJvWizardInteriorPage; wizMapa: TJvWizardRouteMapNodes; Label2: TLabel; edtDirDestino: TEdit; btnSelecDirInstall: TSpeedButton; Label4: TLabel; edtDelphiVersion: TComboBox; Label5: TLabel; edtPlatform: TComboBox; wizPgPacote: TJvWizardInteriorPage; wizPgInstalacao: TJvWizardInteriorPage; lstMsgInstalacao: TListBox; pgbInstalacao: TProgressBar; frameDpk: TframePacotes; ckbBCB: TCheckBox; Label8: TLabel; wizPgInicio: TJvWizardInteriorPage; Label6: TLabel; lblUrlForum1: TLabel; lblUrlUserControl1: TLabel; Label19: TLabel; Label21: TLabel; Label11: TLabel; Label12: TLabel; Label7: TLabel; wizPgFim: TJvWizardInteriorPage; btnVisualizarLogCompilacao: TSpeedButton; pnlInfoCompilador: TPanel; lbInfo: TListBox; Label20: TLabel; Label1: TLabel; Label9: TLabel; Label10: TLabel; Label24: TLabel; Label25: TLabel; Image1: TImage; Label13: TLabel; Label15: TLabel; pnlTopo: TPanel; Label16: TLabel; Label17: TLabel; Image2: TImage; JvCreateProcess1: TJvCreateProcess; Label18: TLabel; chkDeixarSomenteLIB: TCheckBox; btnInstalar: TButton; Label3: TLabel; Label23: TLabel; Label14: TLabel; Label28: TLabel; Label22: TLabel; Label26: TLabel; Label27: TLabel; Label29: TLabel; Label30: TLabel; Label31: TLabel; procedure FormCreate(Sender: TObject); procedure FormClose(Sender: TObject; var Action: TCloseAction); procedure edtDelphiVersionChange(Sender: TObject); procedure btnSelecDirInstallClick(Sender: TObject); procedure wizPgConfiguracaoNextButtonClick(Sender: TObject; var Stop: Boolean); procedure wizPgInstalacaoEnterPage(Sender: TObject; const FromPage: TJvWizardCustomPage); procedure btnInstalarClick(Sender: TObject); procedure btnVisualizarLogCompilacaoClick(Sender: TObject); procedure wizPgConfiguracaoCancelButtonClick(Sender: TObject; var Stop: Boolean); procedure wizPgConfiguracaoFinishButtonClick(Sender: TObject; var Stop: Boolean); procedure URLClick(Sender: TObject); procedure wizPgInstalacaoNextButtonClick(Sender: TObject; var Stop: Boolean); procedure lblUrlPIXClick(Sender: TObject); private FCountErros : Integer; oUserControl: TJclBorRADToolInstallations; iVersion : Integer; tPlatform : TJclBDSPlatform; sDirRoot : string; sDirLibrary : string; sDirPackage : string; // sDestino : TDestino; sPathBin: String; procedure BeforeExecute(Sender: TJclBorlandCommandLineTool); procedure AddLibrarySearchPath; procedure OutputCallLine(const Text: string); procedure SetPlatformSelected; function IsCheckOutJaFeito(const ADiretorio: String): Boolean; procedure CreateDirectoryLibrarysNotExist; procedure GravarConfiguracoes; procedure LerConfiguracoes; function PathApp: String; function PathArquivoIni: String; function PathArquivoLog: String; procedure ExtrairDiretorioPacote(NomePacote: string); procedure AddLibraryPathToDelphiPath(const APath: String; const AProcurarRemover: String); procedure FindDirs(ADirRoot: String; bAdicionar: Boolean = True); procedure DeixarSomenteLib; function RunAsAdminAndWaitForCompletion(hWnd: hWnd; filename: string): Boolean; procedure WriteToTXT(const ArqTXT, AString: AnsiString; const AppendIfExists: Boolean = True; AddLineBreak: Boolean = True);
public end;
var FrmPrincipal: TFrmPrincipal;
implementation
{$R *.dfm}
uses {$WARNINGS off} FileCtrl, {$WARNINGS on} ShellApi, IniFiles, StrUtils, Math, Registry, System.Types, System.IOUtils, Clipbrd;
procedure TFrmPrincipal.AddLibraryPathToDelphiPath(const APath, AProcurarRemover: String); const cs: PChar = 'Environment Variables'; var lParam, wParam: Integer; aResult : Cardinal; ListaPaths : TStringList; I : Integer; PathsAtuais : String; PathFonte : string; begin with oUserControl.Installations[iVersion] do begin // tentar ler o path configurado na ide do delphi, se não existir ler // a atual para complementar e fazer o override PathsAtuais := Trim(EnvironmentVariables.Values['PATH']); if PathsAtuais = '' then PathsAtuais := GetEnvironmentVariable('PATH');
// manipular as strings
ListaPaths := TStringList.Create;
try
ListaPaths.Clear;
ListaPaths.Delimiter := ';';
ListaPaths.StrictDelimiter := True;
ListaPaths.DelimitedText := PathsAtuais;
// verificar se existe algo do UserControl e remover do environment variable PATH do delphi
if Trim(AProcurarRemover) <> '' then
begin
for I := ListaPaths.Count - 1 downto 0 do
begin
if Pos(AnsiUpperCase(AProcurarRemover), AnsiUpperCase(ListaPaths[I])) > 0 then
ListaPaths.Delete(I);
end;
end;
// adicionar o path
ListaPaths.Add(APath);
// escrever a variavel no override da ide
ConfigData.WriteString(cs, 'PATH', ListaPaths.DelimitedText);
// enviar um broadcast de atualização para o windows
wParam := 0;
lParam := LongInt(cs);
SendMessageTimeout(HWND_BROADCAST, WM_SETTINGCHANGE, wParam, lParam, SMTO_NORMAL, 4000, aResult);
if aResult <> 0 then
raise Exception.Create('Ocorreu um erro ao tentar configurar o path: ' + SysErrorMessage(aResult));
finally
ListaPaths.Free;
end;end; end;
procedure TFrmPrincipal.AddLibrarySearchPath; begin FindDirs(IncludeTrailingPathDelimiter(sDirRoot) + 'Source');
// -- with oUserControl.Installations[iVersion] do begin AddToLibraryBrowsingPath(sDirLibrary, tPlatform); AddToLibrarySearchPath(sDirLibrary, tPlatform); AddToDebugDCUPath(sDirLibrary, tPlatform); end;
// -- adicionar a library path ao path do windows AddLibraryPathToDelphiPath(sDirLibrary, 'UserControl');
// -- **** C++ Builder *** // if ckbBCB.Checked then begin if oUserControl.Installations[iVersion] is TJclBDSInstallation then begin with TJclBDSInstallation(oUserControl.Installations[iVersion]) do begin AddToCppSearchPath(sDirLibrary, tPlatform); AddToCppLibraryPath(sDirLibrary, tPlatform); AddToCppBrowsingPath(sDirLibrary, tPlatform); AddToCppIncludePath(sDirLibrary, tPlatform); end; end; end; end;
procedure TFrmPrincipal.BeforeExecute(Sender: TJclBorlandCommandLineTool); begin // limpar os parâmetros do compilador Sender.Options.Clear;
// não utilizar o dcc32.cfg if oUserControl.Installations[iVersion].SupportsNoConfig then Sender.Options.Add('--no-config');
// -B = Build all units
Sender.Options.Add('-B');
// O+ = Optimization
Sender.Options.Add('-$O-');
// W- = Generate stack frames
Sender.Options.Add('-$W+');
// Y+ = Symbol reference info
Sender.Options.Add('-$Y-');
// -M = Make modified units
Sender.Options.Add('-M');
// -Q = Quiet compile
Sender.Options.Add('-Q');
// não mostrar warnings
Sender.Options.Add('-H-');
// não mostrar hints
Sender.Options.Add('-W-');
// -D
// **** C++ Builder *** // if ckbBCB.Checked then begin // -JL compila c++ builder Sender.AddPathOption('JL', sDirLibrary); // -NO compila .dpi output directory c++ builder Sender.AddPathOption('NO', sDirLibrary); // -NB compila .lib output directory c++ builder Sender.AddPathOption('NB', sDirLibrary); // -NH compila .hpp output directory c++ builder Sender.AddPathOption('NH', sDirLibrary); end; // with oUserControl.Installations[iVersion] do begin // -- Path para instalar os pacotes do Rave no D7, nas demais versões // -- o path existe. if VersionNumberStr = 'd7' then Sender.AddPathOption('U', oUserControl.Installations[iVersion].RootDir + '\Rave5\Lib');
// -- Na versão XE2 por motivo da nova tecnologia FireMonkey, deve-se adicionar
// -- os prefixos dos nomes, para identificar se será compilado para VCL ou FMX
if VersionNumberStr = 'd16' then
Sender.Options.Add('-NSData.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;System;Xml;Data;Datasnap;Web;Soap;Winapi;System.Win');
// -- 04/06/2024 - Kellson Nunes Rocha foi acrescentado a verificação match para d29 athens
if MatchText(VersionNumberStr, ['d17', 'd18', 'd19', 'd20', 'd21', 'd22', 'd23', 'd24', 'd25', 'd26', 'd27', 'd28', 'd29']) then
begin
Sender.Options.Add('-NSWinapi;System.Win;Data.Win;Datasnap.Win;Web.Win;Soap.Win;Xml.Win;Bde;System;Xml;Data;Datasnap;Web;Soap;Vcl;Vcl.Imaging;Vcl.Touch;Vcl.Samples;Vcl.Shell;IBX');
end;end; end;
procedure TFrmPrincipal.btnSelecDirInstallClick(Sender: TObject); var Dir: String; begin if SelectDirectory('Selecione o diretório de instalação', '', Dir, [sdNewFolder, sdNewUI, sdValidateDir]) then edtDirDestino.Text := Dir; end;
procedure TFrmPrincipal.btnVisualizarLogCompilacaoClick(Sender: TObject); begin ShellExecute(Handle, 'open', PWideChar(PathArquivoLog), '', '', 1); end;
// criação dos diretórios necessários procedure TFrmPrincipal.CreateDirectoryLibrarysNotExist; begin // Checa se existe diretório da plataforma if not DirectoryExists(sDirLibrary) then ForceDirectories(sDirLibrary); end;
procedure TFrmPrincipal.DeixarSomenteLib; procedure Copiar(const Extensao: string); var ListArquivos: TStringDynArray; Arquivo : string; I : Integer; begin ListArquivos := TDirectory.GetFiles(IncludeTrailingPathDelimiter(sDirRoot) + 'Source', Extensao, TSearchOption.soAllDirectories); for I := Low(ListArquivos) to High(ListArquivos) do begin Arquivo := ExtractFileName(ListArquivos[I]); CopyFile(PWideChar(ListArquivos[I]), PWideChar(IncludeTrailingPathDelimiter(sDirLibrary) + Arquivo), True); end; end;
begin // remover os path com o segundo parametro FindDirs(IncludeTrailingPathDelimiter(sDirRoot) + 'Source', False);
Copiar('.dcr'); Copiar('.res'); Copiar('.dfm'); Copiar('.ini'); Copiar('*.inc'); end;
procedure TFrmPrincipal.btnInstalarClick(Sender: TObject); var iDpk : Integer; bRunOnly : Boolean; NomePacote: String; Cabecalho : String;
procedure Logar(const AString: String); begin lstMsgInstalacao.Items.Add(AString); lstMsgInstalacao.ItemIndex := lstMsgInstalacao.Count - 1; Application.ProcessMessages;
WriteToTXT(PathArquivoLog, AString);end;
procedure MostrarMensagemInstalado(const aMensagem: String; const aErro: String = ''); var Msg: String; begin
Msg := Format(aMensagem + ' em "%s"', [sPathBin]);
WriteToTXT(PathArquivoLog, '');
Logar(Msg);end;
procedure IncrementaBarraProgresso; begin pgbInstalacao.Position := pgbInstalacao.Position + 1; Application.ProcessMessages; end;
begin
FCountErros := 0;
btnInstalar.Enabled := False; wizPgInstalacao.EnableButton(bkNext, False); wizPgInstalacao.EnableButton(bkBack, False); wizPgInstalacao.EnableButton(TJvWizardButtonKind(bkCancel), False); try Cabecalho := 'Caminho: ' + edtDirDestino.Text + sLineBreak + 'Versão do delphi: ' + edtDelphiVersion.Text + ' (' + IntToStr(iVersion) + ')' + sLineBreak + 'Plataforma: ' + edtPlatform.Text + '(' + IntToStr(Integer(tPlatform)) + ')' + sLineBreak + StringOfChar('=', 80);
// limpar o log
lstMsgInstalacao.Clear;
WriteToTXT(PathArquivoLog, Cabecalho, False);
// setar barra de progresso
pgbInstalacao.Position := 0;
pgbInstalacao.Max := (frameDpk.Pacotes.Count * 2) + 6;
// *************************************************************************
// removendo arquivos antigos se configurado
// *************************************************************************
(* if ckbRemoverArquivosAntigos.Checked then
begin
if Application.MessageBox(
'você optou por limpar arquivos antigos do UserControl do seu computador, essa ação pode demorar vários minutos, deseja realmente continuar com está ação?',
'Limpar',
MB_YESNO + MB_DEFBUTTON2
) = ID_YES then
begin
Logar('Removendo arquivos antigos do disco...');
RemoverArquivosAntigosDoDisco;
IncrementaBarraProgresso;
end;
end; *)
// *************************************************************************
// Seta a plataforna selecionada
// *************************************************************************
Logar('Setando parâmetros de plataforma...');
SetPlatformSelected;
IncrementaBarraProgresso;
// *************************************************************************
// Cria diretório de biblioteca da versão do delphi selecionada,
// só será criado se não existir
// *************************************************************************
Logar('Criando diretórios de bibliotecas...');
CreateDirectoryLibrarysNotExist;
IncrementaBarraProgresso;
// *************************************************************************
// remover paths do delphi
// *************************************************************************
(* Logar('Removendo diretorios e pacotes antigos instalados...');
RemoverDiretoriosEPacotesAntigos; *)
IncrementaBarraProgresso;
// *************************************************************************
// Adiciona os paths dos fontes na versão do delphi selecionada
// *************************************************************************
Logar('Adicionando library paths...');
AddLibrarySearchPath;
IncrementaBarraProgresso;
// *************************************************************************
// compilar os pacotes primeiramente
// *************************************************************************
Logar('');
Logar('COMPILANDO OS PACOTES...');
for iDpk := 0 to frameDpk.Pacotes.Count - 1 do
begin
NomePacote := frameDpk.Pacotes[iDpk].Caption;
// Busca diretório do pacote
ExtrairDiretorioPacote(NomePacote);
if (IsDelphiPackage(NomePacote)) and (frameDpk.Pacotes[iDpk].Checked) then
begin
WriteToTXT(PathArquivoLog, '');
if oUserControl.Installations[iVersion].CompilePackage(sDirPackage + NomePacote, sDirLibrary, sDirLibrary) then
Logar(Format('Pacote "%s" compilado com sucesso.', [NomePacote]))
else
begin
Inc(FCountErros);
Logar(Format('Erro ao compilar o pacote "%s".', [NomePacote]));
// parar no primeiro erro para evitar de compilar outros pacotes que
// precisam do pacote que deu erro
Break
end;
end;
IncrementaBarraProgresso;
end;
// *************************************************************************
// instalar os pacotes somente se não ocorreu erro na compilação e plataforma for Win32
// *************************************************************************
if (edtPlatform.ItemIndex = 0) then
begin
if (FCountErros <= 0) then
begin
Logar('');
Logar('INSTALANDO OS PACOTES...');
for iDpk := 0 to frameDpk.Pacotes.Count - 1 do
begin
NomePacote := frameDpk.Pacotes[iDpk].Caption;
// Busca diretório do pacote
ExtrairDiretorioPacote(NomePacote);
if IsDelphiPackage(NomePacote) then
begin
// instalar somente os pacotes de designtime
GetDPKFileInfo(sDirPackage + NomePacote, bRunOnly);
if not bRunOnly then
begin
// se o pacote estiver marcado instalar, senão desinstalar
if frameDpk.Pacotes[iDpk].Checked then
begin
WriteToTXT(PathArquivoLog, '');
if oUserControl.Installations[iVersion].InstallPackage(sDirPackage + NomePacote, sDirLibrary, sDirLibrary) then
Logar(Format('Pacote "%s" instalado com sucesso.', [NomePacote]))
else
begin
Inc(FCountErros);
Logar(Format('Ocorreu um erro ao instalar o pacote "%s".', [NomePacote]));
Break;
end;
end
else
begin
WriteToTXT(PathArquivoLog, '');
if oUserControl.Installations[iVersion].UninstallPackage(sDirPackage + NomePacote, sDirLibrary, sDirLibrary) then
Logar(Format('Pacote "%s" removido com sucesso...', [NomePacote]));
end;
end;
end;
IncrementaBarraProgresso;
end;
end
else
begin
Logar('');
Logar('Abortando... Ocorreram erros na compilação dos pacotes.');
end;
end
else
begin
Logar('');
Logar('Para a plataforma de 64 bits os pacotes são somente compilados.');
end;
// *************************************************************************
// não instalar outros requisitos se ocorreu erro anteriormente
// *************************************************************************
if FCountErros <= 0 then
begin
Logar('');
Logar('INSTALANDO OUTROS REQUISITOS...');
// *************************************************************************
// deixar somente a pasta lib se for configurado assim
// *************************************************************************
if chkDeixarSomenteLIB.Checked then
begin
try
DeixarSomenteLib;
MostrarMensagemInstalado('Limpeza library path com sucesso');
MostrarMensagemInstalado('Copia dos arquivos necessário.');
except
on E: Exception do
begin
MostrarMensagemInstalado('Ocorreu erro ao limpas os path e copiar arquivos' + sLineBreak + E.Message)
end;
end;
end;
end;finally btnInstalar.Enabled := True; wizPgInstalacao.EnableButton(bkBack, True); wizPgInstalacao.EnableButton(bkNext, FCountErros = 0); wizPgInstalacao.EnableButton(TJvWizardButtonKind(bkCancel), True); end;
if FCountErros = 0 then begin Application.MessageBox( PWideChar( 'Pacotes compilados e instalados com sucesso! ' + sLineBreak + 'Clique em "Próximo" para finalizar a instalação.' ), 'Instalação', MB_ICONINFORMATION + MB_OK ); end else begin if Application.MessageBox( PWideChar( 'Ocorreram erros durante o processo de instalação, ' + sLineBreak + 'para maiores informações verifique o arquivo de log gerado.' + sLineBreak + sLineBreak + 'Deseja visualizar o arquivo de log gerado?' ), 'Instalação', MB_ICONQUESTION + MB_YESNO ) = ID_YES then begin btnVisualizarLogCompilacao.Click; end; end;
end;
procedure TFrmPrincipal.edtDelphiVersionChange(Sender: TObject); begin iVersion := edtDelphiVersion.ItemIndex; sPathBin := IncludeTrailingPathDelimiter(oUserControl.Installations[iVersion] .BinFolderName); // -- Plataforma só habilita para Delphi XE2 // -- Desabilita para versão diferente de Delphi XE2 edtPlatform.Enabled := oUserControl.Installations[iVersion].VersionNumber >= 9; if oUserControl.Installations[iVersion].VersionNumber < 9 then edtPlatform.ItemIndex := 0;
// C++ Builder a partir do D2006, versões anteriores tem IDE independentes. // 04/06/2024 - Kellson Nunes Rocha: Foi acrescentado a versão d29 athens para o matchtext ckbBCB.Enabled := MatchText(oUserControl.Installations[iVersion].VersionNumberStr, ['d10', 'd11', 'd12', 'd14', 'd15', 'd16', 'd17', 'd18', 'd19', 'd20', 'd21', 'd22', 'd23', 'd24', 'd25', 'd26', 'd27', 'd28', 'd29']); if not ckbBCB.Enabled then ckbBCB.Checked := False; end;
procedure TFrmPrincipal.ExtrairDiretorioPacote(NomePacote: string); procedure FindDirPackage(sDir, sPacote: String); var oDirList: TSearchRec; iRet : Integer; sDirDpk : string; begin sDir := IncludeTrailingPathDelimiter(sDir); if not DirectoryExists(sDir) then Exit;
if System.SysUtils.FindFirst(sDir + '*.*', faAnyFile, oDirList) = 0 then
begin
try
repeat
if (oDirList.Name = '.') or (oDirList.Name = '..') or (oDirList.Name = '__history') then
Continue;
// if oDirList.Attr = faDirectory then
if DirectoryExists(sDir + oDirList.Name) then
FindDirPackage(sDir + oDirList.Name, sPacote)
else
begin
if oDirList.Name = sPacote then
sDirPackage := IncludeTrailingPathDelimiter(sDir);
end;
until System.SysUtils.FindNext(oDirList) <> 0;
finally
System.SysUtils.FindClose(oDirList);
end;
end;end;
begin sDirPackage := '';
FindDirPackage(sDirRoot + 'Packages\', NomePacote); end;
procedure TFrmPrincipal.FindDirs(ADirRoot: String; bAdicionar: Boolean); var oDirList: TSearchRec;
function EProibido(const ADir: String): Boolean; const LISTA_PROIBIDOS: ARRAY [0 .. 4] OF STRING = ( 'quick', 'rave', 'laz', 'VerificarNecessidade', '__history' ); var Str: String; begin Result := False; for Str in LISTA_PROIBIDOS do begin Result := Pos(AnsiUpperCase(Str), AnsiUpperCase(ADir)) > 0; if Result then Break; end; end;
begin ADirRoot := IncludeTrailingPathDelimiter(ADirRoot);
if FindFirst(ADirRoot + '.', faDirectory, oDirList) = 0 then begin try repeat if ((oDirList.Attr and faDirectory) <> 0) and (oDirList.Name <> '.') and (oDirList.Name <> '..') and (not EProibido(oDirList.Name)) then begin with oUserControl.Installations[iVersion] do begin if bAdicionar then begin AddToLibrarySearchPath(ADirRoot + oDirList.Name, tPlatform); AddToLibraryBrowsingPath(ADirRoot + oDirList.Name, tPlatform); end else RemoveFromLibrarySearchPath(ADirRoot + oDirList.Name, tPlatform); end; // -- Procura subpastas FindDirs(ADirRoot + oDirList.Name, bAdicionar); end; until FindNext(oDirList) <> 0; finally System.SysUtils.FindClose(oDirList) end; end; end;
procedure TFrmPrincipal.FormClose(Sender: TObject; var Action: TCloseAction); begin oUserControl.Free; end;
procedure TFrmPrincipal.FormCreate(Sender: TObject); var iFor: Integer; begin iVersion := -1; sDirRoot := ''; sDirLibrary := ''; sDirPackage := '';
oUserControl := TJclBorRADToolInstallations.Create;
// popular o combobox de versões do delphi instaladas na máquina for iFor := 0 to oUserControl.Count - 1 do begin if oUserControl.Installations[iFor].VersionNumberStr = 'd3' then edtDelphiVersion.Items.Add('Delphi 3') else if oUserControl.Installations[iFor].VersionNumberStr = 'd4' then edtDelphiVersion.Items.Add('Delphi 4') else if oUserControl.Installations[iFor].VersionNumberStr = 'd5' then edtDelphiVersion.Items.Add('Delphi 5') else if oUserControl.Installations[iFor].VersionNumberStr = 'd6' then edtDelphiVersion.Items.Add('Delphi 6') else if oUserControl.Installations[iFor].VersionNumberStr = 'd7' then edtDelphiVersion.Items.Add('Delphi 7') else if oUserControl.Installations[iFor].VersionNumberStr = 'd9' then edtDelphiVersion.Items.Add('Delphi 2005') else if oUserControl.Installations[iFor].VersionNumberStr = 'd10' then edtDelphiVersion.Items.Add('Delphi 2006') else if oUserControl.Installations[iFor].VersionNumberStr = 'd11' then edtDelphiVersion.Items.Add('Delphi 2007') else if oUserControl.Installations[iFor].VersionNumberStr = 'd12' then edtDelphiVersion.Items.Add('Delphi 2009') else if oUserControl.Installations[iFor].VersionNumberStr = 'd14' then edtDelphiVersion.Items.Add('Delphi 2010') else if oUserControl.Installations[iFor].VersionNumberStr = 'd15' then edtDelphiVersion.Items.Add('Delphi XE') else if oUserControl.Installations[iFor].VersionNumberStr = 'd16' then edtDelphiVersion.Items.Add('Delphi XE2') else if oUserControl.Installations[iFor].VersionNumberStr = 'd17' then edtDelphiVersion.Items.Add('Delphi XE3') else if oUserControl.Installations[iFor].VersionNumberStr = 'd18' then edtDelphiVersion.Items.Add('Delphi XE4') else if oUserControl.Installations[iFor].VersionNumberStr = 'd19' then edtDelphiVersion.Items.Add('Delphi XE5') else if oUserControl.Installations[iFor].VersionNumberStr = 'd20' then edtDelphiVersion.Items.Add('Delphi XE6') else if oUserControl.Installations[iFor].VersionNumberStr = 'd21' then edtDelphiVersion.Items.Add('Delphi XE7') else if oUserControl.Installations[iFor].VersionNumberStr = 'd22' then edtDelphiVersion.Items.Add('Delphi XE8') else if oUserControl.Installations[iFor].VersionNumberStr = 'd23' then edtDelphiVersion.Items.Add('Delphi 10 Seattle') else if oUserControl.Installations[iFor].VersionNumberStr = 'd24' then edtDelphiVersion.Items.Add('Delphi 10.1 Berlin') else if oUserControl.Installations[iFor].VersionNumberStr = 'd25' then edtDelphiVersion.Items.Add('Delphi 10.2 Tokyo') else if oUserControl.Installations[iFor].VersionNumberStr = 'd26' then edtDelphiVersion.Items.Add('Delphi 10.3 Rio') else if oUserControl.Installations[iFor].VersionNumberStr = 'd27' then edtDelphiVersion.Items.Add('Delphi 10.4 Sydney') else if oUserControl.Installations[iFor].VersionNumberStr = 'd28' then edtDelphiVersion.Items.Add('Delphi 11 Alexandria') else if oUserControl.Installations[iFor].VersionNumberStr = 'd29' then edtDelphiVersion.Items.Add('Delphi 12 Athens'); // 04/06/2024 Kellson Nunes Rocha
// -- Evento disparado antes de iniciar a execução do processo.
oUserControl.Installations[iFor].DCC32.OnBeforeExecute := BeforeExecute;
// -- Evento para saidas de mensagens.
oUserControl.Installations[iFor].OutputCallback := OutputCallLine;end;
if edtDelphiVersion.Items.Count > 0 then begin edtDelphiVersion.ItemIndex := 0; iVersion := 0; end;
LerConfiguracoes; end;
procedure TFrmPrincipal.GravarConfiguracoes; var ArqIni: TIniFile; I : Integer; begin ArqIni := TIniFile.Create(PathArquivoIni); try ArqIni.WriteString('CONFIG', 'DiretorioInstalacao', edtDirDestino.Text); ArqIni.WriteString('CONFIG', 'DelphiVersao', edtDelphiVersion.Text); ArqIni.WriteString('CONFIG', 'Plataforma', edtPlatform.Text); ArqIni.WriteBool('CONFIG', 'C++Builder', ckbBCB.Checked);
for I := 0 to frameDpk.Pacotes.Count - 1 do
ArqIni.WriteBool('PACOTES', frameDpk.Pacotes[I].Caption,
frameDpk.Pacotes[I].Checked);finally ArqIni.Free; end; end;
// verificar se no caminho informado já existe o .svn indicando que o // checkout já foi feito no diretorio function TFrmPrincipal.IsCheckOutJaFeito(const ADiretorio: String): Boolean; begin Result := DirectoryExists(IncludeTrailingPathDelimiter(ADiretorio) + '.svn') end;
procedure TFrmPrincipal.lblUrlPIXClick(Sender: TObject); begin Clipboard.asText := TLabel(Sender).Caption;
Application.MessageBox('Chave copiada para a área de transferência!', 'Apoio ao Projeto', MB_ICONINFORMATION + MB_OK); end;
procedure TFrmPrincipal.wizPgConfiguracaoCancelButtonClick(Sender: TObject; var Stop: Boolean); begin if Application.MessageBox( 'Deseja realmente cancelar a instalação?', 'Fechar', MB_ICONQUESTION + MB_YESNO ) = ID_YES then begin Self.Close; end; end;
procedure TFrmPrincipal.wizPgConfiguracaoFinishButtonClick(Sender: TObject; var Stop: Boolean); begin Self.Close; end;
procedure TFrmPrincipal.wizPgConfiguracaoNextButtonClick(Sender: TObject; var Stop: Boolean); begin // verificar se foi informado o diretório if Trim(edtDirDestino.Text) = EmptyStr then begin Stop := True; edtDirDestino.SetFocus; Application.MessageBox( 'Diretório de instalação não foi informado.', 'Erro.', MB_OK + MB_ICONERROR ); end;
// prevenir versão do delphi em branco if Trim(edtDelphiVersion.Text) = '' then begin Stop := True; edtDelphiVersion.SetFocus; Application.MessageBox( 'Versão do delphi não foi informada.', 'Erro.', MB_OK + MB_ICONERROR ); end;
// prevenir plataforma em branco if Trim(edtPlatform.Text) = '' then begin Stop := True; edtPlatform.SetFocus; Application.MessageBox( 'Plataforma de compilação não foi informada.', 'Erro.', MB_OK + MB_ICONERROR ); end;
// Gravar as configurações em um .ini para utilizar depois GravarConfiguracoes;
// if not DirectoryExists() then
end;
procedure TFrmPrincipal.wizPgInstalacaoEnterPage(Sender: TObject; const FromPage: TJvWizardCustomPage); begin SetPlatformSelected; lstMsgInstalacao.Clear; pgbInstalacao.Position := 0;
// mostrar ao usuário as informações de compilação with lbInfo.Items do begin Clear; Add(edtDelphiVersion.Text + ' ' + edtPlatform.Text); Add('Dir. Instalação : ' + edtDirDestino.Text); Add('Dir. Bibliotecas : ' + sDirLibrary); end;
// para 64 bit somente compilar if tPlatform = bpWin32 then // Win32 btnInstalar.Caption := 'Instalar' else // win64 btnInstalar.Caption := 'Compilar'; end;
procedure TFrmPrincipal.wizPgInstalacaoNextButtonClick(Sender: TObject; var Stop: Boolean); begin if (lstMsgInstalacao.Count <= 0) then begin Stop := True; Application.MessageBox( 'Clique no botão instalar antes de continuar.', 'Erro.', MB_OK + MB_ICONERROR ); end;
if (FCountErros > 0) then begin Stop := True; Application.MessageBox( 'Ocorreram erros durante a compilação e instalação dos pacotes, verifique.', 'Erro.', MB_OK + MB_ICONERROR ); end; end;
procedure TFrmPrincipal.LerConfiguracoes; var ArqIni: TIniFile; I : Integer; begin ArqIni := TIniFile.Create(PathArquivoIni); try edtDirDestino.Text := ArqIni.ReadString('CONFIG', 'DiretorioInstalacao', ExtractFilePath(ParamStr(0))); edtPlatform.ItemIndex := edtPlatform.Items.IndexOf (ArqIni.ReadString('CONFIG', 'Plataforma', 'Win32')); edtDelphiVersion.ItemIndex := edtDelphiVersion.Items.IndexOf (ArqIni.ReadString('CONFIG', 'DelphiVersao', '')); ckbBCB.Checked := ArqIni.ReadBool('CONFIG', 'C++Builder', False);
if Trim(edtDelphiVersion.Text) = '' then
edtDelphiVersion.ItemIndex := 0;
edtDelphiVersionChange(edtDelphiVersion);
for I := 0 to frameDpk.Pacotes.Count - 1 do
frameDpk.Pacotes[I].Checked := ArqIni.ReadBool('PACOTES',
frameDpk.Pacotes[I].Caption, False);finally ArqIni.Free; end; end;
// Evento disparado a cada ação do instalador procedure TFrmPrincipal.OutputCallLine(const Text: string); begin // remover a warnings de conversão de string (delphi 2010 em diante) // as diretivas -W e -H não removem estas mensagens if (Pos('Warning: W1057', Text) <= 0) and ((Pos('Warning: W1058', Text) <= 0)) then WriteToTXT(PathArquivoLog, Text); end;
// retornar o path do aplicativo function TFrmPrincipal.PathApp: String; begin Result := IncludeTrailingPathDelimiter(ExtractFilePath(ParamStr(0))); end;
// retornar o caminho completo para o arquivo .ini de configurações function TFrmPrincipal.PathArquivoIni: String; var NomeApp: String; begin NomeApp := ExtractFileName(ParamStr(0)); Result := PathApp + ChangeFileExt(NomeApp, '.ini'); end;
// retornar o caminho completo para o arquivo de logs function TFrmPrincipal.PathArquivoLog: String; begin Result := PathApp + 'log' + StringReplace(edtDelphiVersion.Text, ' ', '', [rfReplaceAll]) + '.txt'; end;
function TFrmPrincipal.RunAsAdminAndWaitForCompletion(hWnd: hWnd; filename: string): Boolean; { See Step 3: Redesign for UAC Compatibility (UAC) http://msdn.microsoft.com/en-us/library/bb756922.aspx } var sei : TShellExecuteInfo; ExitCode: DWORD; begin ZeroMemory(@sei, SizeOf(sei)); sei.cbSize := SizeOf(TShellExecuteInfo); sei.Wnd := hWnd; sei.fMask := SEE_MASK_FLAG_DDEWAIT or SEE_MASK_FLAG_NO_UI or SEE_MASK_NOCLOSEPROCESS; sei.lpVerb := PWideChar('runas'); sei.lpFile := PWideChar(filename); sei.lpParameters := PWideChar(''); sei.nShow := SW_HIDE;
if ShellExecuteEx(@sei) then begin repeat Application.ProcessMessages; GetExitCodeProcess(sei.hProcess, ExitCode); until (ExitCode <> STILL_ACTIVE) or Application.Terminated; end; end;
procedure TFrmPrincipal.SetPlatformSelected; var sVersao: String; sTipo : String; begin iVersion := edtDelphiVersion.ItemIndex; sVersao := AnsiUpperCase(oUserControl.Installations[iVersion].VersionNumberStr); sDirRoot := IncludeTrailingPathDelimiter(edtDirDestino.Text);
sTipo := 'Lib\Delphi\';
if edtPlatform.ItemIndex = 0 then // Win32 begin tPlatform := bpWin32; sDirLibrary := sDirRoot + sTipo + 'Lib' + sVersao; end else if edtPlatform.ItemIndex = 1 then // Win64 begin tPlatform := bpWin64; sDirLibrary := sDirRoot + sTipo + 'Lib' + sVersao + 'x64'; end;
{ Cria os diretorios } if not(System.SysUtils.DirectoryExists(sDirRoot + sTipo)) then MkDir(sDirRoot + sTipo);
if not(System.SysUtils.DirectoryExists(sDirLibrary)) then MkDir(sDirLibrary); end;
procedure TFrmPrincipal.URLClick(Sender: TObject); begin ShellExecute(Handle, 'open', PWideChar(TLabel(Sender).Caption), '', '', 1); end;
procedure TFrmPrincipal.WriteToTXT(const ArqTXT, AString: AnsiString; const AppendIfExists: Boolean; AddLineBreak: Boolean); var FS : TFileStream; LineBreak: AnsiString; begin FS := TFileStream.Create(string(ArqTXT), IfThen(AppendIfExists and System.SysUtils.FileExists(String(ArqTXT)), Integer(fmOpenReadWrite), Integer(fmCreate)) or fmShareDenyWrite); try FS.Seek(0, soFromEnd); // vai para EOF FS.Write(Pointer(AString)^, Length(AString));
if AddLineBreak then
begin
LineBreak := sLineBreak;
FS.Write(Pointer(LineBreak)^, Length(LineBreak));
end;finally FS.Free; end; end;
end.
Existe alguma correção para funcionar o instalador no delphi 12.0 e 12.1 Athens?