[Mailchik]

R.i.m.s.k.y., пример:

читать дальше »

Код:

[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Code]
var
 BeforeFinishedPage: TInputOptionWizardPage;

function NextButtonClick(CurPageID: Integer): Boolean;
 begin
  if CurPageID <> BeforeFinishedPage.ID then
   Result := True else begin
    MsgBox('Вы нажали Далее' + #13#10 + 'Название выбранного чекбокса: '
     + BeforeFinishedPage.CheckListBox.ItemCaption[BeforeFinishedPage.CheckListBox.ItemIndex],
      mbInformation, MB_OK);
     Result := True;
   end;
end;

procedure InitializeWizard();
 begin
 BeforeFinishedPage := CreateInputOptionPage(wpInfoAfter,
   'Страница перед wpFinished', 'Моё описание страницы', 'Выберите действие и нажмите Далее', False, False);
 with BeforeFinishedPage do begin
  Add('Действие:');
  with CheckListBox do begin
   ItemEnabled[0] := False;
   Checked[0] := True;
  end;
  AddEx('ЧекБокс 1', 1, True);
  AddEx('ЧекБокс 2', 1, True);
 end;
end;

Скажите пожалуйста как добавлять цветные строки в TListBox.Items.Add »

может уже не нужно, но всё же (версия inno от restools от 121216):

читать дальше »

Код:

#ifdef IS_ENHANCED
  #if (Ver < 0x5020300) || (Pos('ee', IS_Ver_Str) < 1)
    #pragma error 'Enhanced edition of Inno Setup (5.2.3.ee1 or higher) is required to compile this script'
  #endif
#else
  #error Enhanced edition of Inno Setup (restools) is required to compile this script
#endif

[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Code]
var
  TestListBox: TListBox;
  
procedure ListBoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
begin
 with TListBox(Control).Canvas do
  begin
    case Index of
      0:
        begin
          Font.Color := clBlue;
          Brush.Color := clYellow;
        end;
      1:
        begin
          Font.Color := clRed;
          Brush.Color := clLime;
        end;
      2:
        begin
          Font.Color := clGreen;
          Brush.Color := clFuchsia;
        end;
    end;
    FillRect(Rect);
    TextOut(Rect.Left, Rect.Top, (Control as TListBox).Items[Index]);
  end;
end;

procedure InitializeWizard();
 begin
 with WizardForm do begin
  OuterNotebook.Hide;
 end;
  TestListBox := TListBox.Create(WizardForm);
  with TestListBox do begin
   Parent := WizardForm;
   SetBounds(5, 5, 300, 300);
   Items.Add('строка 1');
   Items.Add('строка 2');
   Items.Add('строка 3');
   Style := lbOwnerDrawVariable;
   OnDrawItem := @ListBoxDrawItem;
 end;
end;

[R.i.m.s.k.y.]

Mailchik, хорошо только кнопка "назад" после установки не к месту

[Vstanka]

alert30, попробовала еще такой вариант:

Код:

