Имя пользователя:
Пароль:
 

Показать сообщение отдельно

Аватара для Johny777

Ветеран


Сообщения: 649
Благодарности: 444

Профиль | Отправить PM | Цитировать


Цитата Tco 03:
чтобы в коде не было ничего лишнего »
Мне иногда страшно представить сколько лишнего(мусорного) кода содержит ассемблерный код, скомпилированный из чистого, без лишних переменных и функций скрипта тк думаю что компилятору инно далеко до например дельфи 2010
вот только сжатие. Константы все наместе, тк если будет ошибка, то поймёшь что означает по имени константы
читать дальше »
Код: Выделить весь код
[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program

[Files]
Source: 7-zip32.dll; Flags: ignoreversion dontcopy nocompression solidbreak sortfilesbyextension

[  code]
#ifdef UNICODE
    #define A "W"
#else
    #define A "A"
#endif
const
    // codes returned by SevenZipCreateArchive and SevenZipExtractArchive
    SZ_OK = 0;
    SZ_ERROR = 1;
    SZ_CANCELLED = 2;
    SZ_DLLERROR = 3;

    FNAME_MAX32 = 512;

    // these get returned as nState in the Callback function
    ARCEXTRACT_BEGIN = 0;
    ARCEXTRACT_INPROCESS = 1;
    ARCEXTRACT_END = 2;
    ARCEXTRACT_OPEN = 3;
    ARCEXTRACT_COPY = 4;

    // Errors
    ERROR_START = $8000;

    // WARNING
    ERROR_DISK_SPACE = $8005;
    ERROR_READ_ONLY = $8006;
    ERROR_USER_SKIP = $8007;
    ERROR_UNKNOWN_TYPE = $8008;
    ERROR_METHOD = $8009;
    ERROR_PASSWORD_FILE = $800A;
    ERROR_VERSION = $800B;
    ERROR_FILE_CRC = $800C;
    ERROR_FILE_OPEN = $800D;
    ERROR_MORE_FRESH = $800E;
    ERROR_NOT_EXIST = $800F;
    ERROR_ALREADY_EXIST = $8010;
    ERROR_TOO_MANY_FILES  = $8011;

    // ERROR
    ERROR_MAKEDIRECTORY = $8012;
    ERROR_CANNOT_WRITE = $8013;
    ERROR_HUFFMAN_CODE = $8014;
    ERROR_COMMENT_HEADER = $8015;
    ERROR_HEADER_CRC = $8016;
    ERROR_HEADER_BROKEN = $8017;
    ERROR_ARC_FILE_OPEN = $8018;
    ERROR_NOT_ARC_FILE = $8019;
    ERROR_CANNOT_READ  = $801A;
    ERROR_FILE_STYLE = $801B;
    ERROR_COMMAND_NAME = $801C;
    ERROR_MORE_HEAP_MEMORY = $801D;
    ERROR_ENOUGH_MEMORY = $801E;
    ERROR_ALREADY_RUNNING = $801F;
    ERROR_USER_CANCEL = $8020;
    ERROR_HARC_ISNOT_OPENED = $8021;
    ERROR_NOT_SEARCH_MODE = $8022;
    ERROR_NOT_SUPPORT = $8023;
    ERROR_TIME_STAMP = $8024;
    ERROR_TMP_OPEN = $8025;
    ERROR_LONG_FILE_NAME = $8026;
    ERROR_ARC_READ_ONLY = $8027;
    ERROR_SAME_NAME_FILE = $8028;
    ERROR_NOT_FIND_ARC_FILE = $8029;
    ERROR_RESPONSE_READ = $802A;
    ERROR_NOT_FILENAME = $802B;
    ERROR_TMP_COPY = $802C;
    ERROR_EOF = $802D;
    ERROR_ADD_TO_LARC = $802E;
    ERROR_TMP_BACK_SPACE = $802F;
    ERROR_SHARING = $8030;
    ERROR_NOT_FIND_FILE = $8031;
    ERROR_LOG_FILE = $8032;
    ERROR_NO_DEVICE = $8033;
    ERROR_GET_ATTRIBUTES = $8034;
    ERROR_SET_ATTRIBUTES = $8035;
    ERROR_GET_INFORMATION = $8036;
    ERROR_GET_POINT = $8037;
    ERROR_SET_POINT = $8038;
    ERROR_CONVERT_TIME = $8039;
    ERROR_GET_TIME = $803A;
    ERROR_SET_TIME = $803B;
    ERROR_CLOSE_FILE = $803C;
    ERROR_HEAP_MEMORY = $803D;
    ERROR_HANDLE = $803E;
    ERROR_TIME_STAMP_RANGE = $803F;
    ERROR_MAKE_ARCHIVE = $8040;
    ERROR_NOT_CONFIRM_NAME = $8041;
    ERROR_UNEXPECTED_EOF = $8042;
    ERROR_INVALID_END_MARK = $8043;
    ERROR_INVOLVED_LZH = $8044;
    ERROR_NO_END_MARK = $8045;
    ERROR_HDR_INVALID_SIZE = $8046;
    ERROR_UNKNOWN_LEVEL = $8047;
    ERROR_BROKEN_DATA = $8048;
    ERROR_7ZIP_START = $8100;
    ERROR_WARNING = $8101;
    ERROR_FATAL = $8102;
    ERROR_DURING_DECOMPRESSION = $8103;
    ERROR_DIR_FILE_WITH_64BIT_SIZE = $8104;
    ERROR_FILE_CHANGED_DURING_OPERATION = $8105;

    FA_RDONLY = $01;
    FA_HIDDEN = $02;
    FA_SYSTEM = $04;
    FA_LABEL = $08;
    FA_DIREC = $10;
    FA_ARCH = $20;
    FA_ENCRYPTED = $40;

    ARCHIVETYPE_ZIP = 1;
    ARCHIVETYPE_7Z = 2;

    WM_USER = $400;
    PBM_SETPOS = (WM_USER + 2);


type
    HARC = Longint;

    EXTRACTINGINFO = record
        dwFileSize: DWORD;                                  // Size of all the housing files. When entire size 0xFFFFFFFF (-1) it is above, 0xFFFFFFFF (-1) it houses.
        dwWriteSize: DWORD;                                 // The entire size which processed with compression thawing processing. When dwFileSize 0xFFFFFFFF (-1) is, entire processing ratio (permill) it houses.
        szSourceFileName: array [0..FNAME_MAX32] of Byte;   // The housing file name which processes.
        dummy1: array [0..2] of Byte;
        szDestFileName: array [0..FNAME_MAX32] of Byte;     // The path name which actually is written.
        dummy: array [0..2] of Byte;
    end;

    // Callback func should return FALSE to cancel the archiving process, else TRUE
    ARCHIVERPROC = function(_hwnd: HWND; _uMsg: UINT; _nState: UINT; _lpEis: Longint): BOOL;

function SevenZip(const _hwnd: HWND; _szCmdLine: PAnsiChar; _szOutput: AnsiString; const _dwSize: DWORD): Integer; external 'SevenZip@files:7-zip32.dll stdcall';
function SevenZipSetOwnerWindowEx(_hwnd: HWND; _lpArcProc: Longint): BOOL; external 'SevenZipSetOwnerWindowEx@files:7-zip32.dll stdcall';
function SevenZipKillOwnerWindowEx(_hwnd: HWND): BOOL; external 'SevenZipKillOwnerWindowEx@files:7-zip32.dll stdcall';
function RtlMoveMemory(var Destination: EXTRACTINGINFO; const Source: Longint; len: Integer): Integer; external 'RtlMoveMemory@kernel32.dll stdcall';
function SetWindowText(hWnd: HWND; lpString: String): BOOL; external 'SetWindowText{#A}@user32.dll stdcall';
function StrFormatByteSize64(qdw: Currency; var pszBuf: Char; cchBuf: UINT): PAnsiChar; external 'StrFormatByteSize64A@shlwapi.dll stdcall';


const
    CP_ACP    = 0;             { default to ANSI code page }
    CP_OEMCP  = 1;             { default to OEM  code page }

function MultiByteToWideChar(CodePage: UINT; dwFlags: DWORD; lpMultiByteStr: PAnsiChar; cbMultiByte: Integer; lpWideCharStr: PAnsiChar; cchWideChar: Integer): Longint; external 'MultiByteToWideChar@kernel32.dll stdcall';
function WideCharToMultiByte(CodePage: UINT; dwFlags: DWORD; lpWideCharStr: PAnsiChar; cchWideChar: Integer; lpMultiByteStr: PAnsiChar; cbMultiByte: Integer; lpDefaultChar: Integer; lpUsedDefaultChar: Integer): Longint; external 'WideCharToMultiByte@kernel32.dll stdcall';

function StringToWideString(const aStr: string; codePage: Word): string;
var
    len: Integer;
begin
    len := MultiByteToWideChar(codePage, 0, aStr, -1, '', 0);
    if len > 0 then
    begin
        SetLength(Result, (len*2)-2);
        MultiByteToWideChar(codePage, 0, aStr, -1, Result, Length(Result));
    end;
end;

function WideStringToString(const wStr: string; codePage: Word): string;
var
    len: Integer;
begin
    len := WideCharToMultiByte(codePage, 0, wStr, -1, '', 0, 0, 0);
    if len > 0 then
    begin
        SetLength(Result, len-1);
        WideCharToMultiByte(codePage, 0, wStr, -1, Result, Length(Result), 0, 0);
    end;
end;

function AnsiToDos(const SourceStr: string): string;
begin
    Result := WideStringToString(StringToWideString(SourceStr, CP_ACP), CP_OEMCP);
end;



var
    szStatus: TNewStaticText;
    ei: EXTRACTINGINFO;
    ProgressPage: TOutputProgressWizardPage;
    hProgress, hMsg1Label, hMsg2Label: HWND;
    Cancel: boolean;
    DestPath: String;
    MyPrgBar: TNewProgressBar;

function ByteArrayToString(cArray: array of Byte): String;
begin
    Result := '';
    while cArray[Length(Result)] <> 0 do Insert(Chr(cArray[Length(Result)]), Result, Length(Result)+1);
end;

function BytesToSize(Bytes: Extended): String;
var
    pszBuf: array [0..15] of Char;
begin
    try
        Result := StrFormatByteSize64(Abs(Bytes div 1E4), pszBuf[0], SizeOf(pszBuf));
    except end;
end;

function ArchiverCallbackProc(_hwnd: HWND; _uMsg, _nState: UINT; _lpEis: Longint): BOOL;
var
    dwCurrentSize: Single;
begin
    Result := True;
    case _nState of
        ARCEXTRACT_BEGIN: SetWindowText(hMsg1Label, 'Status: scanning');
        ARCEXTRACT_INPROCESS:
        begin
           // if Cancel then Exit;
            RtlMoveMemory(ei, _lpEis, SizeOf(ei));
            dwCurrentSize := ei.dwWriteSize;
            PostMessage(hProgress, PBM_SETPOS, Round(65535*(dwCurrentSize/ei.dwFileSize)), 0);
            SetWindowText(hMsg1Label, 'Status: compressing');
            SetWindowText(hMsg2Label, FormatFloat('Progress: 0.#0 %', (dwCurrentSize*100)/ei.dwFileSize));
            SetWindowText(_hwnd, 'File: ' + ByteArrayToString(ei.szSourceFileName) + #13#10 +
            'Total size: ' + BytesToSize(ei.dwFileSize) + #13#10 +
            'Current size: ' + BytesToSize(ei.dwWriteSize));
            Result := not Cancel;
        end;
        ARCEXTRACT_END: Result := False;
        ARCEXTRACT_OPEN: SetWindowText(hMsg1Label, 'Status: open archive');
    end;
end;

procedure Cancel7ZipWork(Sender: TObject);
begin
    Cancel := True;
end;

/////////////////////
procedure CreateSevenZipProgressPage;
begin
    ProgressPage := CreateOutputProgressPage('7-zip', '');
    szStatus := TNewStaticText.Create(ProgressPage);
    with szStatus do
    begin
        Parent := ProgressPage.Surface;
        WordWrap := True;
        SetBounds(ScaleX(0), ProgressPage.ProgressBar.Top + ScaleY(30), ProgressPage.Surface.Width, ScaleY(300));
    end;
    MyPrgBar := TNewProgressBar.Create(nil)
    with MyPrgBar do
    begin
        Parent := ProgressPage.Surface;
        SetBounds(ScaleX(0), ProgressPage.ProgressBar.Top + ScaleY(140), ProgressPage.Surface.Width, ScaleY(27));
    end;
    with TButton.Create(nil) do
    begin
        Parent := ProgressPage.Surface;
        Caption := 'Cancel';
        SetBounds(ScaleX(0), ProgressPage.ProgressBar.Top + ScaleY(90), ScaleX(75), ScaleY(25));
        OnClick := @Cancel7ZipWork;
    end;
end;


//////////////////////////////////////////////////////
function SevenZipCreateArchive(hWnd: HWND; ArchiveFilename, BaseDirectory: String; FileList : TArrayOfString; CompressionLevel: Integer; CreateSolidArchive: Boolean; RecurseFolders: Boolean; Password, Sfx: String; ShowProgress: Boolean; Callback: Longint): Integer;
var
    S7ResultOutput, s7cmd, cwd: AnsiString;
    i: Integer;
begin
    Result := SZ_ERROR;
    if not SetCurrentDir(BaseDirectory) then Exit;
    //
    cwd := GetCurrentDir;
    
    if Callback <> 0 then ShowProgress := False;
    try
        if GetArrayLength(FileList) > 0 then
        begin
            s7cmd := 'a "' + AnsiToDos(ArchiveFilename) + '" "' + RemoveQuotes(FileList[0]) + '"';
            for i := 1 to GetArrayLength(FileList)-1 do
            begin
                s7cmd := s7cmd + ' -i';
                if RecurseFolders then s7cmd := s7cmd + 'r';
                s7cmd := s7cmd + '!"' + RemoveQuotes(FileList[i]) + '"';
            end;
        end;
        s7cmd := s7cmd + ' -mx' + IntToStr(CompressionLevel);
        if RecurseFolders then s7Cmd := s7cmd + ' -r';
        if Password <> '' then s7Cmd := s7Cmd + ' -p' + Password;
        if CreateSolidArchive then s7cmd := s7cmd + ' -ms=on' else s7cmd := s7cmd + ' -ms=off';
        if not ShowProgress then s7cmd := s7cmd + ' -hide';
        if Length(Sfx) > 0 then s7cmd := s7cmd + ' -sfx' + Sfx;
        try
            s7ResultOutput := StringOfChar(#0, 10240);
            if Callback <> 0 then
            begin
                //get handles for 7-zip callback thread
                hProgress := ProgressPage.ProgressBar.Handle;
                hMsg1Label := ProgressPage.Msg1Label.Handle;
                hMsg2Label := ProgressPage.Msg2Label.Handle;
                //show progress page
                ProgressPage.Show;
                ProgressPage.ProgressBar.Show;
                ProgressPage.Description := 'Compress';
                //set callback
                SevenZipSetOwnerWindowEx(hWnd, Callback);
            end;
            Result := SevenZip(hWnd, s7cmd, s7ResultOutput, Length(s7ResultOutput)-1);
        finally
            if Callback <> 0 then
            begin
                ProgressPage.Hide;
                SevenZipKillOwnerWindowEx(hWnd);
            end;
            //MsgBox(S7ResultOutput, mbInformation, MB_OK);
        except
            Result := SZ_DLLERROR;
        end;
    finally
        SetCurrentDir(cwd);
    end;
end;

procedure InitializeWizard();
begin
    Cancel := True;
    CreateSevenZipProgressPage;
end;

function NextButtonClick(CurPageID: Integer): Boolean;
begin
    if CurPageID = wpWelcome then
    begin
        Cancel := False;
        DestPath := 'c:\setup'
        // compress with callback
        SevenZipCreateArchive(szStatus.Handle, 'C:\123.7z', 'c:\setup', ['common\*'], 1, True, False, '', '', False, CallbackAddr('ArchiverCallbackProc'));
        // compress without callback
        //SevenZipCreateArchive(szStatus.Handle, 'd:\123.7z', 'd:\', 'SkypeSetupFull.exe', 1, True, False, '', '', True, 0);
        Result := True;
    end;
end;

Цитата Tco 03:
TERMINAL
Как вариант, могу предложить так: »
его нельзя переименовывать так просто тк путь к экзешнику лежит в реестре и по нему, пути, вызывается удаление
TERMINAL, нужно так:
читать дальше »
Код: Выделить весь код
[Setup]
AppName=My Program
AppVerName=My Program v.1.2
DefaultDirName={pf}\My Program
AppId=proto_15
 
[  Code]
procedure CurStepChanged(CurStep: TSetupStep);
begin
  if CurStep=ssPostInstall then
  begin
    if not RegWriteStringValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{#SetupSetting("AppID")}_is1', 'QuietUninstallString', '"' + ExpandConstant('{app}\Uninstall.exe') + '"' + #32 + '/SILENT') then Exit;
    if RegWriteStringValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{#SetupSetting("AppID")}_is1', 'UninstallString', '"' + ExpandConstant('{app}\Uninstall.exe') + '"') then
    RenameFile(ExpandConstant('{app}\unins000.exe'), ExpandConstant('{app}\Uninstall.exe'));
    if RegWriteStringValue(HKEY_LOCAL_MACHINE, 'SOFTWARE\Microsoft\Windows\CurrentVersion\Uninstall\{#SetupSetting("AppID")}_is1', 'UninstallDataFile', '"' + ExpandConstant('{app}\Uninstall.dat') + '"') then
    RenameFile(ExpandConstant('{app}\unins000.dat'), ExpandConstant('{app}\Uninstall.dat'));
  end;
end;


UPD
Shegorat, пардон, не увидел

Последний раз редактировалось Johny777, 18-02-2013 в 17:04.

Это сообщение посчитали полезным следующие участники:

Отправлено: 16:57, 18-02-2013 | #1669