Имя пользователя:
Пароль:  
Помощь | Регистрация | Забыли пароль?  

Показать сообщение отдельно

Ветеран


Сообщения: 1133
Благодарности: 581

Профиль | Отправить PM | Цитировать


Raf-9600,
читать дальше »
Код: Выделить весь код
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 CurPageID = 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;

-------
Книги нужны, чтобы напоминать человеку, что его оригинальные мысли не так уж новы... Авраам Линкольн.

Это сообщение посчитали полезным следующие участники:

Отправлено: 01:05, 05-05-2009 | #681