DLL - conexao dinamica

/*** ATENCAO, no final do arquivo um exemplo que funcionou nos teste e pratico ////

Conexão dinamica com uma DLL

Uso normal de DLL

-----------------

Unit NotAGoodIdea;

interface

  function MyDLLFunction: Integer;

implementation

  function MyDLLFunction; external 'MYFUNC.DLL' index 1

end.

O problema é que, a primeira coisa que o programa vai fazer é tentar a conexão com a dll.

Se a DLL está na máquina, não tem problema, mas se por alguma razão a DLL não está presente

o Windows irá gerar um grande e feio erro numa caixa de dialogo e vai explodir o programa.

O código abaixo, primeiro procura a DLL, caso ela não esteja mostra uma mensagem programada.

se estiver presente faz uma conexão manual via LoadLibrary. Note: é necessário dar um FreeLibrary

para liberar a DLL da memória.

O exemplo abaixo é como se fosse um component

type

  ProcGetUserName        = FUNCTION(ID : PChar): Integer;

var

  VnsGetUserName         : ProcGetUserName;

constructor TVines.Create(AOwner: TComponent);

var

  LastState : Word;

  ThePtr    : Pointer;

begin

  inherited Create(AOwner);

  // Este Word abaixo suprime a mensagem de erro ao carregar a DLL caso ela não exista.

  LastState := SetErrorMode(sem_NoOpenFileErrorBox);

  // Carrega a DLL na variavel hBinesDLL (HINSTANCE)

  hVinesDLL := LoadLibrary('Z:\VNSAPI.DLL');

  // Diz pro Windows que o estado do erro retorna ao normal (senão ele não mostra mais nenhum erro)

  SetErrorMode(LastState);

  // If the return value from LoadLibrary is greater than the

  // constant HINSTANCE_ERROR, then the load was sucessful.

  VinesAvailable := (hVinesDLL > HINSTANCE_ERROR);

  // Go get a pointer to the address of the VnsGetUserName procedure

  ThePtr := GetProcAddress(hVinesDLL,'VnsGetUserName');

  // Typecast the pointer as a procedure of type ProcGetUserName

  VnsGetUserName := ProcGetUserName(ThePtr);

end;

Now later on, when you want to access the function in the DLL, you would do something like this:

Procedure TVines.GetTheUser;

var

  ID : Array[0..80] of Char;

begin

  // Setup a array to hold the users name

  FillChar(ID,SizeOf(ID),#0);

  // Don't call the function if the DLL was not loaded correctly!

  if VinesAvailable then

    begin

      // Call the DLL to retrieve the users name

      FError := VnsGetUserName(ID);

      if (VinesError = 0) then

        begin

          // function call was good, clear any error message...

          FMessage := '';

          // ... and save the user name

          FUser := StrPas(ID);

        end

      else

        begin

          // DLL call failed, set an error message...

          FMessage := 'Unable to identify user';

          // ... and call any user-defined error handler

          If Assigned(FOnError) then FOnError(Self);

        end;

    end;

end;

// Lastly, when the component is destroyed, you need to free the DLL:

destructor TVines.Destroy;

begin

  If VinesAvailable Then FreeLibrary(hVinesDLL);

  inherited Destroy;

end;

/////////////////////////////////////////////////////////////////////////////////////////////////////

                   EXEMPLO TESTADO POR FLAVIO JUNIOR EM 27/11/2000

/////////////////////////////////////////////////////////////////////////////////////////////////////

{ Eu fiz um programa uma vez chamado mr.bean, ele tinha que ocultar o programa da lista de

  processos no Ctrl+Alt+Del. Até aí tudo bem é só usar uma função da KERNEL32, porém este

  programa dava pau no Win2000. Ou seja na DLL KERNEL32 do Nt a funcao nao existia. Como carregar

  a dll SOMENTE se o Windows for 9x? Veja o código completo abaixo (note na tela tinha apenas 2 buttons)

}

var

  Form1     : TForm1;

  Handle_DLL: THandle;

type

  PRegistraProcesso  = function(dwProcessID, dwType: DWord): DWord; stdcall;

var

  RegistraProcesso: PRegistraProcesso;

implementation

{$R *.DFM}

// se for NT devolve true

function WinNT: Boolean;

var

  verInfo: TOsVersionInfo;

begin

  Result := False;

  verInfo.dwOSVersionInfoSize := SizeOf(TOSVersionInfo);

  if GetVersionEx(verInfo) then

    Result := verInfo.dwPlatformId = VER_PLATFORM_WIN32_NT;

end;

procedure TForm1.Button1Click(Sender: TObject);

begin

  if not WinNT then RegistraProcesso(GetCurrentProcessID,1);

end;

procedure TForm1.Button2Click(Sender: TObject);

begin

  if not WinNT then RegistraProcesso(GetCurrentProcessID,0);

end;

procedure TForm1.FormCreate(Sender: TObject);

var

  LastState : Word;

  dllOk     : Boolean;

  P         : Pointer;

begin

  if WinNT then Exit;

  LastState  := SetErrorMode(sem_NoOpenFileErrorBox);                 // Desvia o ponteiro de erros do Windows

  Handle_DLL := LoadLibrary( 'KERNEL32.DLL');                         // carrega a dll

  SetErrorMode(LastState);                                            // volta estado de erro para o original

  DLLOK      := (Handle_DLL > HINSTANCE_ERROR);                       // a var e esq. contem true se tudo estiver ok

  P          := GetProcAddress(Handle_DLL, 'RegisterServiceProcess'); // carrega a funcao da dll

  RegistraProcesso := PRegistraProcesso(P);                           // associa a var para usar a funcao

end;

procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction);

begin

  FreeLibrary(Handle_DLL); // libera da memoria 

end;

end.