Details

Written by: Stanko Milosev

Category: Lazarus

Published: 12 November 2011

Last Updated: 18 December 2011

Hits: 5642

This is one example of late binding using Lazarus, and example of disabling radio frequency DENSO BHT-200BW-CE devices, API manual you can download from here.

 

...
uses dynlibs;

...

procedure TForm1.Button4Click(Sender: TObject);
type
  TBHT_RF_CloseEx = function(_opt:DWord): DWord; stdcall;
var
  BHT_RF_CloseEx : TBHT_RF_CloseEx;
  FDllHandle: TLibHandle;
  intRes: DWord;
  intError: Integer;
begin
  FDllHandle := LoadLibrary('BHTLib.dll');
  intError := GetLastError;
  if FDLLHandle = NilHandle then begin
   ShowMessage(SysErrorMessage(intError) + ' (Error ' + IntToStr(intError) + ')');
  end else begin
    BHT_RF_CloseEx := TBHT_RF_CloseEx(GetProcedureAddress(FDllHandle, 'BHT_RF_CloseEx'));
    intError := GetLastError;
    if BHT_RF_CloseEx = nil then begin
      ShowMessage(SysErrorMessage(intError) + ' (Error ' + IntToStr(intError) + ')')
    end else begin
      intRes := BHT_RF_CloseEx(1);
    end;
  end;
end;

Another example is:

procedure TForm1.Button4Click(Sender: TObject);
type
  TBHT_RF_CloseEx  = function(_opt:DWord): DWord; stdcall;
var
  BHT_RF_CloseEx : TBHT_RF_CloseEx;
  p: pointer;
  FDllHandle: TLibHandle;
  intRes: DWord;
  intError: Integer;
begin
  FDllHandle := LoadLibrary('BHTLib.dll');
  intError := GetLastError;
  if FDLLHandle = NilHandle then begin
   ShowMessage(SysErrorMessage(intError) + ' (Error ' + IntToStr(intError) + ')');
  end else begin
    p := GetProcAddress(VBHTLibHandle, 'BHT_RF_CloseEx');
    if p <> nil then begin
      Pointer(BHT_RF_CloseEx) := p;
    end;
    intError := GetLastError;
    if BHT_RF_CloseEx = nil then begin
      ShowMessage(SysErrorMessage(intError) + ' (Error ' + IntToStr(intError) + ')')
    end else begin
      intRes := BHT_RF_CloseEx();
    end;
  end;
end;

For opening and closing you can use:

BHT_RF_Open() (*1)
BHT_RF_Close() (*2)
BHT_RF_OpenEx(COMM_CONTINUOUS)
BHT_RF_CloseEx(COMM_CONTINUOUS)

(*1) Includes BHT_RF_OpenEx(COMM_NORMAL)
(*2) Includes BHT_RF_CloseEx(COMM_NORMAL)

Where COMM_CONTINUOUS is 1, and COMM_NORMAL is 0 (I hope)

Details

Written by: Stanko Milosev

Category: Lazarus

Published: 09 November 2011

Last Updated: 18 December 2011

Hits: 6164

Code is taken from here, and translated to Lazarus.

Dialing:

uses ras

...
var
  rasDialParam:RASDIALPARAMS;

  pRasConn:HRASCONN;

  dwResult: DWORD;

begin
  pRasConn := null;

  FillChar(rasDialParam, SizeOf(RASDIALPARAMS), 0);
  rasDialParam.dwSize:=SizeOf(RASDIALPARAMS);
  rasDialParam.szCallbackNumber[0]:=#0;
  rasDialParam.szDomain[0]:=#0;
  rasDialParam.szEntryName:='ConnName'; //important, name of the connection which I want to use
  rasDialParam.szPassword:='pass'; //important, if pass or user is wrong, then I will receive error code 619
  rasDialParam.szPhoneNumber[0]:=#0; 
  rasDialParam.szUserName:='user'; //important

  dwResult := RasDial(nil, nil, @rasDialParam, null, nil, @pRasConn);
  if dwResult = ERROR_SUCCESS then
    ShowMesage('It is working')
  else
    ShowMesage('Error: ' + IntToStr(dwResult))

Get connection status:

...
var
  dwResult: DWORD;
  MyRasconnstatus: RASCONNSTATUS;
...
 dwResult := RasGetConnectStatus(VRasConn, @MyRasconnstatus);
 if dwResult = ERROR_SUCCESS then 
 begin
   if MyRasconnstatus.rasconnstate = RASCS_Connected then 
   begin
     ShowMessage('Connected')
   end 
   else 
   begin
     ShowMessage('Not connected')
   end;
 end;

Hang up:

 RasHangUp(VRasConn)

List of error codes you can find here, or here.