(Resolvido) [Dúvida] DLL

s2pid · Maio 16, 2009

Bom , minha dúvida é a seguinte meus amigos,

fiz uma unit espeicalmente para procedimentos para a dll... ok? certo..

exemplo:

unit UnitDLL;

interface

{ DIVERSÃO }

procedure teste;  ExTeRnaL 'minhadll.dll';

implementation

end.

OK, o problema é que se a DLL não estiver no diretório windows ou system32 , esta mensagem de erro aparece:

Este aplicativo não pode ser iniciado porque não foi encontrado minhadll.dll. A reinstalação do aplicativo pode corrigir o problema..

Isto logicamente acontece porque a dll não esta onde deveria estar , ele procura a dll e se não encontra ele não inicia o aplicativo e mostra essa mensagem..

Queria saber se tem como evitar a mensgem aparecendo , e também gostaria de que ele simplismente ignorasse a verificacao da dll , só fizesse a verificação quando fosse chamado o procedimento da dll.. tem como?

abraços

Churc · Maio 16, 2009

Opa

então, o que voce teria que fazer é, carregar a DLL em tempo de execução (Run-Time)...

vou fazer como exemplo uma function e uma procedure...

** GLOBAL ** (ou seja pra ambos, exe -> dll)
type
  TTeste1Proc = record
    Proc: procedure; StdCall;
    hLib: THandle;
  end;

  TTeste2Func = record
    Func: function: Boolean; StdCall;
    hLib: THandle;
  end;

** DLL **

procedure Teste1; StdCall;
begin
  ShowMessage('Teste');
end;

function Teste2: Boolean; StdCall;
begin
  Result := True;
end;

exports
  Teste1.
  Teste2;

** EXE **

procedure Teste1;
var
  Teste1Proc: TTeste1Proc;
begin
  with Teste1Proc do
  begin
    hLib := LoadLibrary(PChar('caminho_da_DLL.dll'));
    if hLib <> 0 then
    begin
      @Proc := GetProcAddress(hLib, 'Teste1');
      if Assigned(Proc) then
      try
        Proc;
      finally
        FreeLibrary(hLib);
      end
      else
      ShowMessage('Procedure não encontrada na DLL');
    end
    else
    ShowMessage('DLL não encontrada!!');
  end;
end;

function Teste2: Boolean;
var
  Teste2Func: TTeste2Func;
begin
  Result := False;
  with Teste2Func do
  begin
    hLib := LoadLibrary(PChar('caminho_da_DLL.dll'));
    if hLib <> 0 then
    begin
      @Func := GetProcAddress(hLib, 'Teste2');
      if Assigned(Func) then
      try
        Result := Func;
      finally
        FreeLibrary(hLib);
      end
      else
      ShowMessage('Function não encontrada na DLL');
    end
    else
    ShowMessage('DLL não encontrada');
  end;
end;

qualquer dúvida, poste ai...

abrxxx

Editado Maio 16, 2009 por Churc

s2pid · Maio 16, 2009

Entendi , muito obrigado..

Mas o problema é que eu tenho mais de 50 procedures e functions no projeto.. vou ter que fazer getprocadress em todas as func e proc?

