Ru-Board.club
← Вернуться в раздел «Программы»

» Inno Setup (создание инсталяционных пакетов)

Автор: Sampron
Дата сообщения: 18.04.2007 01:09
Sero
Да я тоже заметил что если вернуться назад со страницы wpReady то текст остается.
Автор: DenVl
Дата сообщения: 18.04.2007 01:12
Sero

Цитата:
но не получил результат!

Свободное место в процентах у тебя не выводится что ли?
Извини тада не знаю, у меня все работает...я в Паскале не силен, а round использовал потому что где уже видел пример с его использованием.
Вот то что у меня получилось
Автор: Sampron
Дата сообщения: 18.04.2007 01:17
DenVl
Твой код прекрасно пашет!
Автор: Sero
Дата сообщения: 18.04.2007 01:20

Цитата:
Твой код прекрасно пашет!

Согласен!


Цитата:
Свободное место в процентах у тебя не выводится что ли?

Да,именно это.
Автор: GRom V
Дата сообщения: 18.04.2007 01:37
NightW0lf

Цитата:
Вот тебе код

Спасибо
Автор: EagleSH
Дата сообщения: 18.04.2007 08:38
народ, на сколько нужно делить, чтоб получить гигабайт? на 1048576 или 1024 или 1000

шота меня климануло

и еще при делении чегото всегда целые числа, как отображать до 2-х знаков после запятой?
Автор: Chuvakstepan
Дата сообщения: 18.04.2007 11:05
EagleSH
Гигабайт будет выглядеть так: 1073741824 (в байтах)
Автор: Sampron
Дата сообщения: 18.04.2007 12:35
Люди а как можно на новый TPanel наложить TBitmapImage?
Автор: EagleSH
Дата сообщения: 18.04.2007 12:43
братцы, переведите эту строку в Гб плиз

ListBox.Items.Add(Path + ' - Всего: ' + IntToStr(TotalMB) +
'Гб - Свободно: ' + IntToStr(FreeMB) + 'Гб');
Автор: Sero
Дата сообщения: 18.04.2007 12:58
EagleSH
Все что я могу это так:
Замени процедуру InitializeWizard(); на эту:


Код:
procedure InitializeWizard();
var
Path: String;
FreeMB, TotalMB: Cardinal;
drives: DWORD;
i: integer;
oneGB:Longint;
begin
ListBox:= TListBox.Create(WizardForm);
ListBox.Top:= 120;
ListBox.Width:= 260;
ListBox.Height:= ScaleY(90);
ListBox.Parent:= WizardForm.SelectDirPage;
ListBox.OnClick:= @ListBoxOnClick;
ListBox.Font.Name:='Arial Black'
ListBox.Font.Color:=clBlack;

oneGB := 1024

drives:= GetLogicalDrives();
for i:= 0 to 31 do
begin
if (drives and (1 shl i)) > 0 then
begin
Path:= chr(ord('A')+i)+':';
if GetDriveType(Path) = DRIVE_FIXED then
begin
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
ListBox.Items.Add(Path + IntToStr(round(FreeMB/TotalMB*100)) +'%'+' - Всего: ' + IntToStr(TotalMB/oneGB) +
'GB - Свободно: ' + IntToStr(FreeMB/oneGB) + 'GB');
end;
end;
end;
end;
Автор: Sampron
Дата сообщения: 18.04.2007 18:13
Сделал!!! Повесил текстуру на кнопку, блин, теперь прийдётся все скины переделать. Пример забираем здесь:
http://data.cod.ru/841711050
Автор: Sero
Дата сообщения: 18.04.2007 20:23
Sampron
Красиво!

P.S. Скинь пожалуйста BMP кнопку без текста.
Автор: Sampron
Дата сообщения: 18.04.2007 20:35
Sero
Кнопки выдрал с темы висты забирай:
http://data.cod.ru/842825162
Автор: Drez
Дата сообщения: 18.04.2007 21:04
кто знает как разрешить проблему:
есть строка
procedure CurStepChanged(CurStep: TSetupStep);
begin
//В начале этапа установки запускаем слайд-шоу
if CurStep=ssInstall
then
begin
ExtractTemporaryFile('2.jpg');

