Динамическая загрузка DLL из ресурса на примере Bass.dll

// return value is nil if function fails
function MemLoadLibrary(var f_data: Pointer; const f_size: int64; fin: byte = FIN_BOTH; attach: boolean = true): PMemModule; stdcall;
// return value is nil if function fails
function MemGetProcAddress(var f_module: PMemModule; const f_name: PAnsiChar): Pointer; stdcall;
// free module
procedure MemFreeLibrary(var f_module: PMemModule); stdcall;
// returns last error
function MemGetLastError: AnsiString; stdcall;

  _BT_MEMORY_MODULE = packed record
    headers: PImageNtHeaders;
    codeBase: Pointer;
    modules: Pointer;
    numModules: integer;
    initialized: boolean;
  end;

procedure MemDllCall;
var
  rm: tResourceStream;
  mem: pointer;
  dlSz: int64;
  mDLL: PMemModule;
  SomeFunc: procedure(i:integer);
begin
  try
    rm:= tResourceStream.Create(hInstance,'MyDLL',RT_RCDATA);
    rm.Position := 0;
    dlSz:=rm.Size;
    mem := GetMemory(dlSz);
    rm.Read(mem^, dlSz);
    rm.Free;
  except
    ShowMessage('Someshit happened while RES load: ' + SysErrorMessage(GetLastError));
    if rm <> nil then rm.Free;
    exit;
  end;
  try
    mDLL:= MemLoadLibrary(mem, dlSz);
    if mDLL <> nil then @SomeFunc := MemGetProcAddress(mDLL, 'SomeFunс');
    if @SomeFunc <> nil then SomeFunc(123);
  except
    ShowMessage('Someshit happened while DLL load: ' + MemGetLastError);
  end;
  if mDLL <> nil then MemFreeLibrary(mDLL);
  FreeMemory(mem);
end;

  if (l_section.Characteristics and IMAGE_SCN_MEM_DISCARDABLE) <> 0 then begin
      // section is not needed any more and can safely be freed
      VirtualFree(Pointer(l_section.Misc.PhysicalAddress), l_section.SizeOfRawData, MEM_DECOMMIT);
      inc(longword(l_section), sizeof(TImageSectionHeader));
      continue;
  end;

{ SectionFinalization Flags: }
  FIN_NOFIN    = $0;//no SectionFinalization
  FIN_PROTECT  = $1;//SectionFinalization with VirtualProtect
  FIN_DISCARD  = $10;//SectionFinalization with Discard
  FIN_BOTH     = $11;//FIN_PROTECT + FIN_DISCARD

////////////////////////////by Markus_13////////////////////////////////////////
program BassMem; { App demonstrating dynamic BASS usage via Memory Projection }
uses Windows,strUtilz,MemModuleUnicode;
//strUtilz - мой модуль с выпиленными asm функ-ми из SysUtils (inttostr/strtoint,etc...)
 
const//КОНСТАНТЫ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  _s='   ';
  _n=#13#10;//разрыв строки
  ver='1.0';//версия
  tit=' Bass Memory App '+ver;//title - название приложения
  msgYN=$04; msgERR=$10; msgINF=$40; //<-коды типов сообщений
  res1='dll';//название ресурса с дллкой
  res2='snd';//название ресурса со звуком
  //всякий трэш:
  mrFail='Unable to load res: ';
  bt1='Pause';
  bt2='Play';
  btX='Close';
  WM_SETICON=$80;
 
type//ТИПЫ::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  MemRes=record//структура для проекции ресурса в память
    p:pointer;//указатель на область памяти
    sz:int64;//размер (длина)
    rd:cardinal;//hResData
    ri:cardinal;//hResInfo
  end;
 
var//ПЕРЕМЕННЫЕ:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
  wnd:cardinal;//хэндл окна
  ss:cardinal;//хэндл звукового потока
  snd:MemRes;//указатель на звуковой файл в памяти
  dll:MemRes;//указатель на дллку в памяти
  bass:PMemModule;//структура проекции длл в памяти
  stp:word;//шаг выполнения (для дебага)
  st:boolean;//статус звукового потока
  th:cardinal;//хэндл потока для замены кнопок
  ti:cardinal;//id потока