não é possível que exista outro jeito :(

Muito obrigado cara.

Churc · Maio 16, 2009

Opa

Então, complicado...

Porque assim, a única maneira de você não ter o Access Violation até onde sei é carregando a DLL em tempo de execução, agora... antes de tudo me diz uma coisa, imagina que a DLL não exista ou não seja encontrada... então seu programa não poderá ser usado certo?

Se caso sim, o que você pode fazer é, vai no Source do Aplicativo através do Menu Project > View Source e logo depois do begin que tem a criação dos Forms (Application.CreateForm...) você faz algo tipo...

uses
  SysUtils;

...
begin
  if not FileExists('caminho_da_DLL.dll') then
  begin
    MessageBox(0, 'DLL não encontrada tal tal tal', 'Erro', MB_OK or MB_ICONERROR);
    Exit;
  end;
...
  Application.CreateForm....

massss nem sei se funcionaria, foi só uma idéia que me veio em mente agora estou sem o Delphi aqui :/ pela lógica, o código que voce importa a DLL fica na Unit exemplo

function Teste; StdCall; External 'nome_da_DLL.dll';

então verificando na Inicialização do Programa talvez funcione...

teste ai :D

se servir maravilha, senao acho que só do jeito que passei mesmo rs

abrxxx

Editado Maio 16, 2009 por Churc

s2pid · Maio 16, 2009

Churc,

Você é muito prestativo...

Mas infelizmente ainda não obtive resultado positivo...se eu conseguir alguma coisa eu volto a postar ok?!

Obrigado pela sua ajuda!

abraço!

EDIT: olha o que achei na net:

só não sei como usar :(

unit Unit2;
{
[===========================================]
[?]uDllFromMem - Loading a DLL from Memory[?]
[v]              Version 1.0              [v]
[c]          Hamtaro aka CorVu5           [c]
[@]     hamtaro.6x.to OR corvu5.6x.to     [@]
[================Description================]
[With this Code, you can load a DLL in your ]
[application directly from Memory, the file ]
[doesnt have to be present on your Harddrive]
[===================Note====================]
[   This example doesnt work with Bound     ]
[       Import Tables at this time          ]
[==================thx to===================]
[              CDW, Cryptocrack             ]
[           & Joachim Bauch for his         ]
[      GetSectionProtection function        ]
[===========================================]
[  there must be 50 ways to learn to hover  ]
[===========================================]
}


interface
uses windows;
type
PImageBaseRelocation = ^TImageBaseRelocation;
  _IMAGE_BASE_RELOCATION = packed record
    VirtualAddress: DWORD;
    SizeOfBlock: DWORD;
end;
{$EXTERNALSYM _IMAGE_BASE_RELOCATION}
  TImageBaseRelocation = _IMAGE_BASE_RELOCATION;
  IMAGE_BASE_RELOCATION = _IMAGE_BASE_RELOCATION;
{$EXTERNALSYM IMAGE_BASE_RELOCATION}





type
PImageImportDescriptor = ^TImageImportDescriptor;
  TImageImportDescriptor = packed record
    OriginalFirstThunk: dword;
    TimeDateStamp: dword;
    ForwarderChain: dword;
    Name: dword;
    FirstThunk: dword;
end;

type
PImageImportByName = ^TImageImportByName;
  TImageImportByName = packed record
    Hint : WORD;
    Name : array[0..255] of Char;
end;

type
PImageThunkData = ^TImageThunkData;
  TImageThunkData = packed record
    case integer of
      0 : (ForwarderString: PBYTE);
      1 : (FunctionPtr    : PDWORD);
      2 : (Ordinal        : DWORD);
      3 : (AddressOfData  : PImageImportByName);
end;

type
  TDllEntryProc = function(hinstdll: THandle; fdwReason: DWORD; lpReserved: Pointer): BOOL; stdcall;

function memLoadLibrary(FileBase : Pointer) : Pointer;
function memGetProcAddress(Physbase : Pointer; NameOfFunction : String) : Pointer;
function memFreeLibrary(physbase : Pointer) : Boolean;
const
IMAGE_REL_BASED_HIGHLOW = 3;
IMAGE_ORDINAL_FLAG32 = DWORD($80000000);
var DllentryProc : TDLLEntryProc;
implementation
//strComp Function from SysUtils
function StrComp(const Str1, Str2: PChar): Integer; assembler;
asm
        PUSH    EDI
        PUSH    ESI
        MOV     EDI,EDX
        MOV     ESI,EAX
        MOV     ECX,0FFFFFFFFH
        XOR     EAX,EAX
        REPNE   SCASB
        NOT     ECX
        MOV     EDI,EDX
        XOR     EDX,EDX
        REPE    CMPSB
        MOV     AL,[ESI-1]
        MOV     DL,[EDI-1]
        SUB     EAX,EDX
        POP     ESI
        POP     EDI
end;

function GetSectionProtection(ImageScn: cardinal): cardinal;
  begin
    Result := 0;
    if (ImageScn and IMAGE_SCN_MEM_NOT_CACHED) <> 0 then
    begin
    Result := Result or PAGE_NOCACHE;
    end;
    if (ImageScn and IMAGE_SCN_MEM_EXECUTE) <> 0 then
    begin
      if (ImageScn and IMAGE_SCN_MEM_READ)<> 0 then
      begin
        if (ImageScn and IMAGE_SCN_MEM_WRITE)<> 0 then
        begin
          Result := Result or PAGE_EXECUTE_READWRITE
        end
        else
        begin
          Result := Result or PAGE_EXECUTE_READ
        end;
      end
      else if (ImageScn and IMAGE_SCN_MEM_WRITE) <> 0 then
      begin
        Result := Result or PAGE_EXECUTE_WRITECOPY
      end
      else
      begin
        Result := Result or PAGE_EXECUTE
      end;
    end
    else if (ImageScn and IMAGE_SCN_MEM_READ)<> 0 then
    begin
      if (ImageScn and IMAGE_SCN_MEM_WRITE) <> 0 then
      begin
        Result := Result or PAGE_READWRITE
      end
      else
      begin
        Result := Result or PAGE_READONLY
      end
    end
    else if (ImageScn and IMAGE_SCN_MEM_WRITE) <> 0 then
    begin
      Result := Result or PAGE_WRITECOPY
    end
    else
    begin
      Result := Result or PAGE_NOACCESS;
    end;
  end;
function memLoadLibrary(FileBase : Pointer) : Pointer;
var
pfilentheader : PIMAGENTHEADERS;
pfiledosheader: PIMAGEDOSHEADER;
pphysntheader : PIMAGENTHEADERS;
pphysdosheader: PIMAGEDOSHEADER;
physbase  : Pointer;
pphyssectionheader : PIMAGESECTIONHEADER;
i : Integer;
importsDir : PImageDataDirectory;
importsBase: Pointer;
importDesc :  PImageImportDescriptor;
importThunk: PImageThunkData;
dll_handle : Cardinal;
importbyname : pimageimportbyname;
relocbase : Pointer;
relocdata : PIMAGeBaseRElocation;
relocitem : PWORD;
reloccount : Integer;
dllproc : TDLLEntryProc;
begin
result := 0;

pfiledosheader := filebase;
pfilentheader  := Pointer(Cardinal(filebase) + pfiledosheader^._lfanew);


////////////////////////
/////////////allozieren/
physbase := VirtualAlloc(Pointer(pfilentheader^.OptionalHeader.ImageBase),pfilentheader^.OptionalHeader.SizeOfImage,MEM_RESERVE,PAGE_READWRITE);
if Cardinal(physbase) = 0 Then begin
physbase := VirtualAlloc(0,pfilentheader^.OptionalHeader.SizeOfImage,MEM_RESERVE Or Mem_COMMIT,PAGE_READWRITE);
end;


/////////////////////////////
/////////////header kopieren/
CopyMemory(physbase,filebase,pfilentheader^.OptionalHeader.SizeOfHeaders);

//header im memory finden & anpassen
pphysdosheader := physbase;
pphysntheader := Pointer(Cardinal(physbase) + pphysdosheader^._lfanew);
pphysntheader^.OptionalHeader.ImageBase := Cardinal(physbase);


///////////////////////////////
/////////////sections kopieren/
pphyssectionheader := Pointer(Cardinal(pphysntheader) + SizeOf(TIMAGENTHEADERS));
for i := 0 To (pphysntheader^.FileHeader.NumberOfSections - 1) do begin
  if pphyssectionheader^.SizeOfRawData = 0 Then begin
    //keine raw data
    ZeroMemory(Pointer(Cardinal(physbase) + pphyssectionheader^.VirtualAddress),pphyssectionheader^.Misc.VirtualSize);
  end else begin
    //raw data vorhanden
    CopyMemory(Pointer(Cardinal(physbase) + pphyssectionheader^.VirtualAddress),Pointer(Cardinal(filebase) + pphyssectionheader^.PointerToRawData),pphyssectionheader^.SizeOfRawData);
  end;
  pphyssectionheader^.Misc.PhysicalAddress :=  Cardinal(physbase) + pphyssectionheader^.VirtualAddress;

  //next one please
  pphyssectionheader :=  Pointer(Cardinal(pphyssectionheader) + SizeOf(TIMAGESECTIONHEADER));
end;


//////////////////////
/////////////imports/
importsBase := Pointer(Cardinal(physbase) + pphysntheader^.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_IMPORT].VirtualAddress);
importDesc := importsBase;
while (importDesc.Name) <> 0 Do begin
  dll_handle := LoadLibrary(pchar(Cardinal(physbase) + importdesc.Name));
  importDesc.ForwarderChain := dll_handle;
  importThunk := Pointer(Cardinal(physbase) +  importDesc.FirstThunk);
  while importThunk.Ordinal <> 0 Do begin
    importbyname := Pointer(Cardinal(physbase) + importThunk.Ordinal);
    //Später noch überprüfen ob OriginalFirstThunk = 0
    if (importThunk.Ordinal and IMAGE_ORDINAL_FLAG32) <> 0 Then
    begin //ordinal
      importThunk.FunctionPtr := GetProcaddress(dll_handle,pchar(importThunk.Ordinal and $ffff))
    end else begin //normal
      importThunk.FunctionPtr := GetProcAddress(dll_handle,importByname.name);
    end;
  //next one, please
  importThunk := Pointer(Cardinal(importThunk) + SizeOf(TIMAGETHUNKDATA));
  end;
//next one, please
importDesc := Pointer(Cardinal(importDesc) + sizeOf(TIMAGEIMPORTDESCRIPTOR));
end;


/////////////////////
/////////////relocs/
relocbase := Pointer(Cardinal(physbase) + pphysntheader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].VirtualAddress);
relocData := RElocbase;
while (Cardinal(relocdata) -  Cardinal(relocbase)) < pphysntheader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_BASERELOC].Size do begin
  reloccount := trunc((relocdata.SizeOfBlock - 8) / 2);
  relocitem  := Pointer(Cardinal(relocdata) + 8);
  For i := 0 To (reloccount - 1) do begin
    if (relocitem^ shr 12) = IMAGE_REL_BASED_HIGHLOW Then begin
      Inc(PDWord(Cardinal(physbase) + relocdata.VirtualAddress + (relocitem^ and $FFF))^,(Cardinal(physbase) - pfilentheader.OptionalHeader.ImageBase));
    end;
    relocitem := Pointer(Cardinal(relocitem) + SizeOf(WORD));
  end;

  //next one please
  relocdata := Pointer(Cardinal(relocdata) + relocdata.SizeOfBlock);