есть другая строка
procedure CurPageChanged(CurPageID: Integer);
begin
if CurPageID = wpPassword then
WizardForm.NextButton.OnClick(WizardForm.NextButton);
end;

но как обьеденить не знаю, пишу две комманды - он говорит что повоторяется procedure CurStepChanged, пишу в одном он не понимает что такое CurPageID
Автор: Sero
Дата сообщения: 18.04.2007 21:17
Drez
У тебя две разные процедуры:
procedure CurStepChanged(CurStep: TSetupStep) и procedure CurPageChanged(CurPageID : Integer)

CurPageID используй в procedure CurPageChanged(CurPageID : Integer)
CurStep в CurStepChanged(CurStep: TSetupStep)

Добавлено:
Sampron
Спасибо!
Автор: Drez
Дата сообщения: 18.04.2007 21:29
всё равно не пашет
вот скрин -
Автор: Sampron
Дата сообщения: 18.04.2007 22:06
Sero
Незнаешь как можно сделать чтоб при нажатии на кнопку менялся рисунок?
Автор: Sero
Дата сообщения: 18.04.2007 22:25
Sampron
На какую кнопку?
Drez
Дай скрипт и сделаю!
Автор: Sampron
Дата сообщения: 18.04.2007 22:37
Sero
Которая в примере тоесть чтоб в темп копировалось два рисунка и при нажатии грузился другой рисунок.
Автор: Sero
Дата сообщения: 18.04.2007 22:45
Sampron

Код:
[Files]
Source: Button.bmp; Flags: dontcopy
Source: Button2.bmp; Flags: dontcopy

[Code]
var
BtnPanel: TPanel;
BtnImage: TBitmapImage;

procedure BtnOnClick(Sender :TObject);
begin
ExtractTemporaryFile('Button2.bmp')
BtnImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Button2.bmp'));
end;

procedure InitializeWizard();
begin
BtnPanel:=TPanel.Create(WizardForm)
with BtnPanel do begin
Left:=20
Top:=325
Width:=132
Height:=27
Cursor:=crHand
OnClick:=@BtnOnClick
Parent:=WizardForm
end
BtnImage:=TBitmapImage.Create(WizardForm)
with BtnImage do begin
AutoSize:=True
Enabled:=False
ExtractTemporaryFile('Button.bmp')
Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\Button.bmp')
Parent:=BtnPanel
end
end;
Автор: Sampron
Дата сообщения: 18.04.2007 23:05
мда такое в инно наверно нереально сделать
Автор: Sero
Дата сообщения: 18.04.2007 23:14
Sampron
О чем ты?
Автор: Sampron
Дата сообщения: 18.04.2007 23:38
Вот пример того что нужно:
(2,3мб) http://data.cod.ru/844594634
Автор: Ded_PiXto
Дата сообщения: 19.04.2007 00:39
Ну вот вроде сайлент инсталл :


Цитата:

[Setup]
AppName=My Program
AppVerName=My Program 1.5
DefaultDirName={pf}\My Program
DisableDirPage=yes
DisableProgramGroupPage=yes
DisableReadyPage=yes
DisableFinishedPage=yes
OutputBaseFilename=setup

[Files]
Source: "C:\My Program\*"; DestDir: "{app}"; Flags: ignoreversion recursesubdirs createallsubdirs

[Code]
procedure CurPageChanged(CurPageID: Integer);
begin
If CurPageID=wpWelcome then
begin
SendMessage(WizardForm.NEXTBUTTON.Handle, 513, 0, 0)
SendMessage(WizardForm.NEXTBUTTON.Handle, 514, 0, 0)
end;
end;
Автор: GRom V
Дата сообщения: 19.04.2007 02:35
Sampron

