Ветеран
Сообщения: 517
Благодарности: 314
|
Профиль
|
Отправить PM
| Цитировать
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;
|
