[saurn]

habib2302, держите

Секция кода

Код:

[Code]
#ifdef UNICODE
    #define A "W"
#else
    #define A "A"
#endif

const
    RT_RCDATA             = 10;
    APPID_IMAGE_COMPARER  = '%7B{D37E8E49-1AA3-401F-BA15-50AB88A2712D}';
    WAIT_OBJECT_0         = $0;
    STARTF_USESHOWWINDOW  = 1;
    NORMAL_PRIORITY_CLASS = $00000020;
    INFINITE              = $FFFFFFFF;

type
    _STARTUPINFO = record
        cb: DWORD;
        #ifdef UNICODE
            lpReserved, lpDesktop, lpTitle: PAnsiChar;
        #else
            lpReserved, lpDesktop, lpTitle: PChar;
        #endif
        dwX, dwY, dwXSize, dwYSize, dwXCountChars, dwYCountChars, dwFillAttribute, dwFlags: DWORD;
        wShowWindow, cbReserved2: Word;
        lpReserved2: Byte;
        hStdInput, hStdOutput, hStdError: THandle;
    end;

    _PROCESS_INFORMATION = record
        hProcess: THandle;
        hThread: THandle;
        dwProcessId: DWORD;
        dwThreadId: DWORD;
    end;

function SetWindowTheme(hwnd: HWND; pszSubAppName: pchar; pszSubIdList: pchar): Longint; external 'SetWindowTheme@uxtheme.dll stdcall delayload';
function CloseHandle(hObject: THandle): BOOL; external 'CloseHandle@kernel32.dll stdcall';
function WaitForSingleObject(hHandle: THandle; dwMilliseconds: DWORD): DWORD; external 'WaitForSingleObject@kernel32.dll stdcall';
#ifdef UNICODE
function CreateProcess(lpApplicationName, lpCommandLine: PAnsiChar; lpProcessAttributes, lpThreadAttributes: Longint; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment, lpCurrentDirectory: PAnsiChar; const lpStartupInfo: _STARTUPINFO; var lpProcessInformation: _PROCESS_INFORMATION): BOOL; external 'CreateProcess{#A}@kernel32.dll stdcall';
#else
function CreateProcess(lpApplicationName, lpCommandLine: PChar; lpProcessAttributes, lpThreadAttributes: Longint; bInheritHandles: BOOL; dwCreationFlags: DWORD; lpEnvironment, lpCurrentDirectory: PChar; const lpStartupInfo: _STARTUPINFO; var lpProcessInformation: _PROCESS_INFORMATION): BOOL; external 'CreateProcess{#A}@kernel32.dll stdcall';
#endif

var
 TDV: TFolderTreeView;
 TFV: TStartMenuFolderTreeView;
 ResultCode: Integer;
 lPLogo, bPicHandle, bPicHandle2, lPicHandle: THandle;
 BtnImage: TBitmapImage;
 CheckLicense: TCheckBox;
 iInitialize: Boolean;
 TB: TTrackBar;

function GetUninstallPath(const AppIds: array of String): array of String;
var
    StringList: TStringList;
    i, Len: Integer;
    Buff: String;
