Скрипты Inno Setup. Помощь и советы [часть 6]

[saurn]

habib2302,
Цитата saurn:



В качестве иконки ярлыка берется иконка исполняемого файла.

Скрипты Inno Setup. Помощь и советы [часть 6]

[Gnom_aka_Lexander]

Цитата by_gangster:



А в примере от El Sanchez, можно сделать что бы окно выбора не высвечивалось ?

Скрипты Inno Setup. Помощь и советы [часть 6]

by_gangster, замените эти строки:



Код:

Код: Выделить всё

if GetSaveFileName('Сохранить как...', fName, '', '*' + ExtractFileExt(fName), ExtractFileExt(fName)) then
try

вот этими:



Код:

Код: Выделить всё

if DirExists(szDestDir) then
try
    fName := Format('%s\%s', [szDestDir, fName]);

Саму процедуру объявите как:



Код:

Код: Выделить всё

procedure DownloadFile(urlFilename, szDestDir: String);

P.S. Вообще-то пример в шапке устарел, заменю его как-нибудь.

[neorom]

by_gangster, El Sanchez,

позволил себе изменить немного процедуру скачивания:



procedure DownloadFile(интернет_ссылка_на_файл, имя_файла_сохранения, указатель_на_каллбэк_процедуру);

упростил немного код, благодаря каллбэку избавился от глобальных переменных и вынес конвертацию массива символов в строку в отдельную функцию и таким макаром избавился от некоторых действий

процедуры скачивания и теперь в функцию передаются не переменные, а const ссылки (так лучше)

пример скачивания и работы каллбэка ниже:

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

Код:

Код: Выделить всё

[Setup]
AppName=My Program
AppVerName=My Program v 1.5
DefaultDirName={pf}\My Program
OutputDir=.
Compression=lzma2/ultra
InternalCompressLevel=ultra
SolidCompression=yes
[code  ]
#ifdef UNICODE
    #define A "W"
    #define UCHAR "AnsiChar"
#else
    #define A "A"
    #define UCHAR "Char"
#endif
const
    INTERNET_OPEN_TYPE_PRECONFIG = 0;
    INTERNET_FLAG_NO_CACHE_WRITE = $4000000;
    INTERNET_FLAG_NEED_FILE = $10;
    INTERNET_FLAG_NO_AUTO_REDIRECT = $200000;
    HTTP_QUERY_LOCATION = 33;
    FILE_END = 2;
    INVALID_SET_FILE_POINTER = $FFFFFFFF;
    DOWNLOAD_START = -1;
    DOWNLOADING = 1;
    DOWNLOAD_END = 0;
type
    _DOWNLOAD_CALLBACK = function(const StatusMessage, sFileNameAddr, dwFileSize, dwPosition: Longint): Boolean;
    HINTERNET = Longint;
var
    StopDownload: Boolean;
    StopDownloadBtn: TButton;
