Экспертная система Delphi.int.ru

Сообщество программистов
Общение, помощь, обмен опытом
Логин:
Пароль:
Регистрация | Забыли пароль?

Delphi.int.ru Expert

Другие разделы портала

Переход к вопросу:

#   

Статистика за сегодня:  


Лучшие эксперты

Подробнее »

Вопрос # 2 889

Раздел: Delphi » Программирование с помощью API
/ вопрос открыт /

Здравствуйте, эксперты!

Я пишу программу на Delphi7 с kol, для замены ресурсов в файле exe dll из другого файла dll. Но я столкнулся с проблемой, когда пытаюсь заменить иконку из одного dll файла в другой. Замена идет не правильно. Как исправить? Еще хотелось бы знать как засунуть любую иконку в файл Dll правильно, т.е. имеется файл new.ico и мне надо записать его как-то в ресурс файла RT_GROUP_ICON и RT_ICON, так чтобы было правильно все и на другие иконки не повлияло. Как такое сделать? Заранее спасибо.

Приложение:
  1. program UpdateResources;
  2.  
  3. uses
  4. Windows, Messages, Kol;
  5.  
  6. type
  7. PForm1 = ^TForm1;
  8. TForm1 = object(TObj)
  9. form: PControl;
  10. public
  11. procedure butClick(Sender:Pobj);
  12. end;
  13. {$I MCKfakeClasses.inc}
  14.  
  15.  
  16. var
  17. Form1: PForm1;
  18. Edit:array[1..2] of tkolEditBox;
  19.  
  20. function GetIDRes(strS:string):integer;
  21. const dd:array[1..19] of Pchar=('RT_CURSOR','RT_BITMAP','RT_ICON',
  22. 'RT_MENU','RT_DIALOG','RT_STRING','RT_FONTDIR','RT_FONT',
  23. 'RT_ACCELERATOR','RT_RCDATA','RT_MESSAGETABLE','RT_GROUP_CURSOR', 'RT_GROUP_ICON',
  24. 'RT_VERSION','RT_DLGINCLUDE','RT_PLUGPLAY','RT_VXD','RT_ANICURSOR','RT_ANIICON');
  25. const tt:array[1..19] of DWord=(1,2,3,4,5,6,7,8,9,10,11,DWORD(RT_CURSOR + DIFFERENCE),
  26. DWORD(RT_ICON + DIFFERENCE),16,17,19,20,21,22);
  27. var i:integer;
  28. begin
  29. result:=0;
  30. for i:=1 to 19 do begin
  31. if uppercase(strS)=dd[i] then begin
  32. result:=tt[i];Break;
  33. end;
  34. end;
  35. end;
  36.  
  37. function enumResNamesProc(module: HMODULE; restype, resname: PChar;
  38. list: PstrList): Integer; stdcall;
  39. begin
  40. if HiWord(Cardinal(resname)) <> 0 then
  41. list.Add(resname)
  42. else
  43. list.Add('#'+int2str(loword(Cardinal(resname))));
  44. Result := 1;
  45. end;
  46.  
  47. Function StockResourceType(restype: PChar): string;
  48. const
  49. restypenames: Array [1..22] of String =
  50. ( 'RT_CURSOR', // = MakeIntResource(1);
  51. 'RT_BITMAP', // = MakeIntResource(2);
  52. 'RT_ICON', // = MakeIntResource(3);
  53. 'RT_MENU', // = MakeIntResource(4);
  54. 'RT_DIALOG', // = MakeIntResource(5);
  55. 'RT_STRING', // = MakeIntResource(6);
  56. 'RT_FONTDIR',// = MakeIntResource(7);
  57. 'RT_FONT', // = MakeIntResource(8);
  58. 'RT_ACCELERATOR',// = MakeIntResource(9);
  59. 'RT_RCDATA', // = MakeIntResource(10);
  60. 'RT_MESSAGETABLE',// = MakeIntResource(11);
  61. // DIFFERENCE = 11;
  62. 'RT_GROUP_CURSOR',// = MakeIntResource(DWORD(RT_CURSOR +7DIFFERENCE));
  63. 'UNKNOWN', // 13 not used
  64. 'RT_GROUP_ICON', // = MakeIntResource(DWORD(RT_ICON +DIFFERENCE));
  65. 'UNKNOWN', // 15 not used
  66. 'RT_VERSION', // = MakeIntResource(16);
  67. 'RT_DLGINCLUDE', // = MakeIntResource(17);
  68. 'UNKNOWN',
  69. 'RT_PLUGPLAY', // = MakeIntResource(19);
  70. 'RT_VXD', // = MakeIntResource(20);
  71. 'RT_ANICURSOR', // = MakeIntResource(21);
  72. 'RT_ANIICON' // = MakeIntResource(22);
  73. );
  74. var
  75. resid: Cardinal absolute restype;
  76. begin
  77. if resid in [1..22] then
  78. Result := restypenames[resid]
  79. else
  80. Result := 'UNKNOWN';
  81. end;
  82.  
  83. function enumResTypesProc(module: HMODULE; restype: PChar; list: PstrList): Integer; stdcall;
  84. begin
  85. EnumResourceNames(module, restype, @enumResNamesProc, Integer(list));
  86. Result := 1;
  87. end;
  88.  
  89. function ListNameTyp(module: HMODULE; restype: PChar; list: PstrList): Integer; stdcall;
  90. begin
  91. if HiWord(Cardinal(restype)) <> 0 then
  92. list.Add(restype)
  93. else
  94. list.Add(StockResourcetype(restype));
  95. EnumResourceNames(module, restype, nil, Integer(list));
  96. Result := 1;
  97. end;
  98.  
  99. function Resource(HModule:Cardinal; strFile:pchar):string;
  100. var ListNameType,listNameRes: PstrList;
  101. i,d,id:integer;
  102. strSNameTyp, strSNameRes:string;
  103. hResLoad,hResData,hUGeneralHandle:cardinal;
  104. data:pointer;
  105. label getlabel;
  106. begin
  107. Result:='';
  108. ListNameType:=NewStrList;
  109. listNameRes:=NewStrList;
  110. try
  111. if EnumResourceTypes(HModule, @ListNameTyp, Integer(ListNameType)) then
  112. begin
  113. hUGeneralHandle:=BeginUpdateResource(strFile, false);
  114. if hUGeneralHandle=0 then begin goto getlabel; result:=str1 end;
  115. for i:=0 to ListNameType.Count-1 do
  116. begin
  117. strSNameTyp:=ListNameType.Items[i];
  118. id:=GetIDRes(strSNameTyp);
  119. listNameRes.Clear;
  120. if id>0 then enumResTypesProc(HModule, MAKEINTRESOURCE(id), listNameRes) else
  121. enumResTypesProc(HModule, pchar(strSNameTyp), listNameRes);
  122. for d:=0 to listNameRes.Count-1 do
  123. begin
  124. strSNameRes:=listNameRes.Items[d];
  125. if id>0 then hResLoad:=FindResource(HModule, Pchar(strSNameRes), MAKEINTRESOURCE(id)) else
  126. hResLoad:=FindResource(HModule, Pchar(strSNameRes), pchar(strSNameTyp));
  127. if hResLoad=0 then begin goto getlabel; result:=str1 end;
  128. hResData:=LoadResource(HModule, hResLoad);
  129. if hResData=0 then begin goto getlabel; result:=str1 end;
  130. data:=LockResource(hResData);
  131. if data=nil then begin goto getlabel; result:=str1 end;
  132. if pos('#',strSNameRes)=1 then strSNameRes:=copy(strSNameRes,2,length(strSNameRes)-1);
  133. if id>0 then UpdateResource(hUGeneralHandle, MAKEINTRESOURCE(id), Pchar(strSNameRes), 1049, Data,SizeofResource(hModule, hResLoad)) else
  134. UpdateResource(hUGeneralHandle, pchar(strSNameTyp), Pchar(strSNameRes), 1049, Data,SizeofResource(hModule, hResLoad));
  135. end;
  136. end;
  137. if EndUpdateResource(hUGeneralHandle, false) then result:=str2;
  138. getlabel:end;
  139. finally
  140. listNameRes.Free;
  141. ListNameType.Free;
  142. end;
  143. end;
  144.  
  145. procedure resUpdate(strSFile1,strSFile2:Pchar);
  146. var hModuleHandle:cardinal;
  147. s:string;
  148. begin
  149. hModuleHandle:=LoadLibraryEx(strSFile1,0,LOAD_LIBRARY_AS_DATAFILE);
  150. if hModuleHandle<>0 then s:=Resource(hModuleHandle,strSFile2);
  151. FreeLibrary(hModuleHandle);
  152. showmessage(s);
  153. end;
  154.  
  155. procedure TForm1.butClick(Sender:Pobj);
  156. begin
  157. resUpdate(pchar(Edit[1].text),pchar(Edit[2].text));
  158. end;
  159.  
  160. procedure NewForm1(var Result: PForm1; AParent: PControl);
  161. var Path:string;
  162. but:tkolbutton;
  163. i:integer;
  164. begin
  165. New(Result, Create);
  166. with Result^ do
  167. begin
  168. Path:=ExtractFilePath(paramstr(0));
  169. form := NewForm(AParent, 'UpdateResourceFile').SetSize(250,130);
  170. form.Add2AutoFree(Result);
  171. Applet := form;
  172. form.Border:=0;
  173. form.ExStyle := Form.ExStyle or WS_EX_LAYERED or WS_EX_TOPMOST;
  174. Form.Style := WS_BORDER or WS_SYSMENU or WS_VISIBLE;
  175. form.Color:=clWindow;
  176. form.CenterOnParent;
  177. for i:=1 to 2 do begin
  178. Edit[i]:=NewEditbox(form,[]).SetPosition(5,i*18).setsize(233,18);
  179. Edit[i].Height:=18;
  180. Edit[i].Color:=clGrayText;
  181. end;
  182.  
  183.  
  184. but:=NewButton(form,'UpdateResourceFile').SetSize(140,25).setposition(5,63);
  185. but.OnClick:=butClick;
  186. SetLayeredWindowAttributes(Form.Handle, 0, 200, LWA_ALPHA);
  187. end;
  188. end;
  189.  
  190. begin
  191. NewForm1(Form1, nil);
  192. Run(Applet);
  193. end.


Nikfel Вопрос ожидает решения (принимаются ответы, доступен мини-форум)

Вопрос задал: Nikfel (статус: Посетитель)
Вопрос отправлен: 7 июня 2009, 11:54
Состояние вопроса: открыт, ответов: 0.


Мини-форум вопроса

Мини-форум пуст.

Чтобы оставлять сообщения в мини-форумах, Вы должны авторизироваться на сайте.
Версия движка: 2.6+ (26.01.2011)
© 2005-2025
Текущее время: 22 февраля 2025, 11:31
Выполнено за 0.02 сек.