end;


/////////////////////////////////
////////Section protection & so/
pphyssectionheader := Pointer(Cardinal(pphysntheader) + SizeOf(TIMAGENTHEADERS));
For i := 0 To (pphysntheader^.FileHeader.NumberOfSections - 1) do begin
  VirtualProtect(Pointer(Cardinal(physbase) + pphyssectionheader^.VirtualAddress),pphyssectionheader^.Misc.VirtualSize,GetSectionProtection(pphyssectionheader.Characteristics),nil);
  pphyssectionheader := Pointer(Cardinal(pphyssectionheader) + SizeOf(TIMAGESECTIONHEADER));
end;


////////////////////////////////
////////////////Dll entry proc/
dllEntryproc := Pointer(Cardinal(physbase) + pphysntheader.OptionalHeader.AddressOfEntryPoint);
dllEntryproc(cardinal(physbase),DLL_PROCESS_ATTACH,nil);

result := physbase;
end;

function memGetProcAddress(Physbase : Pointer; NameOfFunction : String) : Pointer;
var
pdosheader: PIMAGEDOSHEADER;
pntheader : PIMAGENTHEADERS;
pexportdir: PImageExportDirectory;
i : Integer;
pexportname : PDWORD;
pexportordinal : PWORD;
pexportFunction : PDWORD;
begin
result := 0;
pdosheader := physbase;
pntheader := Pointer(Cardinal(physbase) + pdosheader._lfanew);
pexportdir := Pointer(Cardinal(physbase) + pntheader.OptionalHeader.DataDirectory[IMAGE_DIRECTORY_ENTRY_EXPORT].VirtualAddress);
if pexportdir.NumberOfFunctions Or pexportdir.NumberOfNames  = 0 Then exit;
pexportName    := Pointer(Cardinal(physbase) + Cardinal(pexportDir.AddressOfNames));
pexportordinal := Pointer(Cardinal(physbase) + Cardinal(pexportDir.AddressOfNameOrdinals));
pexportFunction:= Pointer(Cardinal(physbase) + Cardinal(pexportDir.AddressOfFunctions));

