[El Sanchez]

i-Lex, папка Receive с апдейтами рядом со скриптом :

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

Код:

#define AppName "Консультант Плюс"
#define AppExe "CONS.EXE"
#define UpdateDir "RECEIVE"

#define FindHandle
#define FindResult

#sub ProcessFoundFile
    #define public AppVer GetFileVersion(UpdateDir + "\" + FindGetFileName(FindHandle))
#endsub

#for {FindHandle = FindResult = FindFirst(UpdateDir + "\vr*.res", 0); FindResult; FindResult = FindNext(FindHandle)} ProcessFoundFile

[Setup]
AppName={#AppName}
AppVerName={#AppName} {#AppVer}
AppVersion={#AppVer}
CreateAppDir=false
DefaultDirName={tmp}
UsePreviousAppDir=false
UsePreviousGroup=false
UsePreviousSetupType=false
UsePreviousTasks=false
UsePreviousUserInfo=false
DisableStartupPrompt=true
DisableWelcomePage=yes
Uninstallable=false
CreateUninstallRegKey=false

[Languages]
Name: ru; MessagesFile: compiler:Languages\russian.isl

[Messages]
ru.SetupAppTitle=Обновление
ru.SetupWindowTitle=Обновление — %1
ru.WizardReady=Всё готово к обновлению
ru.ReadyLabel1=Программа установки готова начать обновление [name/ver] на вашем компьютере.
ru.ReadyLabel2b=Выберите папки установки и нажмите «Обновить», чтобы продолжить.
ru.WizardInstalling=Обновление...
ru.InstallingLabel=Пожалуйста, подождите, пока [name] обновится на вашем компьютере.
ru.FinishedHeadingLabel=Завершение Мастера обновления [name]
FinishedLabelNoIcons=Программа [name] обновлена на вашем компьютере.

[Files]
Source: {#UpdateDir}\*; DestDir: {tmp}\{#UpdateDir}; Flags: createallsubdirs recursesubdirs

[code]
#define A = (Defined UNICODE) ? "W" : "A"

const
    DRIVE_NO_ROOT_DIR = 1;
    DRIVE_REMOVABLE = 2;
    FO_COPY = $2;
    FOF_SILENT = $4;
    FOF_NOCONFIRMMKDIR = $200;
    FOF_NOCONFIRMATION = $10;
    FOF_NOERRORUI = $400;

type
    SHFILEOPSTRUCT = record
        hwnd: HWND;
        wFunc: UINT;
        pFrom: String;
        pTo: String;
        fFlags: Longint;
        fAnyOperationsAborted: BOOL;
        hNameMappings: Longint;
        lpszProgressTitle: String;
    end;

var
    szPaths: TStringList;
    AppPathsCheckListBox: TNewCheckListBox;
    
function GetLogicalDrives(): DWORD; external 'GetLogicalDrives@kernel32.dll stdcall';
function GetDriveType(lpRootPathName: String): UINT; external 'GetDriveType{#A}@kernel32.dll stdcall';
function SHFileOperation(var lpFileOp: SHFILEOPSTRUCT): Integer; external 'SHFileOperation{#A}@shell32.dll stdcall';

//////////////////////////////////////////////////////////////////
function FindAppExePath(const szPath, szFileName: String): String;
var
    FR: TFindRec;
begin
    if FindFirst(Format('%s\%s', [szPath, szFileName]), FR) then
    try
        repeat
            if (FR.Attributes and FILE_ATTRIBUTE_DIRECTORY = 0) then
                if DirExists(Format('%s\{#UpdateDir}', [szPath])) then Result := szPath;
        until not FindNext(FR) or (Result <> '');
    finally
        FindClose(FR);
    end;
    // recurse
    if FindFirst(Format('%s\*', [szPath]), FR) then
    try
        repeat
            if (FR.Attributes and FILE_ATTRIBUTE_DIRECTORY <> 0) and (FR.Name <> '.') and (FR.Name <> '..') then
                Result := FindAppExePath(Format('%s\%s', [szPath, FR.Name]), szFileName);
        until not FindNext(FR) or (Result <> '');
    finally
        FindClose(FR);
    end;
end;

////////////////////////////////////
function GetAppPaths(): TStringList;
var
    dwDrives, dwDriveType: DWORD;
    i: Integer;
    szDriveLetter: String;
begin
    if Result = nil then Result := TStringList.Create;
    dwDrives := GetLogicalDrives();
    for i := 2 to 25 do if dwDrives and (1 shl i) <> 0 then
    begin
        szDriveLetter := Format('%s:', [Chr(Ord('A') + i)]);
        dwDriveType := GetDriveType(szDriveLetter);
        case dwDriveType of
            DRIVE_REMOVABLE: begin
                Result.Add(FindAppExePath(szDriveLetter, '{#AppExe}'));
                if Result.Strings[Result.Count-1] = '' then Result.Delete(Result.Count-1);
            end;
            DRIVE_NO_ROOT_DIR: Continue;
        end;
    end;
end;

///////////////////////////////////////////////////////
procedure AppPathsCheckListBoxOnClick(Sender: TObject);
var
    i: Integer;
begin
    WizardForm.NextButton.Enabled := False;
    for i := 0 to TNewCheckListBox(Sender).ItemCount-1 do WizardForm.NextButton.Enabled := WizardForm.NextButton.Enabled or TNewCheckListBox(Sender).Checked[i];
end;

////////////////////////////////////
function InitializeSetup(): Boolean;
begin
    szPaths := GetAppPaths();
    Result := szPaths.Count > 0;
    if not Result then MsgBox('Ахтунг! Программа {#AppName} не найдена на съемных дисках!', mbError, MB_OK);
end;

/////////////////////////////
procedure InitializeWizard();
var
    i: Integer;
begin
    WizardForm.ReadyMemo.Hide;
    AppPathsCheckListBox := TNewCheckListBox.Create(WizardForm);
    with AppPathsCheckListBox do
    begin
        Parent := WizardForm.ReadyPage;
        SetBounds(WizardForm.ReadyMemo.Left, WizardForm.ReadyMemo.Top, WizardForm.ReadyMemo.Width, WizardForm.ReadyMemo.Height);
        BorderStyle := bsNone;
        Color := clBtnFace;
        WantTabs := True;
        MinItemHeight := ScaleY(21);
        OnClickCheck := @AppPathsCheckListBoxOnClick;
        for i := 0 to szPaths.Count-1 do AddCheckBox(szPaths.Strings[i], '', 0, True, True, False, False, nil);
    end;
end;

/////////////////////////////////////////////
procedure CurPageChanged(CurPageID: Integer);
begin
    case CurPageID of
        wpReady: WizardForm.NextButton.Caption := 'Обновить';
    end;
end;

//////////////////////////////////////////////
procedure CurStepChanged(CurStep: TSetupStep);
var
    fs: SHFILEOPSTRUCT;
    i, ResultCode: Integer;
begin
    case CurStep of
        ssPostInstall: begin
            fs.wFunc := FO_COPY;
            fs.pFrom := ExpandConstant('{tmp}\{#UpdateDir}'#0);
            fs.fFlags := FOF_SILENT or FOF_NOCONFIRMATION or FOF_NOCONFIRMMKDIR or FOF_NOERRORUI;
            for i := 0 to AppPathsCheckListBox.ItemCount-1 do if AppPathsCheckListBox.Checked[i] then
            begin
                fs.pTo := Format('%s'#0, [AppPathsCheckListBox.ItemCaption[i]]);
                if SHFileOperation(fs) <> 0 then Break;
                Exec(Format('%s\{#AppExe}', [AppPathsCheckListBox.ItemCaption[i]]), '/Receive /Base* /Yes', '', SW_HIDE, ewWaitUntilTerminated, ResultCode);
            end;
        end;
    end;
end;

//////////////////////////////
procedure DeinitializeSetup();
begin
    szPaths.Free;
end;