Ветеран
Сообщения: 649
Благодарности: 444
|
Профиль
|
Отправить PM
| Цитировать
раньше под свои нужды использовал код ...\Inno Setup 5\Scripts\Dobrov\DisksInfoBox.iss
а именно:
читать дальше »
Код:  [Setup]
AppName=DisksInfo
VersionInfoVersion=5.0
AppVerName=DisksInfo
DefaultDirName={pf}\My program
EnableDirDoesntExistWarning=true
[CustomMessages]
Ru.SysDirSelect=Выбранный путь включает в себя системную папку!%nВы уверены, что необходимо продолжать установку?
[Languages]
Name: Ru; MessagesFile: compiler:Languages\Russian.isl
[Icons]
Name: {group}\Notepad; Filename: notepad.exe
[code]
var n: Integer; FreeMB, TotalMB: Cardinal; VolumeName, FileSystemName: String; VolumeSerialNo, MaxComponentLength, FileSystemFlags: Longint; ListBox: TListBox; StartMenuTreeView: TStartMenuFolderTreeView;
const oneMB= 1024*1024;
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 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 NextButtonClick(CurPageID: Integer): Boolean; 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;
End;
Procedure CurPageChanged(CurPageID: Integer);
Begin
if CurPageID = wpSelectDir then ListBoxRefresh
End;
Procedure InitializeWizard;
Begin
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:= [fsBold]
ListBox.Font.Name:= 'Courier New';
ListBox.OnClick:= @ObjectOnClick;
ListBox.Parent:= WizardForm.SelectDirPage;
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
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
End;
но вот намутил свою версию (пол дня убил на код). В отличии от кода выше мой код работает на юникодной инно, но почему-то на ней криво определяет размер и свободное пространство хардов. На ANSI всё в порядке
Добрые люди, у меня 3 просьбы:
1: Поздравить меня 
2: Проверить код (да да как в школе училка проверяла) и по возможности исправить/улучшить
3: хоть оно мне и не нужно, но если получится исправить косяк с юникодной инно, то скрипт может пригодиться ещё кое-кому (хотя там при желании можно заюзать родной GetSpaceOnDisk)
вот ранняя версия (только заполнение листбокса):
читать дальше »
Код: [Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program
[code]
#ifdef UNICODE
#define A "W"
#else
#define A "A"
#endif
type
PDWORD = DWORD;
const
DRIVE_REMOVABLE = $2;
DRIVE_FIXED = $3;
DRIVE_REMOTE = $4;
DRIVE_CDROM = $5;
DRIVE_RAMDISK = $6;
MAX_PATH = 260;
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';
function GetVolumeInformation(lpRootPathName: String; lpVolumeNameBuffer: String; nVolumeNameSize: DWORD; lpVolumeSerialNumber: PDWORD; var lpMaximumComponentLength, lpFileSystemFlags: DWORD; lpFileSystemNameBuffer: String; nFileSystemNameSize: DWORD): BOOL; external 'GetVolumeInformation{#A}@kernel32.dll stdcall';
function GetDriveType(lpRootPathName: String): UINT; external 'GetDriveType{#A}@kernel32.dll stdcall';
function GetDiskFreeSpace(lpRootPathName: String; var lpSectorsPerCluster, lpBytesPerSector, lpNumberOfFreeClusters, lpTotalNumberOfClusters: DWORD): BOOL; external 'GetDiskFreeSpace{#A}@kernel32.dll stdcall';
//function GetLogicalDriveStrings(nBufferLength: DWORD; lpBuffer: String): DWORD; external 'GetLogicalDriveStrings{#A}@kernel32.dll stdcall';
function BytesToSize(Bytes: Extended): String;
var
pszBuf: array [0..15] of Char;
begin
try
Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
except end;
end;
function GetDrivesInfo: array of string;
var
i: Integer;
UndefDriveLetter: String;
DriveType: UINT;
DriveSpecFullString: String;
DrivePath: string;
VolumeName, FileSystemName : string;
ComponentLength, SerialNumber, FileSystemFlags: DWORD;
Sec_Cluster, Bytes_Sec, Free_Clusters, Total_Clusters : DWORD;
begin
for i := 65 to 90 do // Loop from A..Z to determine available drives
begin
UndefDriveLetter := chr(i) + ':\';
DriveType := GetDriveType(UndefDriveLetter);
case DriveType of
// 0: DriveSpecFullString := UndefDriveLetter + ' Тип накопителя не может быть определен.';
// 1: DriveSpecFullString := UndefDriveLetter + ' Корневая директория не существует.';
DRIVE_REMOVABLE:
begin
VolumeName := StringOfChar(#32, MAX_PATH);
FileSystemName := StringOfChar(#32, MAX_PATH);
GetVolumeInformation(UndefDriveLetter, VolumeName, MAX_PATH, SerialNumber, ComponentLength, FileSystemFlags, FileSystemName, MAX_PATH);
GetDiskFreeSpace(UndefDriveLetter, Sec_Cluster, Bytes_Sec, Free_Clusters, Total_Clusters);
if Trim(VolumeName) = '' then VolumeName := 'Без имени';
DriveSpecFullString :=
'Внешний диск: ' + UndefDriveLetter + ' // ' +
'Имя: ' + Trim(VolumeName) + ' // ' +
'Файловая система: ' + Trim(FileSystemName) + ' // ' +
'Общий размер: ' + BytesToSize(Bytes_Sec * Sec_Cluster * Total_Clusters) + ' // ' +
'Доступно: ' + BytesToSize(Bytes_Sec * Sec_Cluster * Free_Clusters);
SetArrayLength(Result, GetArrayLength(Result)+1);
Result[GetArrayLength(Result)-1] := DriveSpecFullString;
end;
DRIVE_FIXED:
begin
VolumeName := StringOfChar(#32, MAX_PATH);
FileSystemName := StringOfChar(#32, MAX_PATH);
GetVolumeInformation(UndefDriveLetter, VolumeName, MAX_PATH, SerialNumber, ComponentLength, FileSystemFlags, FileSystemName, MAX_PATH);
GetDiskFreeSpace(UndefDriveLetter, Sec_Cluster, Bytes_Sec, Free_Clusters, Total_Clusters);
if Trim(VolumeName) = '' then VolumeName := 'Без имени';
DriveSpecFullString :=
'Внутренний диск: ' + UndefDriveLetter + ' // ' +
'Имя: ' + Trim(VolumeName) + ' // ' +
'Файловая система: ' + Trim(FileSystemName) + ' // ' +
'Общий размер: ' + BytesToSize(Bytes_Sec * Sec_Cluster * Total_Clusters) + ' // ' +
'Доступно: ' + BytesToSize(Bytes_Sec * Sec_Cluster * Free_Clusters);
SetArrayLength(Result, GetArrayLength(Result)+1);
Result[GetArrayLength(Result)-1] := DriveSpecFullString;
end;
// DRIVE_REMOTE: DriveSpecFullString := UndefDriveLetter+ ' Удаленный (сетевой) диск: ';
// DRIVE_CDROM: DriveSpecFullString := UndefDriveLetter + ' Устройство - CD-ROM: ';
// DRIVE_RAMDISK: DriveSpecFullString := UndefDriveLetter + ' Устройство - RAM диск: ';
end;
end;
end;
procedure InitializeWizard;
var
ReadyArray: array of string;
DriveListBox: TListBox;
i: Integer;
begin
ReadyArray := GetDrivesInfo;
WizardForm.OuterNotebook.Hide;
WizardForm.Width := 600;
DriveListBox := TListBox.Create(nil)
with DriveListBox do
begin
Parent := WizardForm;
SetBounds(0, 0, WizardForm.Width, WizardForm.Height - 100);
for i := 0 to GetArrayLength(ReadyArray)-1 do Items.Add(ReadyArray[i]);
end;
end;
PS: и меня смущает как я поступил с указателем
Код:
type
PDWORD = DWORD;
|