For i := 0 To (pexportdir.NumberOfNames - 1) Do begin
  if StrComp(pchar(Pointer(Cardinal(physbase) + pexportName^)),pchar(NameOfFunction)) = 0 Then begin
    result := pchar(Pointer(Cardinal(physbase) + pexportFunction^));
    break;
  end;

  //next one, please
  Inc(pexportFunction);
  Inc(pexportName);
  Inc(pexportOrdinal);
end;
end;
function memFreeLibrary(physbase : Pointer) : Boolean;
begin
try begin
  //Keine Ahnung ob die DLL ihre Imports wieder "Free't" wenn man DLL_PROCESS_DETACH aufruft
  result := true;
  dllEntryProc(Cardinal(physbase),DLL_PROCESS_DETACH,0);
  VirtualFree(physbase,0,MEM_RELEASE);
end except
  result := false;
end;
end;
end.

Editado Maio 17, 2009 por s2pid

Churc · Maio 19, 2009

Opa

Amigo também não tenho a menor noção de como funciona isso rs

Mas sinceramente, nem vira... isso é gambiarra, uma hora ou outra da problema... ai derrepente funciona no XP mas não no Vista, funciona no Vista mas não no Seven e por ai vai...

então realmente acho que nem vale a pena...

rss

abrxx