Цитата:
забираем здесь:
http://data.cod.ru/841711050

как обьединить твой скрипт и например этот, т е чтоб проверка производилась при нажатии кнопки тест?

const
NeedSize = 20;
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVEABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;

var
ListBox: TListBox;
Text: TNewStaticText;

function GetVideoCardName(): PChar;
external 'hwc_GetVideoCardName@files:get_hw_caps.dll stdcall';

function GetSoundCardName(): PChar;
external 'hwc_GetSoundCardName@files:get_hw_caps.dll stdcall';

function DetectHardware(): Integer;
external 'hwc_DetectHardware@files:get_hw_caps.dll stdcall';

function GetHardDriveFreeSpace(hdd: integer): Integer;
external 'hwc_GetHardDriveFreeSpace@files:get_hw_caps.dll stdcall';

function GetHardDriveName(hdd: integer): PChar;
external 'hwc_GetHardDriveName@files:get_hw_caps.dll stdcall';

function GetHardDriveTotalSpace(hdd: integer): Integer;
external 'hwc_GetHardDriveTotalSpace@files:get_hw_caps.dll stdcall';

function GetHardDrivesCount(): Integer;
external 'hwc_GetHardDrivesCount@files:get_hw_caps.dll stdcall';

function GetSoundCards(): Integer;
external 'hwc_GetSoundCards@files:get_hw_caps.dll stdcall';

function GetSystemPage(): Integer;
external 'hwc_GetSystemPage@files:get_hw_caps.dll stdcall';

function GetSystemPhys(): Integer;
external 'hwc_GetSystemPhys@files:get_hw_caps.dll stdcall';

function GetVidMemLocal(): Integer;
external 'hwc_GetVidMemLocal@files:get_hw_caps.dll stdcall';

function GetVidMemNonLocal(): Integer;
external 'hwc_GetVidMemNonLocal@files:get_hw_caps.dll stdcall';

function GetVideoCardDev(): Integer;
external 'hwc_GetVideoCardDev@files:get_hw_caps.dll stdcall';

function GetVideoCardVen(): Integer;
external 'hwc_GetVideoCardVen@files:get_hw_caps.dll stdcall';

function GetLogicalDrives: DWORD;
external 'GetLogicalDrives@kernel32.dll stdcall';

function GetDriveType(nDrive: string): Longint;
external 'GetDriveTypeA@kernel32.dll stdcall';

function DelSp(const s: string): string; //функция удаления табуляции и пробелов в начале строки
var
c, i: integer;
stt, st, st1: string;
begin
c := 0;
st := s;

for i := 1 to Length(st) do
begin

stt := copy(st, i, 1);
if (stt = ' ') and (c >= 1) then
begin
st1 := st1;
c := c + 1;
end
else if (stt = ' ') and (c = 0) then
begin
c := c + 1;
st1 := st1 + stt;
end
else if (stt <> ' ') then
begin
c := 0;
st1 := st1 + stt;
end
end;

Result := st1;
end;

function CheckSystemPage(PreviousPageId: Integer): Integer;
var
Page: TWizardPage;
ProcessorName: string;

Processor, VideoCardPanel, AudioCardPanel, RAMPanel, PageFilePanel: TMemo;
ProcessorNamePanel, VideoCardNamePanel, AudioCardNamePanel, RAMTotalPanel, PageFileTotalPanel: TMemo;

ProcessorMHZ: Cardinal;
StaticText, StaticText2: TNewStaticText;
VidRam: integer;
begin
RegQueryStringValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', 'ProcessorNameString', ProcessorName);
RegQueryDWordValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', '~MHz', ProcessorMHZ);
GetVidMemLocal;
GetSoundCards;

Page := CreateCustomPage(PreviousPageId, 'Аппаратное Обеспечение', 'Программа установки обнаружила следующие необходимые компоненты');

