Details

Written by: Stanko Milosev

Category: Lazarus

Published: 18 December 2011

Last Updated: 18 December 2011

Hits: 7192

Full translation of article from here

function TShelRAS.RasDialEx(_ConnectionName, _ConnectionUser, _ConnectionPass: string): boolean;
var
  nRet: DWORD;
  TempEntryName: RASENTRYNAME;
  EntryBufferSize: DWord;
  EntryWritten: DWord;
  StrErr: string;
  RasEntryNameArray: array of RASENTRYNAME;
  GPRSEntry: integer;
  VRasEntry: RASENTRY;
  dwEntrySize: DWord;
  Buffer: array[0..4098] of char;
  dwBufferSize: DWord;
  iEntry: integer;
  RASDialParameters: RASDIALPARAMS;
  bPassword: BOOL;
  RasRc: DWord;

begin
  try
  TempEntryName.dwSize := sizeof(RASENTRYNAME);
  EntryBufferSize := sizeof(TempEntryName);
  EntryWritten := 0;

  // LogIt(-1, Format ('RasEnumEntries %d', [EntryBufferSize]));
  nRet := RasEnumEntries(nil, nil, @TempEntryName, @EntryBufferSize, @EntryWritten);
  if (nRet <> ERROR_BUFFER_TOO_SMALL) then begin
    StrErr := Format('RasEnumEntries failed: Error %d', [nRet]);
    LogIt(nRet, StrErr);
    Result := False;
    exit;
  end;
  SetLength(RasEntryNameArray, EntryBufferSize);  // DEBUG
  try
    RasEntryNameArray[0].dwSize := sizeof(RASENTRYNAME);
    // LogIt(-1, Format ('RasEnumEntries, EntryWritten:%d', [EntryWritten] ));
    nRet := RasEnumEntries(nil, nil, @RasEntryNameArray[0], @EntryBufferSize, @EntryWritten);
    if (nRet <> 0) then begin
      StrErr := Format('RasEnumEntries failed: Error %d', [nRet]);
      if assigned(RepErrFunc) then begin
        RepErrFunc(nRet, StrErr);
      end;
      Result := False;
      exit;
    end;

    GPRSEntry := -1;
    fillchar(VRasEntry, sizeof(RasEntry), #0);
    VRasEntry.dwSize := sizeof(RasEntry);
    dwEntrySize := sizeof(RasEntry);

    memset(@Buffer, #0, sizeof(Buffer));
    dwBufferSize := sizeof(Buffer);

    for ientry := 0 to EntryWritten-1 do begin
      LogIt(0, 'RasName:' +  RasEntryNameArray[iEntry].szEntryName);
      // Check if the name has GPRS in it
      // AND
      // if Local Phone Number contains "~GPRS!"
      // LogIt(-1, 'RasGetEntryProperties');
      nRet := RasGetEntryProperties(nil, RasEntryNameArray[iEntry].szEntryName, @VRasEntry, @dwEntrySize, nil, nil);
      if (nRet <> 0) then begin
        StrErr := Format('RasGetEntryProperties failed: Error %d', [nRet]);
        if assigned(RepErrFunc) then begin
          RepErrFunc(nRet, StrErr);
        end;
        Result := False;
        exit;
      end;
      LogIt(0, 'Phone..:' +  VRasEntry.szLocalPhoneNumber);

      if (wcsstr(VRasEntry.szLocalPhoneNumber, '111') <> nil) then begin // search for dialnr - our way og checking if connection is ras
        // Found -> RAS entry is GPRS
        GPRSEntry := iEntry;
        break;
      end;
    end;
    if GPRSEntry <> -1 then begin
      Logit(0, 'Connect to:' + RasEntryNameArray[GPRSEntry].szEntryName);
      // LogIt(-1, 'RasGetEntryProperties');
      nRet := RasGetEntryProperties(nil, RasEntryNameArray[GPRSEntry].szEntryName, @VRasEntry,
        @dwEntrySize, @Buffer, @dwBufferSize);
      if (nRet <> 0) then begin
        StrErr := Format('RasGetEntryProperties failed: Error %d', [nRet]);
        if assigned(RepErrFunc) then begin
          RepErrFunc(nRet, StrErr);
        end;
        Result := False;
        exit;
      end;

      // Configure the RASDIALPARAMS structure

      fillchar(RASDialParameters, sizeof(RASDIALPARAMS), #0);

      RASDialParameters.szPhoneNumber[0] := #0;
      RASDialParameters.szCallbackNumber[0] := #0;
      RASDialParameters.dwSize := sizeof(RASDIALPARAMS);
      RASDialParameters.szEntryName := RasEntryNameArray[GPRSEntry].szEntryName;
      RASDialParameters.szUserName := 'username' + #0;
      RASDialParameters.szPassword := 'password' + #0;
      RASDialParameters.szDomain[0] := #0;

      // LogIt(-1, 'RasGetEntryDialParams');
      nRet := RasGetEntryDialParams(nil, @RASDialParameters, @bPassword);
      if (nRet <> 0) then begin
        StrErr := Format('RasGetEntryDialParams failed: Error %d', [nRet]);
        if assigned(RepErrFunc) then begin
          RepErrFunc(nRet, StrErr);
        end;
        Result := False;
        exit;
      end;
      Logit(0, 'DIAL start (be patient)..');
      RasRc := RasDial(nil, nil, @RASDialParameters, 0, nil, @VRASConnection);
      Logit(RasRc, Format('DIAL done, rc: %d', [RasRc]));
      if (RasRc <> 0) then begin
        StrErr := Format('Could not connect using RAS', []);
        LogIt(RasRc, StrErr);
        VRASConnection := 0;
        Result := False;
        exit;
      end;
      Result := True;
    end else begin
      Logit(ERROR_PORT_NOT_FOUND, 'Error: No GPRS connection found!');
      Result := False;
    end;
  finally
    SetLength(RasEntryNameArray, 0);
  end;
  except
    on E: exception do begin
      Logit ( -1, 'ERROR:' + E.Message );
    end;
  end;
  //  Try to establish RAS connection.
end;

My problem was with:

nRet := RasEnumEntries(nil, nil, @RasEntryNameArray[0], @EntryBufferSize, @EntryWritten);

since first call

nRet := RasEnumEntries(nil, nil, @TempEntryName, @EntryBufferSize, @EntryWritten);

Initialize variables, and second call actually enumerates RAS entries, asnd I didn't know that parameter should be called with @RasEntryNameArray[0]

Details

Written by: Stanko Milosev

Category: Lazarus

Published: 12 November 2011

Last Updated: 30 November -0001

Hits: 5470

In the project source you will probably need something like:

Application.ApplicationType:=atPDA

Details

Written by: Stanko Milosev

Category: Lazarus

Published: 12 November 2011

Last Updated: 18 December 2011

Hits: 6180

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)