s2pid · Maio 19, 2009

É amigão... Você tem razão :D

Deicha eu te pergunta uma coisa? será que da para min colocar uma coleção de procedures e functions em um record? ou tem que 1 por 1 ?

Abraço!

Churc · Maio 20, 2009

Opa

Da sim amigo, contanto que estas functions e procedures estejam na mesma DLL

tipo

TNomeDLL = record
  hLib: THandle;
  FuncX: function: Boolean; StdCall;
  ProcX: procedure; StdCall;
  Bla: function(lpBuff: Pchar); StdCall;
  Teste: procedure(b: BOOL); StdCall;
end;

ai voce faz

var
  NomeDLL: TNomeDLL;

procedure LoadDLL;
begin
  with NomeDLL do
  begin
    hLib := LoadLibrary(PChar('caminho_da_DLL.dll'));
    if hLib <> 0 then
    begin
      @FuncX := GetProcAddress(hLib, 'FuncX');
      @ProcX := GetProcAddress(hLib, 'ProcX');
      @Bla := GetProcAddress(hLib, 'Bla');
      @Teste := GetProcAddress(hLib, 'Teste');
    end
    else
    ShowMessage('DLL não encontrada');
  end;
end;

Pra chamar, voce usa a variavel Global "NomeDLL"...

exemplo

if Assigned(NomeDLL.FuncX) then
if NomeDLL.FuncX then
True else
False;

e por ai vai...

espero que deu pra entender rs

abrxx

Editado Maio 20, 2009 por Churc

s2pid · Maio 22, 2009

Muito obrigado viu Churc, além de prestativo você é o cara!

Sou seu fan :D

Obrigado pela suas dicas amigão!

abraço

Churc · Maio 25, 2009

opa

auhahua magina brother :D

precisando é noixx hehe

abraxx

Entrar

(Resolvido) [Dúvida] DLL

Pergunta

s2pid

Link para o comentário

Compartilhar em outros sites

9 respostass a esta questão

Posts Recomendados

Churc

Link para o comentário

Compartilhar em outros sites

s2pid

Link para o comentário

Compartilhar em outros sites

Churc

Link para o comentário

Compartilhar em outros sites

s2pid

Link para o comentário

Compartilhar em outros sites

Churc

Link para o comentário

Compartilhar em outros sites

s2pid

Link para o comentário

Compartilhar em outros sites

Churc

Link para o comentário

Compartilhar em outros sites

s2pid

Link para o comentário

Compartilhar em outros sites

Churc

Link para o comentário

Compartilhar em outros sites

Participe da discussão

Estatísticas dos Fóruns

Navegação

Atividades