StaticText := TNewStaticText.Create(Page);
with StaticText do
begin
Parent := Page.Surface;
Caption := 'Все компоненты соответствуют требованиям игры.';
Left := 0;
Top := 0;
AutoSize := True;
end;

StaticText2 := TNewStaticText.Create(Page);
with StaticText2 do
begin
Parent := Page.Surface;
Caption := 'Когда Вы будите, готовы продолжить установку, нажмите «Далее».';
Left := 0;
Top := 220;
AutoSize := True;
end;

//******************************************* [Начало - Процессор] ***************************************************//

Processor := TMemo.Create(Page);
with Processor do
begin
Text := ' Процессор';
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(30);
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := clBtnFace;
end;


ProcessorNamePanel := TMemo.Create(Page);
with ProcessorNamePanel do
begin
Text := DelSP(ProcessorName) + ' ' + IntToStr(ProcessorMHZ) + 'MHz'; //новое обработанное значение строки
//Caption :=ProcessorName+' '+IntToStr(ProcessorMHZ)+'MHz' ;
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := ScaleY(30);
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := $CCFFCC;
end;

if ProcessorMHZ < 1800 then //Минимальное количество частоты в MHz
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
ProcessorNamePanel.Color := $CCCCFF;
end;


//******************************************* [Конец - Процессор] ****************************************************//


//******************************************* [Начало - Видеоадаптер] ************************************************//

VideoCardPanel := TMemo.Create(Page);
with VideoCardPanel do
begin
Text := ' Видеоадаптер';
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := Processor.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := clBtnFace;
end;

VideoCardNamePanel := TMemo.Create(Page);
with VideoCardNamePanel do
begin
Text := ' ' + GetVideoCardName; //+' ОЗУ-'+inttostr(round(GetVidMemLocal/1000000))+' МБ';
//Caption:=' ОЗУ-'+inttostr(GetVidMemLocal)+' МБ';
Alignment := taLeftJustify;
Parent := Page.Surface;

VidrAM := GetVidMemLocal / 1000000;

if VidRam > 127 then
begin
if VidRam < 200 then Text := Text + ' ОЗУ - 128 МB'
else if VidRam < 300 then Text := Text + ' ОЗУ - 256 МB'
else if VidRam < 400 then Text := Text + ' ОЗУ - 384 МB'
else if VidRam > 500 then Text := Text + ' ОЗУ - 512 МB';
end;

Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := VideoCardPanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := $CCFFCC;
end;

if GetVidMemLocal < 127000000 then //Минимальное объем ОЗУ [в байтах] у видеоадаптера 128 MB
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
VideoCardNamePanel.Color := $CCCCFF;
end;

//******************************************* [Конец - Видеоадаптер] *************************************************//


//******************************************* [Начало - Звуковая карта] **********************************************//

AudioCardPanel := TMemo.Create(Page);
with AudioCardPanel do
begin
Text := ' Звуковая карта';
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := VideoCardPanel.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := clBtnFace;
end;

AudioCardNamePanel := TMemo.Create(Page);
with AudioCardNamePanel do
begin
Text := ' ' + GetSoundCardName;
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := AudioCardPanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := $CCFFCC;
end;

if
GetSoundCards = 0 then
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
AudioCardNamePanel.Color := $CCCCFF;
end;

//******************************************* [Конец - Звуковая карта] ***********************************************//


//******************************************* [Начало - ОЗУ] *********************************************************//

RAMPanel := TMemo.Create(Page);
with RAMPanel do
begin
Text := ' ОЗУ';
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := AudioCardPanel.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := clBtnFace;
end;

RAMTotalPanel := TMemo.Create(Page);
with RAMTotalPanel do
begin
Text := ' ' + IntToStr(GetSystemPhys + 1) + ' MB';
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := RAMPanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := $CCFFCC;
end;

if GetSystemPhys + 1 < 1024 then //Минимальное объем ОЗУ 1 Гб или 1024 Мб
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
RAMTotalPanel.Color := $CCCCFF;
end;