//объявляем функции из bass.dll:::::::::::::::::::::::::::::::::::::::::::::::::
  BASS_Init:function(device: integer; freq, flags: cardinal; win: cardinal; clsid: pGUID):bool; stdcall;
  BASS_Free:function: bool; stdcall;
  BASS_StreamCreateFile:function(mem: bool; f: Pointer; offset, length: int64; flags: cardinal): cardinal; stdcall;
  BASS_StreamFree:function(handle: cardinal): bool; stdcall;
  BASS_ChannelPlay:function(handle: cardinal; restart: bool): bool; stdcall;
  BASS_ChannelStop:function(handle: cardinal): bool; stdcall;
  BASS_ChannelPause:function(handle: cardinal): bool; stdcall;
 
{$R BassMem.RES} //ресурс со звуком и либрой
{$R XPMan.res} //ресурс с иконкой и манифестом
 
////////////////////////////////////////////////////////////////////////////////
//ФУНКЦИИ:::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::::
 
function mesaga(m:string;f:longint=0):integer;//выдача сообщения
begin
  result:=MessageBox(wnd,pchar(m+_s),tit,f+$1000);
end;
 
procedure mResFree(mr:MemRes);//освобождаем ресурс
begin
  mr.p:=nil;
  mr.sz:=0;
  UnlockResource(mr.rd);//для совмести с 16-bit Win
  FreeResource(mr.rd);//для совмести с 16-bit Win
  mr.rd:=0;
  mr.ri:=0;
end;
 
function Res2Mem(hInst:cardinal;res:string;rtype:pAnsiChar):MemRes;//проецируем ресурс в память
begin
  result.p:=nil;
  result.ri:=FindResource(hInst,pchar(res),rtype);//находим ресурс
  if result.ri=0 then exit;
  result.sz:=SizeOfResource(hInst,result.ri);//передаем размер в резалт
  if result.sz=0 then exit;
  result.rd:=LoadResource(hInst,result.ri);//загружаем ресурс в память
  if result.rd=0 then exit;
  result.p:=LockResource(result.rd);//фиксируем ресурс в памяти и передаем указатель на него в резалт
end;
 
function mResValid(mr:MemRes):boolean;//проверка валидности проекции ресурса
begin
  result:=(mr.rd>0)and(mr.ri>0)and(mr.p<>nil)and(mr.sz>0);
end;
 
procedure quit(e:string='');//процедура выхода (e - месага ошибки)
begin
  if e<>'' then begin
    e:='Error: '+e+'!'+_s+_n+_s+'Step = '+inttostr(stp);//компонуем месагу
    if MemGetLastError<>'' then//добавляем строку ошибки из MemModule:
      e:=e+_s+_n+_s+'DllMem_Error: '+MemGetLastError;
    mesaga(e,msgErr);//выдаем
  end;
  //освобождаем хэндлы, ресурсы и т.д. (в соответствии с шагом выполнения):
  if stp>=90 then begin
    BASS_ChannelStop(ss);//останавливаем звуковой поток
    BASS_StreamFree(ss);//освобождаем звуковой поток
  end;
  if stp>=70 then BASS_Free;//отключаем bass
  if stp>=80 then mResFree(snd);
  if stp>=60 then MemFreeLibrary(bass);//выгружаем либру
  if stp>=50 then mResFree(dll);
  if th>0 then begin
    if ti>0 then TerminateThread(th,0);
    CloseHandle(th);
  end;
  halt(ord(e<>''));//завершаемся
end;
 
function DlgModify(p:pointer):boolean;//функция замены текста на кнопках в месседжБоксе
var
  w:cardinal;//хэндл диалога
  i:cardinal;//хэндл кнопки
  s:pchar;//строка для замены текста
  c:word;//счетчик
begin
  w:=0;
  c:=0;
  while(w=0)and(c<999)do begin//ждем появления мсгБокса
    sleep(25);
    w:=FindWindow(WC_DIALOG,tit);
    inc(c);
  end;
  if w>0 then begin
    SendMessage(w,WM_SETICON,ICON_SMALL,LoadIcon(hInstance,IDI_APPLICATION));//ставим иконку
    i:=GetDlgItem(w,IdYes);//находим кнопку "Дa"
    if i>0 then begin
      if st then s:=bt1 else s:=bt2;
      SetWindowText(i,s);//пишем "Play/Pause" в соотв-ии со статусом
    end;
    i:=GetDlgItem(w,IdNo);//находим кнопку "Нет"
    if i>0 then begin
      s:=btX;
      SetWindowText(i,s);//пишем "Close"
    end;
  end;
  ExitThread(0);//закрываем поток
  ti:=0;
  result:=true;
