Показать сообщение отдельно
  #6  
Старый 12.07.2010, 19:23
Romix Romix вне форума
Начинающий
 
Регистрация: 10.02.2008
Сообщения: 136
Версия Delphi: XE2
Репутация: 41
По умолчанию

Погуглил... Нашёл!!. Вроде все правильно... То что нужно... Но не работает... Пожалуйста проверьте... Объясните...

Код:
unit MainIcon;
interface
uses Windows;
function ChangeMAINICON(SourceExe, TargetExe: String): Boolean;
implementation
////////////////////////////////////////////////////////////////////////////////
// Аналог макроса MAKELANGID в С++ //
// Возвращает языковой идетификатор //
////////////////////////////////////////////////////////////////////////////////
function MAKELANGID(p :DWORD ;s : DWORD) : LANGID;
begin
Result := (s shl 10) or (p);
end;
////////////////////////////////////////////////////////////////////////////////
// Функция GetMAINICONLanguage получает имя exe-файла и возвращает //
// языковой идетификатор его главной иконки //
////////////////////////////////////////////////////////////////////////////////
function GetMAINICONLanguage(const sFileName: String): LANGID;
// Функция обратного вызова. Вызывается для каждого языкового
// идентификатора данного ресурса. В lParam ей передаю указатель на переменную,
// в которую возвратится результат.
function EnumResLangProc(hModule: THandle; lpszType: PChar;
lpszName: PChar; wIDLanguage: WORD;
lParam: Pointer): BOOL; stdcall;
begin
PWORD(lParam)^ := wIDLanguage;
Result := False; // После первого вызова сразу прекращаем перебор,
// т.к. не видел ни одной проги с разными иконками под разные языки
end;

var hExe: THandle;
begin
hExe := LoadLibrary(PChar(sFileName)); // Загружаю файл.
// Запускаю перебор языков главной иконки
EnumResourceLanguages(hExe, RT_ICON, MakeIntResource(1),
@EnumResLangProc, LPARAM(@Result));
FreeLibrary(hExe); // Выгружаю файл
end;
////////////////////////////////////////////////////////////////////////////////
// ::: Функция ChangeMAINICON ::: //
// //
// Зачада: Изменяет главную иконку целевого exe-файла, на главную //
// иконку исходного файла путем правки ресурсов. //
// (пока под главной иконкой подразумевается иконка //
// с индексом = 1) //
// //
// Входные данные: SourceExe, TargetExe - текстовые строки с путями к //
// исходному и целевому exe-фаайлам. //
// //
// Выходные данные: True - замена иконки произошла успешно, //
// False - ошибка, замена не произошла. //
////////////////////////////////////////////////////////////////////////////////
function ChangeMAINICON(SourceExe, TargetExe: String): Boolean;
var
hResLoad, hRes: HRSRC;
hExe, hUpdateRes: THandle;
lpResLock: PChar;
begin
Result := False;
// Загружаем источник иконки как библиотеку (с ресурсами)
hExe := LoadLibrary(PChar(SourceExe));
if hExe = 0 then Exit;
try
// Ищем в источнике главную иконку
hRes := FindResource(hExe, MakeIntResource(1), RT_ICON);
if hRes = 0 then Exit;
// Загружаем иконку
hResLoad := LoadResource(hExe, hRes);
if hResLoad = 0 then Exit;
// Лочим ресурс иконки. Получаем указатель не ее данные.
lpResLock := LockResource(hResLoad);
if lpResLock = nil then Exit;
// Открываем TargetExe для редактирования ресурсов
hUpdateRes := BeginUpdateResource(PChar(TargetExe), False);
if hUpdateRes = 0 then Exit;
// Заменяем главную иконку TargetExe на SourceExe
if UpdateResource(hUpdateRes, RT_ICON, MakeIntResource(1),
GetMAINICONLanguage(PChar(TargetExe)), // ???
lpResLock, SizeofResource(hExe, hRes)) = False then Exit;
// Сохраняем сделанные изменения
Result := EndUpdateResource(hUpdateRes, False);
finally
// В любом случае закрываем открытый SourceExe
FreeLibrary(hExe);
end;
end;
////////////////////////////////////////////////////////////////////////////////
end.
Ответить с цитированием