//******************************************* [Конец - ОЗУ] **********************************************************//


//******************************************* [Начало - Файл подкачки] ***********************************************//

PageFilePanel := TMemo.Create(Page);
with PageFilePanel do
begin
Text := ' Файл подкачки';
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(0); //оригинал S.T.A.L.K.E.R.
Top := RAMPanel.Top + 27;
Width := ScaleX(106); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := clBtnFace;
end;

PageFileTotalPanel := TMemo.Create(Page);
with PageFileTotalPanel do
begin
Text := ' ' + IntToStr(GetSystemPage) + ' MB';
Alignment := taLeftJustify;
Parent := Page.Surface;

Left := ScaleX(110); //оригинал S.T.A.L.K.E.R.
Top := PageFilePanel.Top;
Width := ScaleX(304); //оригинал S.T.A.L.K.E.R.
Height := ScaleY(22); //оригинал S.T.A.L.K.E.R.

ReadOnly := True;
Color := $CCFFCC;
end;

if GetSystemPage < 1024 then //Минимальное объем файла [в мегабайтах] подкачки 1 Гб или 1024 Мб
begin
StaticText.Caption := 'Не все компоненты удовлетворяют требованиям игры.';
PageFileTotalPanel.Color := $CCCCFF;
end;

Result := Page.ID;
end;

//******************************************* [Конец - Файл подкачки] ************************************************//

procedure ListBoxOnClick(Sender: TObject);
var
NewLetter, OldString: string;
i: Integer;
begin
for i := 0 to ListBox.Items.Count - 1 do
begin
if ListBox.Selected[i] then
begin
NewLetter := Copy(ListBox.Items[i], 0, 1);
OldString := Copy(WizardForm.DirEdit.Text, 2, Length(WizardForm.DirEdit.Text));
WizardForm.DirEdit.Text := NewLetter + OldString;
end;
end;
end;

procedure InitializeWizard();
var
Page: TWizardPage;
Text: TNewStaticText;
Memo: TMemo;
Path: string;
FreeMB, TotalMB: Cardinal;
drives: DWORD;
i: integer;
begin
CheckSystemPage(wpLicense);

Text := TNewStaticText.Create(WizardForm);
Text.Top := 102;
Text.Width := 332;
Text.Height := 14;
Text.Caption := 'Список жестких дисков и свободного места';
Text.Parent := WizardForm.SelectDirPage;

ListBox := TListBox.Create(WizardForm);
ListBox.Top := 120;
ListBox.Width := 332;
ListBox.Height := ScaleY(90);
ListBox.Parent := WizardForm.SelectDirPage;
ListBox.OnClick := @ListBoxOnClick;
ListBox.Font.Style := [fsBold];
ListBox.Font.Name := 'Courier New';
ListBox.Font.Size := 10;
ListBox.Color := clBtnFace;

drives := GetLogicalDrives();
for i := 0 to 31 do
begin
if (drives and (1 shl i)) > 0 then
begin
Path := chr(ord('A') + i) + ':\';
if GetDriveType(Path) = DRIVE_FIXED then
begin
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
ListBox.Items.Add(Path + ' '+ IntToStr(round(FreeMB/TotalMB*100)) + '% ' + IntToStr(FreeMB) + ' MB');

end;
end;
end;
end;

function NextButtonClick(CurPageID: Integer): Boolean;
var
Path: string;
FreeMB, TotalMB: Cardinal;
begin
Result := True;
if CurPageID = wpSelectDir then
begin
Path := ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB < NeedSize then
begin
MsgBox('Недостаточно места на диске!', mbInformation, MB_OK)
Result := False;
end;
end;
end;

Автор: Chanka
Дата сообщения: 19.04.2007 12:26
Sero,
Большое спасибо за код с удалением сейв файлов.
Автор: PavelSES
Дата сообщения: 19.04.2007 14:11
сразу пардон за оффтоп...
но проблема вот вчем - при запускании setup.exe появляется на пару секунд окно консоли и исчезает на совсем - после чего процесс исчезает, пробовал запустить с ключем /log, вот что он выдал:

