Ветеран
Сообщения: 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, пардон, не увидел
|