Ветеран
Сообщения: 1133
Благодарности: 581
|
Профиль
|
Отправить PM
| Цитировать
Цитата Krekerpro:
|
ошибся в третьем,вот скрипт »
|
читать дальше »
[code]
Код:  type
TProc = procedure(HandleW, msg, idEvent, TimeSys: LongWord);
var
n: Integer;
FreeMB, TotalMB: Cardinal;
VolumeName, FileSystemName: String;
VolumeSerialNo, MaxComponentLength, FileSystemFlags: Longint;
ListBox: TListBox;
StartMenuTreeView: TStartMenuFolderTreeView;
baseDisk, baseDir: string;
TimerID: LongWord;
currTime: Integer;
SplashImage: TBitmapImage;
SecondProgressBar: TNewProgressBar;
MouseLabel,SiteLabel: TLabel;
const
oneMB = 1024*1024;
MB_ICONQUESTION = $20;
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 WrapTimerProc(callback:TProc; paramcount:integer):longword;
external 'wrapcallback@files:InnoCallback.dll stdcall';
function SetTimer(hWnd: LongWord; nIDEvent, uElapse: LongWord; lpTimerFunc: LongWord): LongWord;
external 'SetTimer@user32.dll stdcall';
function KillTimer(hWnd: LongWord; nIDEvent: LongWord): LongWord;
external 'KillTimer@user32.dll stdcall';
procedure InitPBarz(wizpbhwnd,pbhwnd:THandle; pbLengt:integer);
external 'InitPBarz@files:arc.dll stdcall';
procedure StartArcExtract(freearc,params:pchar; var ReturnCode:integer);
external 'StartArcExtract@files:arc.dll stdcall';
procedure CancelExtract;
external 'CancelExtract@files:arc.dll stdcall';
procedure RepeatExtract;
external 'RepeatExtract@files:arc.dll stdcall';
procedure SuspendExtract;
external 'SuspendExtract@files:arc.dll stdcall';
procedure ResumeExtract;
external 'ResumeExtract@files:arc.dll stdcall';
procedure UpdateWizGauge;
external 'UpdateWizGauge@files:arc.dll stdcall';
procedure SkipError;
external 'SkipError@files:arc.dll stdcall';
function MessageBox(hWnd: Integer; lpText, lpCaption: String; uType: Cardinal): Integer;
external 'MessageBoxA@user32.dll stdcall';
procedure SiteLabelOnClick(Sender: TObject);
var
ErrorCode: Integer;
begin
ShellExec('open', 'http://*******', '', '', SW_SHOWNORMAL, ewNoWait, ErrorCode)
end;
procedure SiteLabelMouseDown(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
SiteLabel.Font.Color:=clRed
end;
procedure SiteLabelMouseUp(Sender: TObject; Button: TMouseButton; Shift: TShiftState; X, Y: Integer);
begin
SiteLabel.Font.Color:=clBlue
end;
procedure SiteLabelMouseMove(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
SiteLabel.Font.Color:=clGreen
end;
procedure SiteLabelMouseMove2(Sender: TObject; Shift: TShiftState; X, Y: Integer);
begin
SiteLabel.Font.Color:=clRed
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
if baseDisk = ListBox.Items[n][1] then
WizardForm.DirEdit.Text:= baseDir else
WizardForm.DirEdit.Text:= ListBox.Items[n][1] +':\'+ ExtractFileName(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;
procedure CancelButtonClick(CurPage: Integer; var Cancel, Confirm: Boolean);
begin
if curpage=wpInstalling then begin
Cancel:=False;
Confirm:=False;
SuspendExtract;
case MessageBox(StrToInt(ExpandConstant('{wizardhwnd}')),
setupmessage(msgExitSetupMessage), setupmessage(msgExitSetupTitle), MB_YESNO or
MB_defbutton2 or MB_ICONQUESTION) of
idyes:
begin
CancelExtract Cancel:=true
end;
idno: ResumeExtract;
end
end
end;
procedure CurStepChanged(CurStep: TSetupStep);
var
returnCode:integer;
begin
if CurStep = ssInstall then begin
WizardForm.StatusLabel.Caption:=SetupMessage(msgStatusExtractFiles);
ExtractTemporaryFile('arc.exe');
InitPBarz(wizardform.progressgauge.handle,secondprogressbar.Handle,200) //Последнее значение задается в зависимости от кол-ва архивов + 100. То есть - если их 3, то пишем 400, если 1, то 200.
StartArcExtract(ExpandConstant('{tmp}\Arc.exe'), 'x '+AddQuotes(AddBackslash(ExpandConstant('{src}'))+'data-a.bin')+' -y -dp'+AddQuotes(ExpandConstant('{app}')), ReturnCode)
UpdateWizGauge;
end;
end;
procedure OnTimer(HandleW, msg, idEvent, TimeSys: LongWord);
begin
currTime := currTime + 1;
case currTime of
{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_2.bmp'))
end;
2*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_3.bmp'))
end;
3*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_4.bmp'))
end;
4*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_5.bmp'))
end;
5*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_6.bmp'))
end;
6*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_7.bmp'))
end;
7*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_8.bmp'))
end;
8*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_9.bmp'))
end;
9*{#TIME_FOR_VIEW}:
begin
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_10.bmp'))
end;
end;
if CurrTime = 9*{#TIME_FOR_VIEW} then CurrTime := -1;
end;
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 CurPageChanged(CurPageID: Integer);
var
pfunc: LongWord;
begin
if CurPageID = wpSelectDir then ListBoxRefresh
if CurPageID = wpInstalling then
begin
pfunc := WrapTimerProc(@OnTimer, 5);
TimerID := SetTimer(0, 0, 1000, pfunc);
WizardForm.PageNameLabel.Visible:=false
WizardForm.PageDescriptionLabel.Visible:=false
WizardForm.InnerNotebook.Hide;
WizardForm.Bevel1.Hide;
WizardForm.MainPanel.Hide;
WizardForm.PageNameLabel.Hide;
WizardForm.PageDescriptionLabel.Hide;
WizardForm.ProgressGauge.Show;
WizardForm.FileNameLabel.Show;
SplashImage.Show;
WizardForm.CancelButton.Enabled :=True
WizardForm.CancelButton.Top := WizardForm.Bevel.Top + ScaleY(100)
end else
begin
WizardForm.ProgressGauge.Hide;
SplashImage.Hide;
WizardForm.FileNameLabel.Hide;
if (CurPageID > wpInstalling) and (CurPageID < wpFinished) then
begin
WizardForm.InnerNotebook.Show;
WizardForm.Bevel1.Show;
WizardForm.MainPanel.Show;
WizardForm.PageNameLabel.Show;
WizardForm.PageDescriptionLabel.Show;
end
If CurPageID=wpFinished then
end;
end;
procedure InitializeWizard();
begin
MouseLabel:=TLabel.Create(WizardForm)
MouseLabel.Width:=WizardForm.Width
MouseLabel.Height:=WizardForm.Height
MouseLabel.Autosize:=False
MouseLabel.Transparent:=True
MouseLabel.OnMouseMove:=@SiteLabelMouseMove2
MouseLabel.Parent:=WizardForm
SiteLabel:=TLabel.Create(WizardForm)
SiteLabel.Left:=10
SiteLabel.Top:=330
SiteLabel.Cursor:=crHand
SiteLabel.Font.Color:=clRed
SiteLabel.Caption:='Pirat.ca'
SiteLabel.OnClick:=@SiteLabelOnClick
SiteLabel.OnMouseDown:=@SiteLabelMouseDown
SiteLabel.OnMouseUp:=@SiteLabelMouseUp
SiteLabel.OnMouseMove:=@SiteLabelMouseMove
SiteLabel.Parent:=WizardForm
SecondProgressBar := TNewProgressBar.Create(WizardForm);
with SecondProgressBar do begin
Parent := wizardform.InstallingPage;
Left := ScaleX(wizardform.progressgauge.left);
Top := ScaleY(wizardform.progressgauge.top);
Width := ScaleX(wizardform.progressgauge.Width);
Height := ScaleY(wizardform.progressgauge.Height);
end;
ExtractTemporaryFile('Image_1.bmp');
ExtractTemporaryFile('Image_2.bmp');
ExtractTemporaryFile('Image_3.bmp');
ExtractTemporaryFile('Image_4.bmp');
ExtractTemporaryFile('Image_5.bmp');
ExtractTemporaryFile('Image_6.bmp');
ExtractTemporaryFile('Image_7.bmp');
ExtractTemporaryFile('Image_8.bmp');
ExtractTemporaryFile('Image_9.bmp');
ExtractTemporaryFile('Image_10.bmp');
currTime := 0;
WizardForm.ProgressGauge.Parent := WizardForm;
WizardForm.ProgressGauge.Top := WizardForm.CancelButton.Top + ScaleY(12);
WizardForm.ProgressGauge.Left := ScaleX(10);
WizardForm.ProgressGauge.Width := WizardForm.MainPanel.Width - ScaleX(20);
WizardForm.ProgressGauge.Height := 16;
WizardForm.ProgressGauge.Hide;
WizardForm.FileNameLabel.Parent := WizardForm;
WizardForm.FileNameLabel.Top := WizardForm.ProgressGauge.Top - ScaleY(18);
WizardForm.FileNameLabel.Left := ScaleX(10);
WizardForm.FileNameLabel.Width := ScaleX(397);
WizardForm.FileNameLabel.Hide;
SplashImage := TBitmapImage.Create(WizardForm);
SplashImage.Top := 0;
SplashImage.Left := 0;
SplashImage.Width := WizardForm.MainPanel.Width;
SplashImage.Height := WizardForm.Bevel.Top;
SplashImage.Parent := WizardForm.InnerPage;
SplashImage.Stretch := True;
SplashImage.Bitmap.LoadFromFile(ExpandConstant('{tmp}\Image_1.bmp'));
SplashImage.Hide;
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;
baseDir:= WizardForm.DirEdit.Text
baseDisk:= WizardForm.DirEdit.Text[1]
end;
procedure DeInitializeSetup();
begin
KillTimer(0, TimerID);
end;
|
