unit principalU;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, TFlatButtonUnit, StdCtrls, SUIPageControl, Registry,
  ShellAPI, FileCtrl, SUITabControl, SWSystem, Buttons, ComObj, ShlObj, ActiveX;

type
  TprincipalF = class(TForm)
    Image4: TImage;
    suiPageControl1: TsuiPageControl;
    suiTabSheet1: TsuiTabSheet;
    Label1: TLabel;
    RadioButton1: TRadioButton;
    RadioButton2: TRadioButton;
    Shape1: TShape;
    suiTabSheet2: TsuiTabSheet;
    suiTabSheet3: TsuiTabSheet;
    suiTabSheet4: TsuiTabSheet;
    Label2: TLabel;
    Label3: TLabel;
    RadioButton3: TRadioButton;
    Panel1: TPanel;
    FlatButton2: TFlatButton;
    FlatButton1: TFlatButton;
    FlatButton3: TFlatButton;
    FlatButton4: TFlatButton;
    Label4: TLabel;
    Label5: TLabel;
    Image1: TImage;
    Image2: TImage;
    Label6: TLabel;
    FlatButton5: TFlatButton;
    Label7: TLabel;
    FlatButton6: TFlatButton;
    Label8: TLabel;
    Label9: TLabel;
    FlatButton7: TFlatButton;
    Label10: TLabel;
    Label11: TLabel;
    Label12: TLabel;
    Label13: TLabel;
    FlatButton8: TFlatButton;
    Label14: TLabel;
    suiTabSheet5: TsuiTabSheet;
    suiTabSheet6: TsuiTabSheet;
    Panel2: TPanel;
    Edit1: TEdit;
    Label15: TLabel;
    FlatButton9: TFlatButton;
    Label16: TLabel;
    RadioButton4: TRadioButton;
    Edit2: TEdit;
    Label17: TLabel;
    FlatButton10: TFlatButton;
    Shape2: TShape;
    FlatButton11: TFlatButton;
    Shape3: TShape;
    Edit3: TEdit;
    Label18: TLabel;
    Label19: TLabel;
    Edit4: TEdit;
    Edit5: TEdit;
    Label20: TLabel;
    FlatButton12: TFlatButton;
    Label21: TLabel;
    procedure CriarAtalho(var Caminho,NomeAtalho:String);
    procedure CopiaArquivos(var Origem,Destino:string);
    procedure CopiaDiretoriosArquivos(Mascara, De, Para: string);
    procedure VerificaVersao;
    procedure FlatButton4Click(Sender: TObject);
    procedure suiPageControl1TabActive(Sender: TObject; TabIndex: Integer);
    procedure FlatButton3Click(Sender: TObject);
    procedure FlatButton5Click(Sender: TObject);
    procedure suiPageControl1Change(Sender: TObject);
    procedure FlatButton6Click(Sender: TObject);
    procedure FlatButton7Click(Sender: TObject);
    procedure FlatButton8Click(Sender: TObject);
    procedure FlatButton10Click(Sender: TObject);
    procedure FlatButton11Click(Sender: TObject);
    procedure FlatButton9Click(Sender: TObject);
    procedure Edit1Exit(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FlatButton2Click(Sender: TObject);
    procedure FlatButton1Click(Sender: TObject);
    procedure RadioButton1Click(Sender: TObject);
    procedure RadioButton3Click(Sender: TObject);
    procedure RadioButton2Click(Sender: TObject);
    procedure RadioButton4Click(Sender: TObject);
    procedure FlatButton12Click(Sender: TObject);
    procedure FormShow(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    DirDesktop:String;
  end;

var
  principalF: TprincipalF;

implementation

{$R *.dfm}

function IncludeTrailingBackslash(const S: string): string;
begin
 Result := S;
 if S[Length(S)] <> '\' then
   Result := Result + '\';
end;

function ExecAndWait(const FileName, Params: string;
 const WindowState: Word): boolean;
 var 
 SUInfo: TStartupInfo; 
 ProcInfo: TProcessInformation;
 CmdLine: string;
 begin 
 { Coloca o nome do arquivo entre aspas. Isto é necessário devido aos espaços contidos em nomes longos } 
 CmdLine := '"' + Filename + '"' + Params;
 FillChar(SUInfo, SizeOf(SUInfo), #0);
 with SUInfo do begin 
 cb := SizeOf(SUInfo); 
 dwFlags := STARTF_USESHOWWINDOW; 
 wShowWindow := WindowState; 
 end;
 Result := CreateProcess(nil, PChar(CmdLine), nil, nil, false,
 CREATE_NEW_CONSOLE or NORMAL_PRIORITY_CLASS, nil, 
 PChar(ExtractFilePath(Filename)), SUInfo, ProcInfo); 
 { Aguarda até ser finalizado } 
 if Result then begin 
 WaitForSingleObject(ProcInfo.hProcess, INFINITE); 
 { Libera os Handles } 
 CloseHandle(ProcInfo.hProcess);
 CloseHandle(ProcInfo.hThread); 
 end; 
 end; 


procedure TprincipalF.FlatButton4Click(Sender: TObject);
  var Resultado:Boolean;
  Caminho,Caminho2,Caminho3:String;
begin
with TRegistry.Create do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    Resultado := OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances', False);
    if Resultado then
    begin
      Caminho := ReadString('DefaultInstance') + 'bin\instsvc.exe';
      Caminho2 := ReadString('DefaultInstance') + 'unins000.exe';
      Caminho3 := ReadString('DefaultInstance');
      Resultado := FileExists(Caminho);
      if Resultado then begin
      ShellExecute(0, nil, PChar(Caminho), '-s stop', nil, SW_HIDE);
      ShellExecute(0, nil, PChar(Caminho), '-s remove', nil, SW_HIDE);
      ShellExecute(0, nil, PChar(Caminho2), '/SILENT /NORESTART /SUPPRESSMSGBOXES', nil, SW_HIDE);
      RemoveDir(Caminho3);
      end;
      CloseKey;
    end;
    Free;
  end;
  Label4.Caption := 'Firebird não encontrado';
  FlatButton4.Enabled := false;
  Label5.Caption := 'Pronto para instalar';
  FlatButton3.Enabled := true;
end;

procedure TprincipalF.suiPageControl1TabActive(Sender: TObject;
  TabIndex: Integer);
  var Resultado:Boolean;
  Caminho,VersaoInstalada:String;
begin
  if TabIndex=1 then begin
    VerificaVersao;
  end;
end;

procedure TprincipalF.VerificaVersao;
  var Resultado:Boolean;
  Caminho,VersaoInstalada:String;
begin
  VersaoInstalada := '';
  with TRegistry.Create do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    Resultado := OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances', False);
    if Resultado then
    begin
      Caminho := ReadString('DefaultInstance');
      Caminho := copy(caminho,1,length(caminho)-1);
      while copy(caminho,length(caminho),1)<>'\' do begin
        VersaoInstalada := copy(caminho,length(caminho),1) + VersaoInstalada;
        Caminho := copy(caminho,1,length(caminho)-1);
      end;
      Resultado := DirectoryExists(ReadString('DefaultInstance'));
      if Resultado then begin
        Label4.Caption := 'Encontrado instalação '+'"'+VersaoInstalada+'"';
        FlatButton4.Enabled := true;
        Label5.Caption := 'Aguardando desinstalar';
        FlatButton3.Enabled := false;
      end else begin
        Label4.Caption := 'Firebird não encontrado';
        FlatButton4.Enabled := false;
        Label5.Caption := 'Pronto para instalar';
        FlatButton3.Enabled := true;
      end;
      CloseKey;
    end else begin
      Label4.Caption := 'Firebird não encontrado';
      FlatButton4.Enabled := false;
      Label5.Caption := 'Pronto para instalar';
      FlatButton3.Enabled := true;
    end;
    Free;
  end;
end;

procedure TprincipalF.FlatButton3Click(Sender: TObject);
  var Resultado:Boolean;
  Caminho,Caminho2:String;
  Origem,Destino:String;
begin
  ExecAndWait(PChar(gsAppPath+'\PROGRAMAS\FIREBIRD\FIREBIRD.EXE'),' /SILENT /NORESTART', SW_SHOWNORMAL);
  with TRegistry.Create do
  begin
    RootKey := HKEY_LOCAL_MACHINE;
    Resultado := OpenKey('SOFTWARE\Firebird Project\Firebird Server\Instances', False);
    if Resultado then
    begin
      //CopyFile(PChar(ReadString('DefaultInstance')+'\UDF\'), PChar(gsAppPath+'\PROGRAMAS\UDF\*.*'), true);

      Origem := gsAppPath+'PROGRAMAS\UDF\';
      Destino := ReadString('DefaultInstance')+'UDF\';
      CopiaArquivos(Origem,Destino);

      Caminho := ReadString('DefaultInstance') + 'bin\instsvc.exe';
      Resultado := FileExists(Caminho);
      if Resultado then begin
        ShellExecute(0, nil, PChar(Caminho), '-s start', nil, SW_HIDE);
      end;
      CloseKey;
    end;
    Free;
  end;
  Label4.Caption := 'Instalação efetuada com sucesso. Clique em próximo!';
  FlatButton4.Enabled := true;
  Label5.Caption := 'Aguardando desinstalar';
  FlatButton3.Enabled := false;
end;

procedure TprincipalF.CopiaArquivos(var Origem, Destino: string);
var
SR: TSearchRec;
I: integer;
Origem2, Destino2: string;
begin
  I := FindFirst(origem+'*.*', faAnyFile, SR); // Local de Origem
  while I = 0 do begin
    if (SR.Attr and faDirectory) <> faDirectory then begin
      Origem2 := Origem + SR.Name;
      Destino2 := destino + SR.Name;
      if not FileExists(PChar(Destino2)) then begin
        if not DirectoryExists(ExtractFileDir(Destino2)) then
          MkDir(ExtractFileDir(Destino2));
        if not CopyFile(PChar(Origem2), PChar(Destino2), true) then
          ShowMessage('Erro ao copiar ' + Origem2 + ' para ' + Destino2);
      end;
    end;
    I := FindNext(SR);
  end;
end;

function IsWindows64: Boolean;
type
  TIsWow64Process = function(AHandle:THandle; var AIsWow64: BOOL): BOOL; stdcall;
var
  vKernel32Handle: DWORD;
  vIsWow64Process: TIsWow64Process;
  vIsWow64: BOOL;
begin
  Result := False;
  vKernel32Handle := LoadLibrary('kernel32.dll');
  if (vKernel32Handle = 0) then Exit;
  try
    @vIsWow64Process := GetProcAddress(vKernel32Handle, 'IsWow64Process');
    if not Assigned(vIsWow64Process) then Exit;
    vIsWow64 := False;
    if (vIsWow64Process(GetCurrentProcess, vIsWow64)) then
      Result := vIsWow64;
  finally
    FreeLibrary(vKernel32Handle);
  end;
end;

procedure TprincipalF.FlatButton5Click(Sender: TObject);
  var Origem,Destino:String;
  csParams : PChar;
  Str: String;
begin
{  Origem := gsAppPath+'PROGRAMAS\BDE\';
  Destino := GetEnvironmentVariable('ProgramFiles')+'\Common Files\Borland Shared\BDE\';
  if DirectoryExists(GetEnvironmentVariable('ProgramFiles')+'\Common Files') = false then
    MkDir(GetEnvironmfdcentVariable('ProgramFiles')+'\Common Files\Borland Shared');
  if DirectoryExists(GetEnvironmentVariable('ProgramFiles')+'\Common Files\Borland Shared') = false then
    MkDir(GetEnvironmentVariable('ProgramFiles')+'\Common Files');
  if DirectoryExists(GetEnvironmentVariable('ProgramFiles')+'\Common Files\Borland Shared\BDE') = false then
    MkDir(GetEnvironmentVariable('ProgramFiles')+'\Common Files\Borland Shared\BDE\');
  CopiaArquivos(Origem,Destino);}

  //ExecAndWait(PChar(gsAppPath+'\PROGRAMAS\BDE\Instalador_BDE_5.2_Compacto.EXE'),'', SW_SHOWNORMAL);
  WinExec(PChar(gsAppPath+'\PROGRAMAS\BDE\Instalador_BDE_5.2_Compacto.EXE'),SW_SHOWNORMAL);
  //ExecAndWait(PChar(gsAppPath+'\PROGRAMAS\BDE\Instalador_BDE_5.2_Compacto.EXE'),'', SW_SHOWNORMAL);

  Label7.Visible := true;

end;

procedure TprincipalF.suiPageControl1Change(Sender: TObject);
begin
//  Label7.Visible := false;
//  Label10.Visible := false;
//  Label11.Visible := false;
//  Label14.Visible := false;
end;

procedure TprincipalF.FlatButton6Click(Sender: TObject);
  var Origem,Destino:String;
  csParams : PChar;
  Buffer : Array[0..144] of Char;
begin
 GetWindowsDirectory(Buffer,144);
  if IsWindows64 then begin
    Destino := StrPas(Buffer)+'\SysWOW64\';
  end else
      Destino := StrPas(Buffer)+'\System32\';
  Origem := gsAppPath+'PROGRAMAS\DLL\';
  CopiaArquivos(Origem,Destino);
  Label10.Visible := true;
end;

procedure TprincipalF.FlatButton7Click(Sender: TObject);
  var Origem,Destino:String;
  csParams : PChar;
  Buffer : Array[0..144] of Char;
begin
  GetWindowsDirectory(Buffer,144);
  Destino := StrPas(Buffer)+'\FONTS\';
  Origem := gsAppPath+'PROGRAMAS\FONTS\';
  CopiaArquivos(Origem,Destino);
  Label11.Visible := true;
end;

procedure TprincipalF.FlatButton8Click(Sender: TObject);
begin
  WinExec(Pchar(gsAppPath+'PROGRAMAS\DLL\nfe.bat'), SW_HIDE);
  Label14.Visible := true;
end;

procedure TprincipalF.FlatButton10Click(Sender: TObject);
begin
  if FlatButton10.Caption = 'Desativar Firewall' then begin
    WinExec(PAnsiChar('netsh firewall set opmode disable'), 0);
    WinExec(PAnsiChar('netsh advfirewall set currentprofile state off'), 0);
    FlatButton10.Caption := 'Ativar Firewall';
    Shape2.Brush.Color := clLime;
  end else begin
    WinExec(PAnsiChar('netsh firewall set opmode enable'), 0);
    WinExec(PAnsiChar('netsh advfirewall set currentprofile state on'), 0);
    FlatButton10.Caption := 'Desativar Firewall';
    Shape2.Brush.Color := clRed;
  end;
end;

procedure SetUAC(nUAC : integer);
 var
 reg : TRegistry;
 key : string;
 begin
 reg := TRegistry.Create;
 with reg do
 begin
 RootKey := HKEY_LOCAL_MACHINE;
 key := '\Software\Microsoft\Windows\CurrentVersion\Policies\System';
 if OpenKey(key, false) then
 begin
 if ValueExists('EnableLUA') then
 reg.WriteInteger('EnableLUA', nUAC)
 {else //comment out for Windows OS prior to Vista as the value doesn't exist; UAC was first introduced on Windows Vista
 ShowMessage('value not exist.')};
 end
 else
 ShowMessage('Error in opening registry key.');
 end; 
 reg.Free;
end;

procedure TprincipalF.FlatButton11Click(Sender: TObject);
begin
  if FlatButton11.Caption = 'Desativar UAC' then begin
    setUAC(0);
    FlatButton11.Caption := 'Ativar UAC';
    Shape3.Brush.Color := clLime;
  end else begin
    setUAC(1);
    FlatButton11.Caption := 'Desativar UAC';
    Shape3.Brush.Color := clRed;
  end;
end;


procedure TprincipalF.FlatButton9Click(Sender: TObject);
  var Origem,Destino,Caminho,Atalho:String;
begin
  if DirectoryExists(edit1.Text) then begin
   ShowMessage('Diretório já existente!'+#13+'Favor alterar o caminho.');
  end else begin
    Label16.Caption := 'Instalando...';
    Label16.Visible := true;
    Label16.Refresh;
    Origem := gsAppPath+'Sistemas\';
    if DirectoryExists(Edit1.Text)=false then
      MkDir(Edit1.Text);
    Destino := Edit1.text;
    CopiaDiretoriosArquivos('*.*', Origem, Destino);
    Caminho := Edit1.text+'vedas\vedas.exe';
    Atalho := 'Vedas';
    CriarAtalho(Caminho,Atalho);
    Label16.Visible := true;
    Label16.Caption := 'Instalado com sucesso!';
    Label16.Refresh;
    ShowMessage('Atalho VEDAS criado com sucesso!');
  end;
end;

procedure TprincipalF.CopiaDiretoriosArquivos(Mascara, De, Para: string);
var
 Search: TSearchRec;
 Done: Boolean;
begin
De := IncludeTrailingBackslash(De);
Para := IncludeTrailingBackslash(Para);
 Done := FindFirst(De + Mascara, faAnyFile, Search) <> 0;
 while not Done do begin
     if (Search.Attr and faDirectory) = faDirectory then begin
     if (Search.Name <> '.') and (Search.Name <> '..') then begin
       ForceDirectories(Para + Search.Name);
       CopiaDiretoriosArquivos(Mascara, De + Search.Name, Para + Search.Name);
     end;
   end
   else begin
   If not CopyFile(PChar(De + Search.Name),
       PChar(Para + Search.Name), FALSE) then begin
       ShowMessage('Erro ao copiar: ' + De + ' para: ' + Para);  //trata erro na cópia
     end;
   end;
  Done := FindNext(Search) <> 0;
 end;
end;

procedure TprincipalF.Edit1Exit(Sender: TObject);
begin
  if copy(Edit1.Text,length(Edit1.text),1) <> '\' then
    Edit1.Text := Edit1.Text+'\';
end;

procedure TprincipalF.FormCreate(Sender: TObject);
var ItemIDList :  PItemIDList;
   Registro: TRegistry;
   DesktopUsuario: string;
begin
  Registro := TRegistry.Create;
  Registro.RootKey := HKEY_CURRENT_USER;
  Registro.OpenKey('Software\Microsoft\Windows\CurrentVersion\Explorer\Shell Folders\', True);
  DesktopUsuario := Registro.ReadString('Desktop');
  Registro.CloseKey;
  Registro.Free;
  DirDesktop := DesktopUsuario;
  SetLength(DirDesktop,MAX_PATH);
  SHGetSpecialFolderLocation(Application.Handle, CSIDL_DESKTOPDIRECTORY,ItemIDList);
  SHGetPathFromIDList(ItemIdList,PChar(DirDesktop));
  SetLength(DirDesktop,StrLen(PChar(DirDesktop)));
end;

procedure TprincipalF.CriarAtalho(var Caminho, NomeAtalho: String);
var ShellLink : IShellLink;
    PersistFile : IPersistFile;
    NomeLnk : WideString;
begin
   ShellLink := CreateComObject(CLSID_ShellLink) as IShellLink;
   PersistFile := ShellLink as IPersistFile;
   with ShellLink do begin
     // Informe o Título do ícone
     SetDescription(PChar(NomeAtalho));
     // Informe o Caminho e o Arquivo
     SetPath(PChar(caminho));
     // Argumentos para linha de comando, caso existam
     SetArguments(PChar(''));
     // Informe o Caminho e o Arquivo
     SetWorkingDirectory(PChar(ExtractFilePath(caminho)));
   end;
   // Informe o nome do Atalho
   NomeLnk := DirDesktop+'\'+ChangeFileExt(NomeAtalho,'.lnk');
   PersistFile.Save(PWideChar(NomeLnk),False);
end;

procedure TprincipalF.FlatButton2Click(Sender: TObject);
begin
  suiPageControl1.ActivePageIndex := suiPageControl1.ActivePageIndex+1;
  if suiPageControl1.ActivePageIndex=0 then begin
    FlatButton1.Enabled := false;
  end else
    FlatButton1.Enabled := true;
  if suiPageControl1.ActivePageIndex=suiPageControl1.PageCount-1 then begin
    FlatButton2.Enabled := false;
  end else
    FlatButton2.Enabled := true;
end;

procedure TprincipalF.FlatButton1Click(Sender: TObject);
begin
  suiPageControl1.ActivePageIndex := suiPageControl1.ActivePageIndex-1;
  if suiPageControl1.ActivePageIndex=0 then begin
    FlatButton1.Enabled := false;
  end else
    FlatButton1.Enabled := true;
  if suiPageControl1.ActivePageIndex=suiPageControl1.PageCount-1 then begin
    FlatButton2.Enabled := false;
  end else
    FlatButton2.Enabled := true;
end;

procedure TprincipalF.RadioButton1Click(Sender: TObject);
begin
  suiTabSheet2.TabVisible := true;
  suiTabSheet3.TabVisible := true;
  suiTabSheet4.TabVisible := true;
  suiTabSheet5.TabVisible := true;
  suiTabSheet6.TabVisible := true;
end;

procedure TprincipalF.RadioButton3Click(Sender: TObject);
begin
  suiTabSheet2.TabVisible := false;
  suiTabSheet3.TabVisible := false;
  suiTabSheet4.TabVisible := false;
  suiTabSheet5.TabVisible := false;
  suiTabSheet6.TabVisible := true;
end;

procedure TprincipalF.RadioButton2Click(Sender: TObject);
begin
  suiTabSheet2.TabVisible := false;
  suiTabSheet3.TabVisible := true;
  suiTabSheet4.TabVisible := true;
  suiTabSheet5.TabVisible := true;
  suiTabSheet6.TabVisible := true;
end;

procedure TprincipalF.RadioButton4Click(Sender: TObject);
begin
  suiTabSheet2.TabVisible := true;
  suiTabSheet3.TabVisible := true;
  suiTabSheet4.TabVisible := true;
  suiTabSheet5.TabVisible := false;
  suiTabSheet6.TabVisible := false;
end;

procedure TprincipalF.FlatButton12Click(Sender: TObject);
var Str: String;
  csParams : PChar;
begin
  if IsWindows64 then begin
    Str := gsAppPath+'PROGRAMAS\REGISTRO\64bits.reg';
    csParams := PChar(Str); //converte a var string para pchar
    winexec(Pchar('cmd /c regedit.exe /s '+csParams),SW_hide);
  end else begin
    Str := gsAppPath+'PROGRAMAS\REGISTRO\32bits.reg';
    csParams := PChar(Str); //converte a var string para pchar
    winexec(Pchar('cmd /c regedit.exe /s '+csParams),SW_hide);
  end;
  Label21.Visible := true;
end;

procedure TprincipalF.FormShow(Sender: TObject);
begin
  suiPageControl1.Pages[5].Visible := false;
end;

end.