[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DirExistsWarning=no
DefaultDirName={pf}\My Program
 
[_Code]
const
  PING_TIMEOUT             = 500;
  INADDR_NONE              = $FFFFFFFF;
  SOCKET_ERROR             = (-1);
   
  IP_SUCCESS               = 0;
  IP_BUF_TOO_SMALL         = (11000 + 1);
  IP_DEST_NET_UNREACHABLE  = (11000 + 2);
  IP_DEST_HOST_UNREACHABLE = (11000 + 3);
  IP_DEST_PROT_UNREACHABLE = (11000 + 4);
  IP_DEST_PORT_UNREACHABLE = (11000 + 5);
  IP_NO_RESOURCES          = (11000 + 6);
  IP_BAD_OPTION            = (11000 + 7);
  IP_HW_ERROR              = (11000 + 8);
  IP_PACKET_TOO_BIG        = (11000 + 9);
  IP_REQ_TIMED_OUT         = (11000 + 10);
  IP_BAD_REQ               = (11000 + 11);
  IP_BAD_ROUTE             = (11000 + 12);
  IP_TTL_EXPIRED_TRANSIT   = (11000 + 13);
  IP_TTL_EXPIRED_REASSEM   = (11000 + 14);
  IP_PARAM_PROBLEM         = (11000 + 15);
  IP_SOURCE_QUENCH         = (11000 + 16);
  IP_OPTION_TOO_BIG        = (11000 + 17);
  IP_BAD_DESTINATION       = (11000 + 18);
  IP_ADDR_DELETED          = (11000 + 19);
  IP_SPEC_MTU_CHANGE       = (11000 + 20);
  IP_MTU_CHANGE            = (11000 + 21);
  IP_UNLOAD                = (11000 + 22);
  IP_ADDR_ADDED            = (11000 + 23);
  IP_GENERAL_FAILURE       = (11000 + 50);
  IP_PENDING               = (11000 + 255);
 
type
  ICMP_OPTIONS = record
    Ttl         : Byte;
    Tos         : Byte;
    Flags       : Byte;
    OptionsSize : Byte;
    OptionsData : Longint;
  end;
 
  ICMP_ECHO_REPLY = record
    Address       : Longint;
    status        : Longint;
    RoundTripTime : Longint;
    DataSize      : Longint;
    Reserved      : Integer;
    DataPointer   : Longint;
    Options       : ICMP_OPTIONS;
    Data          : string;
  end;
   
function IcmpCreateFile(): HWND;
external 'IcmpCreateFile@icmp.dll stdcall';
 
function IcmpCloseHandle(IcmpHandle: Longint): Longint;
external 'IcmpCloseHandle@icmp.dll stdcall';
 
function IcmpSendEcho(IcmpHandle: HWND;
                      DestinationAddress: Longint;
                      RequestData: string;
                      RequestSize: Longint;
                      RequestOptions: Longint;
                      var ReplyBuffer: ICMP_ECHO_REPLY;
                      ReplySize: Longint;
                      Timeout: Longint): Longint;
external 'IcmpSendEcho@icmp.dll stdcall';
   
function inet_addr(sAddr: string): Longint;
external 'inet_addr@wsock32.dll stdcall';
 
function GetPingResult(status: Longint): string;
begin
  case status of
    IP_SUCCESS:               Result:= 'Ping IP: success';
    IP_BUF_TOO_SMALL:         Result:= 'Ping IP: buf too small';
    IP_DEST_NET_UNREACHABLE:  Result:= 'Ping IP: destination net unreachable';
    IP_DEST_HOST_UNREACHABLE: Result:= 'Ping IP: destination host unreachable';
    IP_DEST_PROT_UNREACHABLE: Result:= 'Ping IP: destination protocol unreachable';
    IP_DEST_PORT_UNREACHABLE: Result:= 'Ping IP: destination port unreachable';
    IP_NO_RESOURCES:          Result:= 'Ping IP: no resources';
    IP_BAD_OPTION:            Result:= 'Ping IP: bad option';
    IP_HW_ERROR:              Result:= 'Ping IP: hardware error';
    IP_PACKET_TOO_BIG:        Result:= 'Ping IP: packet too big';
    IP_REQ_TIMED_OUT:         Result:= 'Ping IP: request timed out';
    IP_BAD_REQ:               Result:= 'Ping IP: bad request';
    IP_BAD_ROUTE:             Result:= 'Ping IP: bad route';
    IP_TTL_EXPIRED_TRANSIT:   Result:= 'Ping IP: ttl expired transit';
    IP_TTL_EXPIRED_REASSEM:   Result:= 'Ping IP: ttl expired reassem';
    IP_PARAM_PROBLEM:         Result:= 'Ping IP: parameter problem';
    IP_SOURCE_QUENCH:         Result:= 'Ping IP: source quench';
    IP_OPTION_TOO_BIG:        Result:= 'Ping IP: option too big';
    IP_BAD_DESTINATION:       Result:= 'Ping IP: bad destination';
    IP_ADDR_DELETED:          Result:= 'Ping IP: address deleted';
    IP_SPEC_MTU_CHANGE:       Result:= 'Ping IP: spec mtu change';
    IP_MTU_CHANGE:            Result:= 'Ping IP: mtu change';
    IP_UNLOAD:                Result:= 'Ping IP: unload';
    IP_ADDR_ADDED:            Result:= 'Ping IP: address added';
    IP_GENERAL_FAILURE:       Result:= 'Ping IP: general failure';
    IP_PENDING:               Result:= 'Ping IP: pending';
    INADDR_NONE:              Result:= 'Ping IP: bad IP format';
    SOCKET_ERROR:             Result:= 'Ping IP: can''t open port';
  else                        Result:= 'Unknown  status';
  end;
 
end;
 
function Ping(sAddr, sendData: string): Longint;
var
  hPort: HWND;
  dwAddr: Longint;
  ECHO: ICMP_ECHO_REPLY;
begin
  dwAddr:= inet_addr(sAddr);
  if dwAddr <> INADDR_NONE then
    begin
      hPort:= IcmpCreateFile();
      if hPort <> 0 then
        begin
          IcmpSendEcho(hPort, dwAddr, sendData, Length(sendData),
                       0, ECHO, SizeOf(ECHO), PING_TIMEOUT);
          IcmpCloseHandle(hPort);
 
          Result:= ECHO.status;
        end
        else Result:= SOCKET_ERROR;
    end
    else Result:= INADDR_NONE;
end;
 
procedure InitializeWizard();
var
  str: string;
  res: Longint;
begin
  res:= Ping('172.31.100.1', 'test');
  str:= GetPingResult(res);
  MsgBox(str, mbInformation, MB_OK);
end;

Но какой бы адрес ни вводила - всегда успешное выполнение.. странно..

[Raf-9600]

Ктонить подскажет код, чтобы инсталлятор через 10 секунд после своего запуска, распаковал в temp и запустил определённый exe?

exe-шник из папки temp ведь сможет скачать из интернета пару килобайт инфы в оперативу?

[Mailchik]

Raf-9600,

читать дальше »

Код:

[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application

[Files]
Source: MyProg.exe; Flags: dontcopy;

[Code]
var
 ResultCode: integer;

procedure MyTimer(Sender: TObject); //Таймер, который сработает через 10 секунд
 begin
  ExtractTemporaryFile('MyProg.exe'); //Распаковываем нужный exe
  Exec(ExpandConstant('{tmp}\MyProg.exe'), '', 
    ExpandConstant('{tmp}'), SW_SHOW, ewNoWait, ResultCode); //Запускаем exe
  TTimer(Sender).Enabled := False; //Вырубаем таймер
end;

procedure InitializeWizard;
 begin
  with TTimer.Create(nil) do begin //Создаём таймер
   Interval := 10000;
   Enabled := True;
   OnTimer := @MyTimer;
  end;
end;

[Vstanka]

Не подскажете, как сделать, чтобы в секции Run была задержка выполнения команды? Т.е. у меня предлагается пользователю выбрать запуск сервера БД и запуск приложения, чтобы запуск приложения осуществлялся чуть позже или после запуска сервера. Флаг waituntilterminated не подходит, т.к. сервер должен оставаться запущенным.. И от пользователя тоже не нужно ждать никаких действий.

[R.i.m.s.k.y.]

Vstanka, я бы вставил вызов пинга там где нужно подождать
Filename: "ping.EXE"; Parameters: " 127.0.0.1 -n 20"

[Vstanka]

R.i.m.s.k.y., а как тогда скрыть флажок, предлагающий запуск приложения, т.к. если вставить так:

Код:

Filename: "ping.EXE"; Parameters: "127.0.0.1 -n 8"; Description: "Запустить приложение после запуска сервера"; Flags: waituntilterminated runhidden postinstall;

,то будет отображаться checkbox, а если убрать postinstall, то в начале вызывается задержка, а потом предлагается запуск приложения?

[R.i.m.s.k.y.]

Vstanka,
вариант а) батник для вызова приложения, в котором первой строчкой ожидание, второй - запуск приложения
вариант б)

Код:

[Code]
procedure CurStepChanged(CurStep: TSetupStep);
res : integer;
begin
  if CurStep=ssDone  then begin
    if ( WizardForm.RunList.Checked[WizardForm.RunList.Items.IndexOf('Запустить приложение')] ) then begin
      Exec('ping.exe, ' 127.0.0.1 -n 20',ExpandConstant('{sys}'),SW_hide,ewWaitUntilTerminated,res)
      Exec('твояпрога.ехе, 'параметры проги ',ExpandConstant('{app}\путь до проги'),SW_SHOW,ewNoWait,res);
    end;//if
  end;//CurStep=ssDone  
end; //procedure CurStepChanged(CurStep: TSetupStep);
end.

[Run]
Filename: "сервер.ехе"; Parameters: ""; Description: "Запустить сервер"; Flags: runhidden postinstall
Filename: "ping.EXE"; Parameters: ""; Description: "Запустить приложение"; Flags: runhidden

[R.i.m.s.k.y.]

можно как-то определить что установщик собрался перегружать комп в конце установки не переопределяя Needrestart?