begin
    for i := 0 to GetArrayLength(AppIds)-1 do
    begin
        Buff := RemoveQuotes(ExpandConstant('{reg:HKLM\SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\' + AppIds[i] + '_is1,UninstallString|}'));
        if Buff <> '' then
        begin
            Len := GetArrayLength(Result);
            SetArrayLength(Result, Len+1);
            Result[Len] := Buff;
        end;
    end;
end;


procedure UninstallApps(const UninstallPathes: array of String);
var
    pi: _PROCESS_INFORMATION;
    si: _STARTUPINFO;
    i: Integer;
begin
    for i := 0 to GetArrayLength(UninstallPathes)-1 do
    begin
        si.cb := SizeOf(si);
        si.dwFlags := STARTF_USESHOWWINDOW;
        si.wShowWindow := SW_SHOWNORMAL;
        #ifdef UNICODE
        if not CreateProcess('', PAnsiChar(UninstallPathes[i]), 0, 0, False, NORMAL_PRIORITY_CLASS, '', '', si, pi) then
        #else
        if not CreateProcess('', PChar(UninstallPathes[i]), 0, 0, False, NORMAL_PRIORITY_CLASS, '', '', si, pi) then
        #endif
        begin
            MsgBox(SysErrorMessage(DLLGetLastError), mbCriticalError, MB_OK);
            Exit;
        end;
        try
            while WaitForSingleObject(pi.hProcess, INFINITE) <> WAIT_OBJECT_0 do Application.ProcessMessages;
        finally
            CloseHandle(pi.hProcess);
            CloseHandle(pi.hThread);
        end;
    end;
end;

function GetFromRes(const ResName, SaveFileName: String): Boolean;
var
  lResStream: TResourceStream;
begin
  lResStream := TResourceStream.Create(HInstance, ResName, RT_RCDATA);
  try
    lResStream.SaveToFile(AddBackslash(ExpandConstant('{tmp}')) + SaveFileName);
  finally
  lResStream.Free;
  Result := FileExists(AddBackslash(ExpandConstant('{tmp}')) + SaveFileName);
  end;
end;

//////////////////////////////////кликабельный лейбл
procedure BevelLabelClick(Sender: TObject);
 var ErrorCode: Integer;
 begin
 ShellExec('open','http://forum.oszone.net/member.php?u=334581','', '', SW_SHOW, ewNoWait, ErrorCode)
 end;
///////////////////////////////////////

function InitializeSetup(): Boolean;
var
    i, Len: Integer;
    uArray: array of String;
begin
    uArray := GetUninstallPath( ['{#SetupSetting("AppID")}', APPID_IMAGE_COMPARER] );
    Len := GetArrayLength(uArray);
    Result := Len = 0;
    if not Result then if MsgBox(CustomMessage('MsgUnins'), mbError, MB_YESNO) = IDYES then
    begin
        UninstallApps(uArray);
        Result := InitializeSetup();
    end;
end;

procedure LogoLabelOnClick(Sender: TObject);
begin
  ShellExec('open', 'http://www.imagecomparer.com/', '', '', SW_SHOWNORMAL, ewNoWait, ResultCode)
end;

procedure LicenseOnClick(Sender: TObject);
begin
  case TCheckBox(Sender).Checked of
     True: WizardForm.LicenseAcceptedRadio.Checked := True;
     False: WizardForm.LicenseNotAcceptedRadio.Checked := True;
  end;
end;

procedure TDVOnChange(Sender: TObject);
begin
  WizardForm.DirEdit.Text:= AddBackslash(TDV.Directory)+'{#MyAppName}'
end;

procedure TFVOnChange(Sender: TObject);
begin
  WizardForm.GroupEdit.Text:= AddBackslash(TFV.Directory)+'{#MyAppName}'
end;

function OnShouldSkipPage(Sender: TWizardPage): Boolean;
begin
  if WizardForm.ComponentsList.Items.Count > 0 then WizardForm.Tag:= 1; // отображаются страницы выбора папки и компонентов
end;

procedure TBOnChange(Sender: TObject);
begin
  SetTaskBarProgressValue(0, TTrackBar(sender).Position);
end;

procedure InitializeWizard;
begin
  WizardForm.LicenseNotAcceptedRadio.Hide;
  WizardForm.LicenseAcceptedRadio.Hide;
  WizardForm.LicenseMemo.Height := ScaleY(175);

  CheckLicense:= TCheckBox.Create(WizardForm);
  CheckLicense.Left:= ScaleX(0);
  CheckLicense.Top:= ScaleY(216);
  CheckLicense.Caption:= WizardForm.LicenseAcceptedRadio.Caption;
  CheckLicense.Width:= ScaleX(417);
  CheckLicense.OnClick:= @LicenseOnClick;
  CheckLicense.Parent:= WizardForm.LicensePage;
  with WizardForm do
  begin
    iInitialize := True;
    if GetFromRes('_IS_BOTVA', 'botva2.dll') and GetFromRes('_IS_B2P', 'b2p.dll') and GetFromRes('_IS_LOGO', 'logo.png') and GetFromRes('_IS_BPIC', 'bPic.png') and GetFromRes('_IS_LIPIC', 'LiPic.png') and GetFromRes('_IS_APIC', 'aPic.png') then
    begin
      bPicHandle := ImgLoad(WelcomePage.Handle, ExpandConstant('{tmp}\aPic.png'), WizardBitmapImage.Left, WizardBitmapImage.Top, WizardBitmapImage.Width, WizardBitmapImage.Height, True, True);
      WizardBitmapImage.Hide;
      ImgSetVisibility(bPicHandle, True);
      ImgApplyChanges(WelcomePage.Handle);

      bPicHandle := ImgLoad(FinishedPage.Handle, ExpandConstant('{tmp}\bPic.png'), WizardBitmapImage2.Left, WizardBitmapImage2.Top, WizardBitmapImage2.Width, WizardBitmapImage2.Height, True, True);
      WizardBitmapImage2.Hide;
      ImgSetVisibility(bPicHandle, True);
      ImgApplyChanges(FinishedPage.Handle);

      lPicHandle := ImgLoad(MainPanel.Handle, ExpandConstant('{tmp}\LiPic.png'), WizardSmallBitmapImage.Left, WizardSmallBitmapImage.Top, WizardSmallBitmapImage.Width, WizardSmallBitmapImage.Height, True, True);
      WizardSmallBitmapImage.Hide;
      ImgSetVisibility(lPicHandle, True);
      ImgApplyChanges(MainPanel.Handle);

      lPLogo:= ImgLoad(WizardForm.Handle, ExpandConstant('{tmp}\logo.png'), ScaleX(20), ScaleY(320), ScaleX(135), ScaleY(38), True, True);
      ImgApplyChanges(WizardForm.Handle);
    end;

    ExtractTemporaryFile('WinTB.dll');
    TaskBarV10(MainForm.Handle, WizardForm.Handle, false, false, 0, 0, _m_);
    TB:=TTrackBar.Create(Wizardform)

    TDV:= TFolderTreeView.Create(WizardForm);
    TDV.Top:= WizardForm.DirEdit.Top+28;
    TDV.Width:= 417;
    TDV.Height:= 100;
    TDV.OnChange:= @TDVOnChange;
    TDV.Parent:= WizardForm.SelectDirPage;

    TFV:= TStartMenuFolderTreeView.Create(nil);
    TFV.Top:= WizardForm.GroupEdit.Top+28;
    TFV.Width:= 417;
    TFV.Height:= 100;
    TFV.SetPaths(ExpandConstant('{userprograms}'),ExpandConstant('{commonprograms}'),ExpandConstant('{userstartup}'),ExpandConstant('{commonstartup}'));
    TFV.OnChange:= @TFVOnChange;
    TFV.Parent:= WizardForm.SelectProgramGroupPage;
    with TLabel.Create(WizardForm) do
    begin
      Parent:=WizardForm;
      AutoSize:=False;
      Transparent:= true;
      SetBounds(ScaleX(20), ScaleY(320), ScaleX(135), ScaleY(38));
      OnClick:=@LogoLabelOnClick;
      Cursor:= CrHand;
/////////////////////////////////////кликабельный лейбл
  with BeveledLabel do
  begin
 OnClick:=@BevelLabelClick;
 Font.Color:=clBlue;
 Enabled:=True;
 Cursor:=crHand;
 end;
 end;
 end;
 ///////////////////////////////////////
 end;

Procedure CurPageChanged(CurPageID: Integer);
Begin
  Case CurPageID of
    wpSelectTasks:
  begin
    WizardForm.NextButton.Caption:= SetupMessage(msgButtonInstall);
  end;
 end;
end;

procedure DeinitializeSetup();
begin
  if iInitialize then
  begin
    gdipShutdown;
    TaskBarDestroy;
  end;
end;

procedure UnLogoLabelOnClick(Sender: TObject);
begin
  ShellExec('open', 'http://www.imagecomparer.com/', '', '', SW_SHOWNORMAL, ewNoWait, ResultCode)
end;

procedure InitializeUninstallProgressForm;
begin
  with UninstallProgressForm do
    begin
      if GetFromRes('_IS_BOTVA', 'botva2.dll') and GetFromRes('_IS_B2P', 'b2p.dll') and GetFromRes('_IS_LOGO', 'logo.png') and GetFromRes('_IS_LIPIC', 'LIPic.png') then
      begin
        lPicHandle := ImgLoad(MainPanel.Handle, ExpandConstant('{tmp}\LiPic.png'), WizardSmallBitmapImage.Left, WizardSmallBitmapImage.Top, WizardSmallBitmapImage.Width, WizardSmallBitmapImage.Height, True, True);
        WizardSmallBitmapImage.Hide;
        ImgSetVisibility(lPicHandle, True);
        ImgApplyChanges(MainPanel.Handle);

        lPLogo:= ImgLoad(UninstallProgressForm.Handle, ExpandConstant('{tmp}\logo.png'), ScaleX(20), ScaleY(320), ScaleX(135), ScaleY(38), True, True);
        ImgApplyChanges(UninstallProgressForm.Handle);
      end;

    with TLabel.Create(nil) do
    begin
      Parent:=UninstallProgressForm;
      AutoSize:=False;
      Transparent:= true;
      SetBounds(ScaleX(20), ScaleY(320), ScaleX(135), ScaleY(38));
      OnClick:=@UnLogoLabelOnClick;
      Cursor:= CrHand;
/////////////////////////////////////кликабельный лейбл
  with BeveledLabel do
  begin
 OnClick:=@BevelLabelClick;
 Font.Color:=clBlue;
 Enabled:=True;
 Cursor:=crHand;
 end;
 end;
 end;
 ///////////////////////////////////////
 end;

procedure DeinitializeUninstall();
begin
  gdipShutdown;
end;