2007-04-20 00:03:28 Log opened.
2007-04-20 00:03:28 Setup version: Inno Setup version 5.1.8
2007-04-20 00:03:28 Original Setup EXE: P:\SCDA_DVD1\setup.exe
2007-04-20 00:03:28 Setup command line: /SL4 $100618 "P:\SCDA_DVD1\setup.exe" 52224 0 /LOG
2007-04-20 00:03:28 Windows version: 5.01.2600 SP2 (NT platform: Yes)
2007-04-20 00:03:28 64-bit Windows: No
2007-04-20 00:03:28 Processor architecture: x86
2007-04-20 00:03:28 User privileges: Administrative
2007-04-20 00:03:29 64-bit install mode: No
2007-04-20 00:03:29 Created temporary directory: C:\WINDOWS\Temp\is-RIQG4.tmp
2007-04-20 00:03:29 InitializeSetup returned False; aborting.
2007-04-20 00:03:29 Got EAbort exception.
2007-04-20 00:03:29 Deinitializing Setup.
2007-04-20 00:03:29 Log closed.

подскажите плиз чтоза ошибка и почему неустанавливается данное приложение (если это конечно возможно)
заранее спс
Автор: Sero
Дата сообщения: 19.04.2007 14:55
PavelSES
В процедуре InitializeSetup():Boolean; нужно чтобы было Result:=True;
Автор: Sampron
Дата сообщения: 19.04.2007 15:57
GRom V
Смог только так:

[Files]
Source: Button.bmp; Flags: dontcopy
Source: get_hw_caps.dll; Flags: dontcopy

[Code]
var
res, ProcessorName: string;
ProcessorMHZ: Cardinal;
VidRam: integer;
BtnPanel: TPanel;
BtnImage: TBitmapImage;

function GetVideoCardName(): PChar;
external 'hwc_GetVideoCardName@files:get_hw_caps.dll stdcall';
function GetVidMemLocal(): Integer;
external 'hwc_GetVidMemLocal@files:get_hw_caps.dll stdcall';
function GetSoundCardName(): PChar;
external 'hwc_GetSoundCardName@files:get_hw_caps.dll stdcall';
function GetSystemPhys(): Integer;
external 'hwc_GetSystemPhys@files:get_hw_caps.dll stdcall';
function GetSystemPage(): Integer;
external 'hwc_GetSystemPage@files:get_hw_caps.dll stdcall';

procedure BtnOnClick(Sender :TObject);
begin
RegQueryStringValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', 'ProcessorNameString', ProcessorName);
RegQueryDWordValue(HKLM, 'HARDWARE\DESCRIPTION\System\CentralProcessor\0', '~MHz', ProcessorMHZ);
res:= 'Системные требования' + #10#13 + #10#13;
res:= res + 'Процессор ' + (ProcessorName) + ' ' + IntToStr(ProcessorMHZ) + 'MHz' + #10#13;
res:= res + 'Видеоадаптер ' + GetVideoCardName + IntToStr(round(GetVidMemLocal/1000000)-1) + ' МБ' + #10#13;
res:= res + 'Звуковая карта ' + GetSoundCardName + #10#13;
res:= res + 'ОЗУ ' + IntToStr(GetSystemPhys()+ 1)+ ' MB' + #10#13;
res:= res + 'Файл подкачки ' + IntToStr(GetSystemPage)+ ' MB' + #10#13;
MsgBox(res, mbInformation, MB_OK);
end;

