spider91 На форуме oszone.net,
Serega_ дал [more=работающий скрипт]
var
n: Integer;
FreeMB, TotalMB: Cardinal;
VolumeName, FileSystemName: String;
VolumeSerialNo, MaxComponentLength, FileSystemFlags: Longint;
ListBox: TListBox;
StartMenuTreeView: TStartMenuFolderTreeView;
Info, InfoCaption: TNewStaticText;
InfoPanel: TPanel;
const
oneMB= 1024*1024;
WM_LBUTTONDOWN = 513;
WM_LBUTTONUP = 514;
function GetLogicalDrives: DWord; external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(nDrive: String): Longint; external 'GetDriveTypeA@kernel32.dll stdcall';
function GetVolumeInformation(PathName,VolumeName: PChar; VolumeNameSize,VolumeSerialNumber,MaxComponentLength,FileSystemFlags: Longint; FileSystemName: PChar; FileSystemNameSize: Longint): Longint; external 'GetVolumeInformationA@kernel32.dll stdcall';
function MessageBox(hWnd: Integer; lpText, lpCaption: String; uType: Cardinal): Integer; external 'MessageBoxA@user32.dll stdcall';
function enabledesc(ComponentsListHandle: HWND; DescLabelHandle: HWND; DescStrings: PChar): BOOL; external 'enabledesc@files:descctrl.dll stdcall';
function disabledesc(): BOOL; external 'disabledesc@files:descctrl.dll stdcall';
function ByteOrTB(Bytes: Extended; noMB: Boolean): String; { Перевод числа в значение бт/Кб/Мб/Гб/Тб (до 3х знаков после запятой)}
begin
if not noMB then Result:= FloatToStr(Int(Bytes)) +' Мб' else
if Bytes < 1024 then Result:= FloatToStr(Int(Bytes)) +' Бт' else
if Bytes/1024 < 1024 then Result:= FloatToStr(round((Bytes/1024)*10)/10) +' Кб' else
If Bytes/oneMB < 1024 then Result:= FloatToStr(round(Bytes/oneMB*100)/100) +' Мб' else
If Bytes/oneMB/1000 < 1024 then Result:= FloatToStr(round(Bytes/oneMB/1024*1000)/1000) +' Гб' else
Result:= FloatToStr(round(Bytes/oneMB/oneMB*1000)/1000) +' Тб'
StringChange(Result, ',', '.')
end;
function DelSP(String: String): String; { Удаление начальных, конечных и повторных пробелов }
begin
while (Pos(' ', String) > 0) do Delete(String, Pos(' ', String), 1);
Result:= Trim(String);
end;
function CutString(String: String; MaxLength: Longint): String; { Обрезать строку до заданного кол-ва символов}
begin
if Length(String) > MaxLength then Result:= Copy(String, 1, 6) +'...'+ Copy(String, Length(String) - MaxLength +9, MaxLength)
else Result:= String;
end;
procedure GetDiskInfo(Disk: String);
begin
FileSystemName:= StringOfChar(' ', 32); VolumeName:= StringOfChar(' ', 256);
GetVolumeInformation(Disk, VolumeName, 255, VolumeSerialNo, MaxComponentLength, FileSystemFlags, FileSystemName, 31);
FileSystemName:= DelSp(FileSystemName); VolumeName:= DelSp(VolumeName); if VolumeName='' then VolumeName:='без метки';
end;
procedure ListBoxRefresh; var FreeB, TotalB: Cardinal; Path, String: string;
begin
ListBox.Items.Clear
for n:= 1 to 31 do // диск 'А' пропустить
if (GetLogicalDrives and (1 shl n)) > 0 then
if (GetDriveType(Chr(ord('A') + n) +':\') = 2) or (GetDriveType(Chr(ord('A') + n) +':\') = 3) then
if GetSpaceOnDisk(Chr(ord('A') + n) +':\', True, FreeMB, TotalMB) then ListBox.Items.Add(Chr(ord('A') + n) +':');
for n:= 0 to ListBox.Items.Count -1 do begin
Path:= Copy(ListBox.Items[n],1,2) +'\' { если в накопителе нет диска, пропустить обновление }
if GetSpaceOnDisk(Path, False, FreeB, TotalB) and GetSpaceOnDisk(Path, True, FreeMB, TotalMB) then begin
GetDiskInfo(Path);
if FreeB >= $7FFFFFFF then
String:= PadL(ByteOrTB(FreeMB*oneMB, true),10) else String:= PadL(ByteOrTB(FreeB, true),10);
if TotalB >= $7FFFFFFF then begin
TotalB:= TotalMB; FreeB:= FreeMB;
String:= PadL(ByteOrTB(TotalMB*oneMB, true),11) +' всего -'+ String
end else
String:= PadL(ByteOrTB(TotalB, true),11) +' всего| '+ String;
ListBox.Items[n]:= Copy(Path,1,2) + String + PadL(FloatToStr(round(FreeB/TotalB*100)),3)+ '% своб|'+
PadL(FileSystemName,5)+ '| '+ CutString(VolumeName,9);
end;
end;
end;
procedure ObjectOnClick(Sender: TObject);
begin
Case TObject(Sender) of
ListBox:
for n:= 0 to ListBox.Items.Count-1 do if ListBox.Selected[n] then
WizardForm.DirEdit.Text:= Copy(ListBox.Items[n],1,1) +Copy(WizardForm.DirEdit.Text, 2, Length(WizardForm.DirEdit.Text))
StartMenuTreeView:
if StartMenuTreeView.Directory <> '' then
WizardForm.GroupEdit.Text:= StartMenuTreeView.Directory
else
WizardForm.GroupEdit.Text:= '{#SetupSetting("DefaultGroupName")}'
WizardForm.NoIconsCheck:
begin
WizardForm.GroupEdit.Enabled:= not (WizardForm.GroupEdit.Enabled);
StartMenuTreeView.Enabled:= WizardForm.GroupEdit.Enabled;
WizardForm.GroupBrowseButton.Enabled:= WizardForm.GroupEdit.Enabled
end;
end;
end;
function ShouldSkipPage(CurPage: Integer): Boolean;
begin
if Pos('/SP-', UpperCase(GetCmdTail)) > 0 then
case CurPage of
wpLicense, wpPassword, wpInfoBefore, wpUserInfo,
wpSelectDir, wpSelectProgramGroup, wpInfoAfter: Result := True;
end;
end;
procedure CurPageChanged(CurPageID: Integer);
begin
if (Pos('/SP-', UpperCase(GetCmdTail)) > 0) and
(CurPageID = wpSelectComponents) then
WizardForm.BackButton.Visible := False;
if CurPageID = wpSelectDir then ListBoxRefresh;
end;
//Будьте очень осторожны в таких случаях! Не позволим пользователю установить программу в уже существующую папку:
function NextButtonClick(CurPage: Integer): Boolean;
var
s, s2:string;
begin
Result:= True;
if (CurPage = wpSelectDir) and
(Pos(Uppercase(ExpandConstant('{win}')), Uppercase(ExpandConstant('{app}'))) > 0) then
Result:= MessageBox(StrToInt(ExpandConstant('{wizardhwnd}')), ExpandConstant('{cm:SysDirSelect}'),
'Установка в системную папку', MB_YESNO or $30) = idYes;
If CurPage = wpSelectDir then begin
s2:=ExpandConstant('{app}')+'';
If DirExists(s2) then begin
s:= 'Установка в существующую папку в целях безопасности невозможна!';
MsgBox(s, mbError, mb_Ok);
Result:=False;
end;
end;
end;
procedure InitializeWizard;
begin
if (Pos('/SP-', UpperCase(GetCmdTail)) > 0) then begin
PostMessage(WizardForm.NextButton.Handle, WM_LBUTTONDOWN, 0, 0);
PostMessage(WizardForm.NextButton.Handle, WM_LBUTTONUP, 0, 0);
end;
// WizardForm.NoIconsCheck.SetBounds(WizardForm.DiskSpaceLabel.Left + 96, WizardForm.DiskSpaceLabel.Top + 1,
// WizardForm.NoIconsCheck.Width, WizardForm.NoIconsCheck.Height);
// WizardForm.NoIconsCheck.OnClick:= @ObjectOnClick;
// WizardForm.NoIconsCheck.Parent:= WizardForm.SelectProgramGroupPage;
// WizardForm.NoIconsCheck.Show;
ListBox:= TListBox.Create(WizardForm)
ListBox.SetBounds(WizardForm.DirEdit.Left, WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + 8,
WizardForm.DirBrowseButton.Left + WizardForm.DirBrowseButton.Width - WizardForm.DirEdit.Left,
WizardForm.DiskSpaceLabel.Top - (WizardForm.DirEdit.Top + WizardForm.DirEdit.Height + 12));
ListBox.Font.Size:= 9;
ListBox.Font.Style:= [];
ListBox.Font.Name:= 'Courier New';
ListBox.OnClick:= @ObjectOnClick;
ListBox.Parent:= WizardForm.SelectDirPage;
// StartMenuTreeView:= TStartMenuFolderTreeView.Create(WizardForm);
// StartMenuTreeView.SetPaths(ExpandConstant('{userprograms}'), ExpandConstant('{commonprograms}'),
// ExpandConstant('{userstartup}'), ExpandConstant('{commonstartup}'));
// StartMenuTreeView.SetBounds(ListBox.Left, ListBox.Top, ListBox.Width, ListBox.Height);
// StartMenuTreeView.Parent:= WizardForm.SelectProgramGroupPage;
// StartMenuTreeView.Cursor:= crHand;
// StartMenuTreeView.OnChange:=@ObjectOnClick;
WizardForm.TYPESCOMBO.Visible:= false;
WizardForm.ComponentsList.Height := WizardForm.ComponentsList.Height + WizardForm.ComponentsList.Top - WizardForm.TYPESCOMBO.Top;
WizardForm.ComponentsList.Top := WizardForm.TYPESCOMBO.Top;
WizardForm.ComponentsList.Width := ScaleX(200);
InfoPanel := TPanel.Create(WizardForm);
InfoPanel.Parent := WizardForm.SelectComponentsPage;
InfoPanel.Caption := '';
InfoPanel.Top := WizardForm.ComponentsList.Top;
InfoPanel.Left := ScaleX(216);
InfoPanel.Width := ScaleX(200);
InfoPanel.Height := WizardForm.ComponentsList.Height;
InfoPanel.BevelInner := bvRaised;
InfoPanel.BevelOuter := bvLowered;
InfoCaption := TNewStaticText.Create(WizardForm);
InfoCaption.Parent := WizardForm.SelectComponentsPage;
InfoCaption.Caption := 'ГиКц';
InfoCaption.Left := ScaleX(224);
InfoCaption.Top := InfoPanel.Top - ScaleY(5);
InfoCaption.Font.Color := clActiveCaption;
Info := TNewStaticText.Create(WizardForm);
Info.Parent := InfoPanel;
Info.AutoSize := False;
Info.Left := ScaleX(6);
Info.Width := ScaleX(188);
Info.Top := ScaleY(12);
Info.Height := WizardForm.ComponentsList.Height - ScaleY(18);
Info.Caption := 'ТЖ¶ЇДгµДКу±кЦёХлµЅЧйјюЦ®ЙПЈ¬±гїЙјыµЅЛьµДГиКцЎЈ';
Info.WordWrap := true;
enabledesc(WizardForm.ComponentsList.Handle,Info.Handle,
'іМРтОДјюГиКц;'+
'°пЦъОДјюГиКц;'+
'ЧФКцОДјюГиКц;'+
'УўОДГиКц;'+
'µВОДГиКц;'+
'ЦРОДГиКц;'+
'¶нОДГиКцІвКФ#3B#3B°ьє¬#3BУўОД·ЦєЕ;'+
'ІвКФГиКц;'+
'ІвКФ1ГиКц;'+
'ІвКФ2ГиКц;'+
'ІвКФ3ГиКц;'+
'ІвКФ4ГиКц;'+
'ІвКФ5ГиКц;'+
'ІвКФ6ГиКц;'
);
end;
procedure DeinitializeSetup();
begin
disabledesc();
end;
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
var
Res: Integer;
begin
case CurUninstallStep of
usPostUninstall:
begin
//Проверяем присутствие папки после удаления
If DirExists(ExpandConstant('{app}')+'') then
//Создаем диалог с тремя кнопками
case MsgBox('Папка "'+ExpandConstant('{app}')+'" не пуста.'#13#13 +
'"Да" – полное удаление всех файлов в папке, включая саму папку.' #13#13 +
'"Нет" – открыть папку в проводнике, чтобы вручную удалить файлы.'#13#13 +
'"Отмена" – ничего не делать, удалить папку позже самостоятельно.', mbInformation, MB_YESNOCANCEL) of
IDYES:
begin
if not DelTree(ExpandConstant('{app}')+'', True, True, True) then
MsgBox('Папка не удалена.' #13#13 'Папка или один из файлов в ней задействованы другим приложением.', mbError, MB_OK);
end;
IDNO:
begin
if not ShellExec('open', ExpandConstant('{app}')+'', '', '', SW_SHOWMAXIMIZED, ewNoWait, Res) then
MsgBox('Ошибка открытия.' #13#13 'Папка не найдена.', mbError, MB_OK);
end;
IDCANCEL:
begin
end;
end;
end;
end;
end;[/more], за что ему огромное пассибо!
Единственный побочный эффект, это долгое закрытие инсталлятора. Но это я ещё могу пережить...
У самого не получается. При наведении на RadioButton показывает ошибку.