function InternetOpen(lpszAgent: String; dwAccessType: DWORD; lpszProxy, lpszProxyBypass: String; dwFlags: DWORD): HINTERNET; external 'InternetOpen{#A}@wininet.dll stdcall';
function InternetOpenUrl(hInet: HINTERNET; lpszUrl, lpszHeaders: String; dwHeadersLength, dwFlags, dwContext: DWORD): HINTERNET; external 'InternetOpenUrl{#A}@wininet.dll stdcall';
function InternetSetFilePointer(hFile: HINTERNET; lDistanceToMove, pReserved: Longint; dwMoveMethod, dwContext: DWORD): DWORD; external 'InternetSetFilePointer@wininet.dll stdcall';
function InternetReadFile(hFile: HINTERNET; var lpBuffer: {#UCHAR}; dwNumberOfBytesToRead: DWORD; var lpdwNumberOfBytesRead: DWORD): BOOL; external 'InternetReadFile@wininet.dll stdcall';
function InternetQueryDataAvailable(hFile: HINTERNET; var lpdwNumberOfBytesAvailable: DWORD; dwFlags, dwContext: DWORD): Boolean; external 'InternetQueryDataAvailable@wininet.dll stdcall';
function InternetCloseHandle(hInet: HINTERNET): BOOL; external 'InternetCloseHandle@wininet.dll stdcall';
function DeleteUrlCacheEntry(lpszUrlName: String): BOOL; external 'DeleteUrlCacheEntryA@wininet.dll stdcall';
function HttpQueryInfo(hRequest: HINTERNET; dwInfoLevel: DWORD; var lpvBuffer: {#UCHAR}; var lpdwBufferLength, lpdwReserved: DWORD): BOOL; external 'HttpQueryInfo{#A}@wininet.dll stdcall';
function StrFormatByteSize64(qdw: Currency; var pszBuf: {#UCHAR}; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64{#A}@shlwapi.dll stdcall';
function StrFromTimeInterval(var pszOut: {#UCHAR}; cchMax: UINT; dwTimeMS: DWORD; digits: Byte): Integer; external 'StrFromTimeInterval{#A}@shlwapi.dll stdcall';
function GetTickCount(): DWORD; external 'GetTickCount@kernel32.dll stdcall';
////////////////////////////////////////////
function BytesToSize(Bytes: Extended): String;
var
    pszBuf: array [0..15] of {#UCHAR};
begin
    try
        Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], sizeof(pszBuf));
    except end;
end;
function TicksToTime(Ticks: DWORD): String;
var
    i: Byte;
    arr: array [0..31] of {#UCHAR};
begin
    for i := 0 to StrFromTimeInterval(arr[0], sizeof(arr), Ticks, 8)-1 do Result := Result + arr[i];
end;
function RoundDword(dwValue: DWORD): DWORD;
begin
    dwValue := dwValue or (dwValue shr 1);
    dwValue := dwValue or (dwValue shr 2);
    dwValue := dwValue or (dwValue shr 4);
    dwValue := dwValue or (dwValue shr 8);
    dwValue := dwValue or (dwValue shr 16);
    Result := dwValue - (dwValue shr 1);
end;
procedure CancelDownloadOnClick(Sender: TObject);
begin
    StopDownload := True;
end;
function DownloadProgress(const StatusMessage, sFileNameAddr, dwFileSize, dwPosition: Longint): Boolean;
begin
    case StatusMessage of
        DOWNLOAD_START:
        begin
            WizardForm.ProgressGauge.Max := dwFileSize;
            StopDownloadBtn := TButton.Create(WizardForm)
            with StopDownloadBtn do
            begin
                Parent := WizardForm;
                SetBounds(WizardForm.CancelButton.Left, WizardForm.CancelButton.Top, WizardForm.CancelButton.Width, WizardForm.CancelButton.Height);
                Caption := WizardForm.CancelButton.Caption;
                OnClick := @CancelDownloadOnClick;
            end;
            WizardForm.CancelButton.Hide;
        end;
        DOWNLOADING:
        begin
            WizardForm.ProgressGauge.Position := dwPosition;
            WizardForm.StatusLabel.Caption := Format( 'FileName:' #32 '%s' #32 'FileSize:' #32 '%s', [CastIntegerToString(sFileNameAddr), BytesToSize(Extended(dwFileSize))] );
            WizardForm.FilenameLabel.Caption := Format( 'Downloaded:' #32 '%s' #32 'Ready:' #32 '%s', [BytesToSize(Extended(dwPosition)), FormatFloat('0.#0 %', (dwPosition*100)/dwFileSize)] );
            Application.ProcessMessages;
        end;
        DOWNLOAD_END:
        begin
            WizardForm.CancelButton.Show;
            if StopDownloadBtn  nil then StopDownloadBtn.Free;
        end;
    end;
   // Result := True;
    Result := StopDownload;
end;
function CharArrayToString(const cArray: array of Char): String;
var
    i: Integer;
begin
    for i := 0 to GetArrayLength(cArray)-1 do Result := Result + cArray[i];
end;
procedure DownloadFile(const urlFilename, DestFileName: String; const CallBack: _DOWNLOAD_CALLBACK);
var
    lpdwNumberOfBytesRead, lpdwNumberOfBytesAvailable, lpdwBufferLength, lpdwIndex: DWORD;
    hInt, hRedir, hFile: HINTERNET;
    dStop: Boolean;
    lpBuffer: array of {#UCHAR};
    fStream: TFileStream;
    fSize: DWORD;
begin
    hInt := InternetOpen('', INTERNET_OPEN_TYPE_PRECONFIG, '', '', 0);
    if hInt  0 then
    try   
        //Get file size
        hRedir := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE or INTERNET_FLAG_NO_AUTO_REDIRECT, 0);
        if hRedir  0 then
        try
            SetArrayLength(lpBuffer, 1024);
            fSize := InternetSetFilePointer(hRedir, 0, 0, FILE_END, 0);
            if fSize = INVALID_SET_FILE_POINTER then
            begin
                lpdwBufferLength := GetArrayLength(lpBuffer);
                lpdwIndex := 0;
                HttpQueryInfo(hRedir, HTTP_QUERY_LOCATION, lpBuffer[0], lpdwBufferLength, lpdwIndex);
                hFile := InternetOpenUrl(hInt, CharArrayToString(lpBuffer), '', 0, INTERNET_FLAG_NEED_FILE, 0);
                if hFile  0 then
                try
                    fSize := InternetSetFilePointer(hFile, 0, 0, FILE_END, 0);
                finally
                    InternetCloseHandle(hFile);
                    DeleteUrlCacheEntry(urlFilename);
                end;
            end;
        finally
            InternetCloseHandle(hRedir);
            DeleteUrlCacheEntry(urlFilename);
        end;
        // download
        if FileExists(DestFileName) then if not DeleteFile(DestFileName) then
        begin
            InternetCloseHandle(hInt);
            Exit;
        end;
        if not DirExists(ExtractFileDir(DestFileName)) then if not ForceDirectories(ExtractFileDir(DestFileName)) then
        begin
            InternetCloseHandle(hInt);
            Exit;
        end;
        hFile := InternetOpenUrl(hInt, urlFilename, '', 0, INTERNET_FLAG_NEED_FILE, 0);
        if hFile  0 then 
        try
            fStream := TFileStream.Create(DestFileName, fmCreate);
            if CallBack  nil then dStop := CallBack( DOWNLOAD_START, CastStringToInteger(DestFileName), Longint(fSize), 0);
            while (InternetQueryDataAvailable(hFile, lpdwNumberOfBytesAvailable, 0, 0) and (lpdwNumberOfBytesAvailable > 0)) and not dStop do
            begin
                SetArrayLength(lpBuffer, RoundDword(lpdwNumberOfBytesAvailable));
                InternetReadFile(hFile, lpBuffer[0], GetArrayLength(lpBuffer), lpdwNumberOfBytesRead);
                fStream.WriteBuffer(CharArrayToString(lpBuffer), lpdwNumberOfBytesRead);
                fStream.Seek(0, soFromEnd);
                if CallBack  nil then dStop := CallBack(DOWNLOADING, CastStringToInteger(DestFileName), Longint(fSize), Longint(fStream.Size + lpdwNumberOfBytesRead));
            end;
        finally
            fStream.Free;
            InternetCloseHandle(hFile);
            DeleteUrlCacheEntry(urlFilename);
            if CallBack  nil then dStop := CallBack( DOWNLOAD_END, CastStringToInteger(DestFileName), Longint(fSize), 0);
            if dStop then DeleteFile(DestFileName);
        end;
    finally
        InternetCloseHandle(hInt);
    end;
end;
procedure CurStepChanged(CurStep: TSetupStep);
begin
    if CurStep = ssInstall then DownloadFile('http://mse.dlservice.microsoft.com/download/7/6/0/760B9188-4468-4FAD-909E-4D16FE49AF47/ruRU/x86/mseinstall.exe', ExpandConstant('{app}\File.exe'), @DownloadProgress); // ..., nil); - no Callback
end;

надеюсь не накосячил

и ещё есть поддержка юникодной инно и кнопка отмены

[audiofeel]

Доброе утро, Всем. в примере "GameuxInstallHelper.iss" реализованно все для одного ГДФБинари, "проблема" в том что их два, один для MP второй для SP - как быть, просто "повторить" - "if CurStep = ssPostInstall then begin"

и "if CurUninstallStep = usUninstall then begin" просто вписывая данные для каждого отдельно. как бы это сделать все правильно что ли , что бы при удалении не было эррор

[saurn]

Цитата saurn:



В качестве иконки ярлыка берется иконка исполняемого файла.

Скрипты Inno Setup. Помощь и советы [часть 6]

может что-то можно дописать в vbs скрипт

[audiofeel]

by_gangster,


Цитата by_gangster:



процедуру отмениь нельзя (кнопочкой) когда начинается скачивание

Скрипты Inno Setup. Помощь и советы [часть 6]

добавил кнопку отменны, в перед. сообщении


Цитата by_gangster:



И ещё, почему нельзя так делать ?

Скрипты Inno Setup. Помощь и советы [часть 6]

И что это по твоему за путь '{app}\File.exe' ?

так нельзя, тк {app} - константа. Такую строку нужно пропускать через функцию ExpandConstant(...), которая заменяет константы на пути

короче нужно вот так DownloadFile('

http://sayt.ru/1.rar

', ExpandConstant('{app}\File.exe'), @DownloadProgress);

[saurn]

audiofeel, я использую другой способ. Пробуйте, работает - не работает, проверить сейчас не могу. Только имена бинарников в шапке скрипта свои укажите.

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

Код:

Код: Выделить всё

#define GDFSP "{app}\GDFsp.dll"
#define GDFMP "{app}\GDFmp.dll"
[Setup]
AppName=My Application
AppVersion=1.5
DefaultDirName={pf}\My Application
OutputDir=...
[Files]
Source: GameuxInstallHelper.dll; DestDir: {app}; Flags: overwritereadonly
[Code]
type
  TGUID = record
    D1: Cardinal;
    D2: Word;
    D3: Word;
    D4: Array [0..8] of Byte;
  end;
function AddToGameExplorer(BinaryPatch: String; Path: String; InstallType: Integer; var GUID: TGUID): Cardinal; external 'AddToGameExplorerA@files:GameuxInstallHelper.dll stdcall setuponly';
function RetrieveGUIDForApplication(BinaryPatch: String; var GUID: TGUID): Cardinal; external 'RetrieveGUIDForApplicationA@{app}\GameuxInstallHelper.dll stdcall uninstallonly';
function RemoveFromGameExplorer(var GUID: TGUID): Cardinal; external 'RemoveFromGameExplorer@{app}\GameuxInstallHelper.dll stdcall uninstallonly';
var
  GUID: TGUID;
  GDFSP, GDFMP: String;
procedure CurStepChanged(CurStep: TSetupStep);
begin
  case CurStep of
    ssPostInstall:
    begin
      GDFSP := ExpandConstant('{#GDFsp}');
      GDFMP := ExpandConstant('{#GDFmp}');
      AddToGameExplorer(GDFSP, ExpandConstant('{app}'), 3, GUID);
      AddToGameExplorer(GDFMP, ExpandConstant('{app}'), 3, GUID);
    end;
  end;
end;
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
  case CurUninstallStep of
    usUninstall:
    begin
      GDFSP := ExpandConstant('{#GDFsp}');
      GDFMP := ExpandConstant('{#GDFmp}');
      RetrieveGUIDForApplication(GDFSP, GUID);
      RetrieveGUIDForApplication(GDFMP, GUID);
      RemoveFromGameExplorer(GUID);
      UnloadDll(ExpandConstant('{app}\GameuxInstallHelper.dll'));
    end;
  end;
end;

[audiofeel]

saurn, проверил - создается один ярлык в Game Explorer, причем пустой не кликабельный именно на второй GDFBinary2.DLL (для мульта), но зато для всех пользователей (ну это так к слову)

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

Код:

Код: Выделить всё

type
  TGUID = record
    D1: Cardinal;
    D2: Word;
    D3: Word;
    D4: Array [0..8] of Byte;
  end;
function AddToGameExplorer(BinaryPatch: String; Path: String; InstallType: Integer; var GUID: TGUID): Cardinal; 
  external 'AddToGameExplorerA@files:GameuxInstallHelper.dll stdcall setuponly';
function RetrieveGUIDForApplication(BinaryPatch: String; var GUID: TGUID): Cardinal; 
  external 'RetrieveGUIDForApplicationA@{app}\GameuxInstallHelper.dll stdcall uninstallonly';
function RemoveFromGameExplorer(var GUID: TGUID): Cardinal; 
  external 'RemoveFromGameExplorer@{app}\GameuxInstallHelper.dll stdcall uninstallonly';
var
  GUID: TGUID;
  GDFSP, GDFMP: String;
procedure CurStepChanged2(CurStep: TSetupStep);
begin
  case CurStep of
    ssPostInstall:
    begin
      GDFSP := ExpandConstant('{app}\GDFBinary.dll');
      GDFMP := ExpandConstant('{app}\GDFBinary2.dll');
      AddToGameExplorer(GDFSP, ExpandConstant('{app}'), 3, GUID);
      AddToGameExplorer(GDFMP, ExpandConstant('{app}'), 3, GUID);
    end;
  end;
end;
procedure CurUninstallStepChanged(CurUninstallStep: TUninstallStep);
begin
  case CurUninstallStep of
    usUninstall:
    begin
      GDFSP := ExpandConstant('{app}\GDFBinary.dll');
      GDFMP := ExpandConstant('{app}\GDFBinary2.dll');
      RetrieveGUIDForApplication(GDFSP, GUID);
      RetrieveGUIDForApplication(GDFMP, GUID);
      RemoveFromGameExplorer(GUID);
      UnloadDll(ExpandConstant('{app}\GameuxInstallHelper.dll'));
    end;
  end;
end;

[saurn]

audiofeel, да нет, все добавляется корректно. есть косяки с удалением(остается мертвый ярлык) пока нет времени ковырять, может разберетесь раньше. Может кто более сведущий нам подскажет, я-то тоже не особо спец. На счет пустых ярлыков, смотрите в сторону бинарников.

[saurn]

Цитата by_gangster:



Johny777, Сейчас всё нормально... но деинсталлятор не удаляет файл...

Скрипты Inno Setup. Помощь и советы [часть 6]

Код:

Код: Выделить всё

[UninstallDelete]
Name: {app}\1.rar; Type: files

или



Код:

Код: Выделить всё

[UninstallDelete]
Name: {app}\*; Type: filesandordirs