procedure InitializeWizard();
begin
BtnPanel:=TPanel.Create(WizardForm)
with BtnPanel do begin
Left:=20
Top:=325
Width:=132
Height:=27
Cursor:=crHand
OnClick:=@BtnOnClick
Parent:=WizardForm
end
BtnImage:=TBitmapImage.Create(WizardForm)
with BtnImage do begin
AutoSize:=True
Enabled:=False
ExtractTemporaryFile('Button.bmp')
Bitmap.LoadFromFile(ExpandConstant('{tmp}')+'\Button.bmp')
Parent:=BtnPanel
end
end;
Автор: NightW0lf
Дата сообщения: 19.04.2007 22:19
2 All
Не подскажите как сделать что бы в скрипте отображения локальных дисков винды происходил вывод размера в GB - только если размер превышает 1024 MB, а то получается так, что например свободно 545 MB, а скрипт выдает все в GB - получается что 0 GB - а должно быть 545 MB.

[more=Вот скрипт]

Код:

Код:
const
NeedSize = 20;
DRIVE_UNKNOWN = 0;
DRIVE_NO_ROOT_DIR = 1;
DRIVE_REMOVEABLE = 2;
DRIVE_FIXED = 3;
DRIVE_REMOTE = 4;
DRIVE_CDROM = 5;
DRIVE_RAMDISK = 6;

var
ListBox: TListBox;
Text: TNewStaticText;

function GetLogicalDrives: DWORD;
external 'GetLogicalDrives@kernel32.dll stdcall';

function GetDriveType(nDrive: string): Longint;
external 'GetDriveTypeA@kernel32.dll stdcall';


procedure ListBoxOnClick(Sender: TObject);
var
NewLetter, OldString: string;
i: Integer;
begin
for i := 0 to ListBox.Items.Count - 1 do
begin
if ListBox.Selected[i] then
begin
NewLetter := Copy(ListBox.Items[i], 0, 1);
OldString := Copy(WizardForm.DirEdit.Text, 2, Length(WizardForm.DirEdit.Text));
WizardForm.DirEdit.Text := NewLetter + OldString;
end;
end;
end;


procedure InitializeWizard();
var
Page: TWizardPage;
Text: TNewStaticText;
Memo: TMemo;
Path: string;
FreeMB, TotalMB: Cardinal;
drives: DWORD;
i: integer;
begin
Text := TNewStaticText.Create(WizardForm);
Text.Top := 102;
Text.Width := 332;
Text.Height := 14;
Text.Caption := 'Список жестких дисков и свободного места';
Text.Parent := WizardForm.SelectDirPage;

ListBox := TListBox.Create(WizardForm);
ListBox.Top := 120;
ListBox.Width := 332;
ListBox.Height := ScaleY(90);
ListBox.Parent := WizardForm.SelectDirPage;
ListBox.OnClick := @ListBoxOnClick;
ListBox.Font.Name := 'Courier New';
ListBox.Font.Size := 10;
ListBox.Font.Style := [fsBold];
ListBox.Color := clBtnFace;

drives := GetLogicalDrives();
for i := 0 to 31 do
begin
if (drives and (1 shl i)) > 0 then
begin
Path := chr(ord('A') + i) + ':\';
if GetDriveType(Path) = DRIVE_FIXED then
begin
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
ListBox.Items.Add(Path + ' ' + IntToStr(round(FreeMB / TotalMB * 100)) + '% ' + IntToStr(FreeMB) + ' MB');
end;
end;
end;
end;


function NextButtonClick(CurPageID: Integer): Boolean;
var
Path: string;
FreeMB, TotalMB: Cardinal;
begin
Result := True;
if CurPageID = wpSelectDir then
begin
Path := ExtractFileDrive(WizardForm.DirEdit.Text);
GetSpaceOnDisk(Path, True, FreeMB, TotalMB);
if FreeMB < NeedSize then
begin
MsgBox('Недостаточно места на диске!', mbInformation, MB_OK)
Result := False;
end;
end;
end;

Страницы: 123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172

Предыдущая тема: ICONS


Форум Ru-Board.club — поднят 15-09-2016 числа. Цель - сохранить наследие старого Ru-Board, истории становления российского интернета. Сделано для людей.