end;
 
////////////////////////////////////////////////////////////////////////////////
var sts:shortString;//строка статуса
begin///////////////////////////////////////////////////////////////////////////
  wnd:=0;
  {(можно дописать создание нормального окна с кнопками, но мне лень =)
  поэтому wnd=HWND_DESKTOP, а UI реализуем через MsgBox`ы ниже =)}
  ti:=0;
  stp:=0;
  dll:=Res2Mem(hInstance,res1,RT_RCDATA);//грузим ресурс с либрой в память
  if not mResValid(dll) then quit(mrFail+res1)else stp:=50;//проверяем^
  bass:=MemLoadLibrary(dll.p,dll.sz,FIN_PROTECT);//загружаем либру
  {(юзаем FIN_PROTECT чтобы Discardable секции не вайпались при финализации,
  подробней в статье - http://cyberforum.ru/blogs/14360/blog1682.html)}
  if(bass=nil)or(MemGetLastError<>'')then quit('Unable to load BASS DLL')else stp:=60;//проверяем^
  //получаем адреса функций:
  @BASS_Init:=MemGetProcAddress(bass,'BASS_Init');
  @BASS_Free:=MemGetProcAddress(bass,'BASS_Free');
  @BASS_StreamCreateFile:=MemGetProcAddress(bass,'BASS_StreamCreateFile');
  @BASS_StreamFree:=MemGetProcAddress(bass,'BASS_StreamFree');
  @BASS_ChannelPlay:=MemGetProcAddress(bass,'BASS_ChannelPlay');
  @BASS_ChannelStop:=MemGetProcAddress(bass,'BASS_ChannelStop');
  @BASS_ChannelPause:=MemGetProcAddress(bass,'BASS_ChannelPause');
  //проверяем^:
  if(@BASS_Init=nil)or(@BASS_Free=nil)or(@BASS_StreamCreateFile=nil)or(@BASS_StreamFree=nil)
or(@BASS_ChannelPlay=nil)or(@BASS_ChannelStop=nil)or(@BASS_ChannelPause=nil)then quit('Some of GetProcAddress failed');
  //инициализируем bass и выходим в случае неудачи:
  if not BASS_Init(-1,44100,0,wnd,nil)then quit('Unable to init BASS')else stp:=70;
  snd:=Res2Mem(hInstance,res2,RT_RCDATA);//грузим ресурс со звуком в память
  if not mResValid(snd) then quit(mrFail+res2)else stp:=80;//проверяем^
  ss:=BASS_StreamCreateFile(true,snd.p,0,snd.sz,4{=BASS_SAMPLE_LOOP});//создаем звуковой поток из памяти
  if ss=0 then quit('MemStream creation failed')else stp:=90;//проверяем^
  BASS_ChannelPlay(ss,false);//запускаем звуковой поток (начинаем воспроизведение)
  st:=true;//статус = true = звук проигрывается
  while(true)do begin//реализуем взаимодействие с юзером и делаем вид что у нашей проги есть окно =)))
    if st then sts:='Playing...' else sts:='Paused.  ';
    th:=CreateThread(nil,0,@DlgModify,nil,0,ti);//создаем поток для модификации диалога (месседжБокса)
    if mesaga(' Sound currently '+sts,msgInf+msgYN)=IdNo then break//закрываемся по кнопке "Нет"
    else begin//инверсируем статус по кнопке "Да"
      st:=not st;
      //останавливаем / продолжаем воспроизведение звука в соотв. со статусом:
      if st then BASS_ChannelPlay(ss,false) else BASS_ChannelPause(ss);
      if ti>0 then TerminateThread(th,0);//убиваем поток, если он жив (по невероятному стечению обстоятельств =)
      CloseHandle(th);//закрываем хэндл потока
      th:=0;
    end;
  end;
  quit;//выходим =)
end.