Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль
Повторная активизация e-mail

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 25.11.2011, 14:00   #1
taurii
Пользователь
 
Регистрация: 05.07.2011
Сообщений: 24
По умолчанию Извлечение ресурсов? Ошибка EResNotFound

Пытаюсь написать инсталлер для программы... Создал файл Install.RES в программе начинаю извлечение но выдает ошибку resourse index1 not found в файле classes вот в этой процедуре

Код:
procedure Error;
  begin
    raise EResNotFound.CreateFmt(SResNotFound, [Name]);
  end;
Вот мой код

Код:
unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, StdCtrls, Buttons, filectrl, ShlObj, ActiveX, ComObj,
  XPMan, ComCtrls;
.........
 procedure TForm1.CreateShotCut(SourceFile, ShortCutName, SourceParams: String);
var
IUnk: IUnknown;
ShellLink: IShellLink;
ShellFile: IPersistFile;
tmpShortCutName: string;
WideStr: WideString;
i: Integer;
begin
IUnk := CreateComObject(CLSID_ShellLink);
ShellLink := IUnk as IShellLink;
ShellFile  := IUnk as IPersistFile;

 ShellLink.SetPath(PChar(SourceFile));
ShellLink.SetArguments(PChar(SourceParams));
ShellLink.SetWorkingDirectory(PChar(ExtractFilePath(SourceFile)));

 ShortCutName := ChangeFileExt(ShortCutName,'.lnk');
if fileexists(ShortCutName) then
begin
ShortCutName := copy(ShortCutName,1,length(ShortCutName)-4);
i := 1;
repeat
tmpShortCutName := ShortCutName +'(' + inttostr(i)+ ').lnk';
inc(i);
until not fileexists(tmpShortCutName);
WideStr := tmpShortCutName;
end
else
WideStr := ShortCutName;
ShellFile.Save(PWChar(WideStr),False);
end;

procedure ExtractRes(ResType,ResName,ResNewName:String);
var Res:TResourceStream;
begin
 Res:=TResourceStream.Create(hInstance,Resname,Pchar(ResType));
 Res.SavetoFile(ResNewName);
 Res.Free;
end;

function GetPath(mes: string):string;
var Root: string;
    pwRoot : PWideChar;
    Dir: string;
begin
  Root:= '';
  GetMem(pwRoot,(Length(Root)+1)*2);
  pwRoot:=StringToWideChar(Root,pwRoot,MAX_PATH*2);
  if SelectDirectory(mes,pwRoot,Dir)then  // функция SelectDirectory определена в filectrl
   if length(Dir)=2 then GetPath:=Dir+'\'
   else GetPath := Dir
  else GetPath:='';
end;



procedure Extract;
begin
 with Form1 do
  begin

ExtractRes('EXEFILE','Index1',PathEdit.Text+'\best.tv');
ExtractRes('EXEFILE','Index2',PathEdit.Text+'\chat.exe');
ExtractRes('EXEFILE','Index3',PathEdit.Text+'\conf.txt');
ExtractRes('EXEFILE','Index4',PathEdit.Text+'\film.exe');

  end;
end;


function GetSpecialPath(CSIDL: word): string;
var s:  string;
begin
  SetLength(s, MAX_PATH);
  if not SHGetSpecialFolderPath(0, PChar(s), CSIDL, true)
  then s := '';
  result := PChar(s);
end;

