Старожил
Сообщения: 440
Благодарности: 251
|
Профиль
|
Сайт
|
Отправить PM
| Цитировать
ROMKA-1977,
Держи
Код:  #ifndef IS_ENHANCED
#error Для компилляции этого скрипта нужна расширенная версия Inno Setup (restools).
#endif
#ifdef UNICODE
#error Этот скрипт не работает на UNICODE версии Inno Setup. Используйте ANSI версию Inno Setup.
#endif
[Setup]
AppName=DisksInfo
VersionInfoVersion=5.0
AppVerName=DisksInfo
DefaultDirName={pf}\My program
EnableDirDoesntExistWarning=true
OutputDir=.
[CustomMessages]
Ru.SysDirSelect=Выбранный путь включает в себя системную папку!%nВы уверены, что необходимо продолжать установку?
[Languages]
Name: Ru; MessagesFile: compiler:Languages\Russian.isl
[code]
var
n: Integer;
FreeMB, TotalMB: Cardinal;
VolumeName, FileSystemName: String;
VolumeSerialNo, MaxComponentLength, FileSystemFlags: Longint;
ListBox: TListBox;
InfoForm: TSetupForm;
Info, Ok: TButton;
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 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;
procedure Okclick(Sender: TObject);
begin
InfoForm.Close;
WizardForm.Enabled:= True;
end;
procedure FormClose(Sender: TObject; var Action: TCloseAction);
begin
WizardForm.Enabled:=true;
end;
procedure InfoClick(Sender: TObject);
begin
InfoForm.Show;
WizardForm.Enabled:=false;
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));
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;
Info.Visible:= CurPageID = wpSelectDir;
end;
procedure InitializeWizard;
begin
InfoForm:= CreateCustomForm();
with InfoForm do begin
ClientWidth := ScaleX(450);
ClientHeight := ScaleY(230);
CenterInsideControl(WizardForm, False);
Caption:='Info';
onClose:=@FormClose;
Ok:=tbutton.create(InfoForm);
with Ok do begin
SetBounds(ScaleX(365),ScaleY(200),ScaleX(75),ScaleY(23));
parent:=InfoForm;
Caption:='OK';
onclick:=@OKclick;
end;
ListBox:= TListBox.Create(InfoForm);
with ListBox do begin
SetBounds(ScaleX(10),ScaleY(10),ScaleX(430),ScaleY(185));
Font.Size:= 9;
Font.Style:= [fsBold];
Font.Name:= 'Courier New';
OnClick:= @ObjectOnClick;
Parent:= InfoForm;
end;
end;
Info:= tbutton.create(WizardForm);
with Info do begin
Parent:= WizardForm;
SetBounds(ScaleX(10),ScaleY(327),ScaleX(75),ScaleY(23));
Caption:= 'Info';
OnClick:= @InfoClick;
end;
end;
---------------------------------------------------------------------------------------------------------
Цитата Dodakaedr:
|
а по поводу ключей не подскажите? »
|
Придумал только так, через одно место. Умные люди может что лучше предложат.
Код: #define MyAppName "My programm"
#define MyAppVersion "1.5"
[Setup]
AppName={#MyAppName}
AppVersion={#MyAppVersion}
DefaultDirName={pf}\{#MyAppName}
OutputDir=.
Compression=lzma
SolidCompression=yes
VersionInfoDescription={#MyAppName}
VersionInfoVersion={#MyAppVersion}
[Code]
function GetValue(strFilename,keyFind: string; var tvalue: AnsiString): AnsiString;
var
str: AnsiString;
begin
LoadStringFromFile(strFilename, str);
if Pos(keyFind,str)>0 then begin
Delete(str,1,Pos(keyFind,str)+Length(keyFind));
tvalue:= str;
Result:= tvalue;
Exit;
end;
end;
function InitializeSetup(): Boolean;
var
RCode: Integer;
S, S1, PathName, RegKey, RegKey_1, RegKey_2, RegKey_3: AnsiString;
begin
PathName:= ExpandConstant('{src}\Data\Settings');
ForceDirectories(PathName);
RegKey_1:= 'HKEY_CLASSES_ROOT\.mpa';
RegKey_2:= 'HKEY_CLASSES_ROOT\.mp2';
RegKey_3:= 'HKEY_CLASSES_ROOT\.mp3';
if DirExists(PathName) then begin
Exec('regedit.exe', Format('-ea "%s\Soft.reg" "%s"', [PathName, RegKey_1]), '', SW_SHOW, ewWaitUntilTerminated, RCode);
Exec('regedit.exe', Format('-ea "%s\tmp1.reg" "%s"', [PathName, RegKey_2]), '', SW_SHOW, ewWaitUntilTerminated, RCode);
Exec('regedit.exe', Format('-ea "%s\tmp2.reg" "%s"', [PathName, RegKey_3]), '', SW_SHOW, ewWaitUntilTerminated, RCode);
end;
GetValue(PathName+'\tmp1.reg','REGEDIT4',S);
GetValue(PathName+'\tmp2.reg','REGEDIT4',S1);
SaveStringToFile(PathName+'\Soft.reg', S + S1, true);
DeleteFile(PathName+'\tmp1.reg');
DeleteFile(PathName+'\tmp2.reg');
Result:= False;
end;
|