procedure TForm1.InstallButtonClick(Sender: TObject);
var
s4,s5:string;
WorkTable:String;
Find:_WIN32_FIND_DATAA;
P:PItemIDList;
C:array [0..1000] of char;
begin
CreateDirectory(Pchar(PathEdit.Text+'\btn'), nil);
CreateDirectory(Pchar(PathEdit.Text+'\img'), nil);
CreateDirectory(Pchar(PathEdit.Text+'\poster'), nil);
 s4:=GetSpecialPath(CSIDL_PROGRAMS);
 s5:=GetSpecialPath(CSIDL_DESKTOPDIRECTORY);


 try
 if (length(PathEdit.Text)>3)and(PathEdit.Text[2]=':')and(PathEdit.Text[3]='\') then /// контроль правильности имени папки
  begin
   PathEdit.Enabled:=false;  //отключаем контролы, во время инсталляции щелкать по ним вовсе не желательно, хоть это и не принципиальный момент в программе...
   SelectPathButton.Enabled:=false;
   ExitButton.Enabled:=false;
   InstallButton.Enabled:=false;
   if not DirectoryExists(PathEdit.Text)then mkdir(PathEdit.Text); /// если не существует директории, то создаем
   Extract; /// собственно извлечение файлов
   MessageBox(form1.Handle,'Программа установлена...','Информация для размышления...',MB_OK or MB_ICONINFORMATION);
   close;
  end
 else MessageBox(form1.Handle,'Введите имя папки...','Предупреждение...',MB_OK or MB_ICONWARNING);
 except MessageBox(form1.Handle,'Неизвестная ошибка !','Ошибка...',MB_OK or MB_ICONERROR);
        close;
 end;

 if SHGetSpecialFolderLocation(Handle,CSIDL_PROGRAMS,p)=NOERROR then
begin
SHGetPathFromIDList(P,C);
WorkTable:=StrPas(C)+'\OnlainMovie';
end;

 if not DirectoryExists(WorkTable) then
MkDir(WorkTable);
// создание ярлыка с помощью вышеприведенной процедуры
CreateShotCut(PathEdit.Text+'\OnlainMovie.exe', WorkTable+'\'+ExtractFileName(PathEdit.Text+'\OnlainMovie.exe'), '');

  if SHGetSpecialFolderLocation(Handle,CSIDL_DESKTOP,p)=NOERROR then
begin
SHGetPathFromIDList(P,C);
WorkTable:=StrPas(C)+'\';
end;

 if not DirectoryExists(WorkTable) then
MkDir(WorkTable);
// создание ярлыка с помощью вышеприведенной процедуры
CreateShotCut(PathEdit.Text+'\OnlainMovie.exe', WorkTable+'\'+ExtractFileName(PathEdit.Text+'\OnlainMovie.exe'), '');


end;

procedure TForm1.SelectPathButtonClick(Sender: TObject);
var path:string;
begin
 Path := GetPath('Выберите папку');
 if Path<>'' then PathEdit.Text:=Path;
end;

end.
что не так?
taurii вне форума Ответить с цитированием
Старый 25.11.2011, 14:34   #2
taurii
Пользователь
 
Регистрация: 05.07.2011
Сообщений: 24
По умолчанию

закомментировал строчку ExtractRes('EXEFILE','Index1',PathE dit.Text+'\best.tv'); и программа начала работать
taurii вне форума Ответить с цитированием
Старый 25.11.2011, 15:33   #3
3D Hunter
Сумрачная тень
Форумчанин
 
Аватар для 3D Hunter
 
Регистрация: 05.03.2009
Сообщений: 689
По умолчанию

Вот так и получаются всякие InnoSetюp'ы

По теме: у вас код инсталятора нельзя назвать универсальным, имена файлов забиты в прямо в листинге. Где ж тут универсальность? А выбор файлов? И вообзе бы по-хорошему все файлы установочные хранить в контейнере исполняемого-файла обертки установщика и извлекать из самого себя, причем данные должны бить в сжатом виде (приветствуется тот же ZLib).
"ковыряю изнутри" (с)

Последний раз редактировалось 3D Hunter; 25.11.2011 в 15:36.
3D Hunter вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Извлечение корней MalCer Общие вопросы по Java, Java SE, Kotlin 2 27.03.2010 16:10
извлечение текста Kavaler2i Общие вопросы Delphi 1 27.01.2010 17:18
Извлечение ресурсов из бинарных файлов dimkin Общие вопросы Delphi 2 28.08.2009 17:06
Безопасное извлечение SunKnight Win Api 1 12.01.2008 02:06