// ===========================================================================
// zRas.ds
// Dialog include file for accessing Windows RAS functions
// Version 2003-08-03 (Jürgen Haible, http://www.elbiah.de/tools/dialog/)
// ===========================================================================


// ---------------------------------------------------------------------------
// RAS constants

const                
   RASCS_Connected    = $2000; // status: connected
   RASCS_Disconnected = $2001; // status: disconnected

   SizeOf_TRasDialParams = 1052; // values for missing SizeOf() function
   SizeOf_TRasConnStatus =  160;
   SizeOf_TRasConn       =  412;
   SizeOf_TRasEntryName  =  264;
               
   
// ---------------------------------------------------------------------------
// RAS data structures
            
type       
   TRasDialParams = record
      dwSize: LongWord;
      szEntryName: array[0..256] of Char;
      szPhoneNumber: array[0..128] of Char;
      szCallbackNumber: array[0..128] of Char;
      szUserName: array[0..256] of Char;
      szPassword: array[0..256] of Char;
      szDomain: array[0..15] of Char;
      filler: array[1..3] of Char;
   end;         

   TRasConnStatus = record
      dwSize: LongWord;
      rasconnstate: LongWord;
      dwError: LongWord;
      szDeviceType: array[0..16] of Char;
      szDeviceName: array[0..128] of Char;
      filler: array[1..2] of Char;
   end;        

   TRasConn = record
      dwSize: LongWord;
      hrasconn: LongWord;
      szEntryName: array[0..256] of Char;
      szDeviceType: array[0..16] of Char;
      szDeviceName: array[0..128] of Char;
      filler: array[1..1] of Char;
   end;

   TRasEntryName = record
      dwSize: LongWord;
      szEntryName: array[0..256] of Char;
      filler: array[1..3] of Char;
   end;

// ---------------------------------------------------------------------------
// RAS API functions

function ApiRasDial(
   lpRasDialExtensions, lpszPhoneBook: LongWord;
   var lpRasDialParams: TRasDialParams;
   dwNotifierType, lpvNotifier: LongWord; var lphRasConn: LongWord
   ): LongWord; external 'RasDialA@rasapi32.dll stdcall';

function ApiRasHangup( hrasconn: LongWord
   ): LongWord; external 'RasHangUpA@rasapi32.dll stdcall';

function ApiRasEnumConnections(
   var rasconnArray: TRasConn; var lpcb: LongWord; var lpcConnections: LongWord
   ): LongWord; external 'RasEnumConnectionsA@rasapi32.dll stdcall';

function ApiRasGetConnectStatus(
   hrasconn: LongWord; var status: TRasConnStatus
   ): LongWord; external 'RasGetConnectStatusA@rasapi32.dll stdcall';

function ApiRasGetErrorString(
   errorValue: LongWord; errorString: PChar; cBufSize: LongWord
   ): LongWord; external 'RasGetErrorStringA@rasapi32.dll stdcall';

function ApiRasEnumEntries(
   reserved: LongWord;
   lpszPhoneBook: LongWord;
   entrynamesArray: PChar; // var entrynamesArray: TRasEntryName;
   var lpcb: LongWord;
   var lpcEntries: LongWord
   ): LongWord; external 'RasEnumEntriesA@rasapi32.dll stdcall';


// ---------------------------------------------------------------------------
// RasLastError: Error code of last RAS-API call

var RasLastError: LongWord;


// ---------------------------------------------------------------------------
// RasErrorText: Description of RAS error code
//    ErrNo: Error code (e. g. RasLastError)
//    Returns: Description

function RasErrorText( ErrNo: LongWord ): String;
var  s: String;
begin
   SetLength( s, 256 );
   RasLastError := ApiRasGetErrorString( ErrNo, s, 256 );
   if RasLastError = 0 then Result := s + ' (' + inttostr(ErrNo) + ')'
                       else Result := 'RAS error ' + inttostr(ErrNo);
end;


// ---------------------------------------------------------------------------
// RasGetConnection: Get current connection
//    Returns: Identifier of current connection, 0 if not connected.

function RasGetConnection: LongWord;
var  rasConn: TRasConn;
     cb, cbConnections: LongWord;
begin
   Result := 0;
     
   rasConn.dwSize := SizeOf_TRasConn;
   cb := SizeOf_TRasConn;
   RasLastError := ApiRasEnumConnections( rasConn, cb, cbConnections );
   if RasLastError <> 0 then exit;
   if cbConnections < 1 then exit;
   
   Result := rasConn.hrasconn;
end;                       


// ---------------------------------------------------------------------------
// RasGetConnectionName: Get name of current connection
//    Returns: Name of current connection, '' if not connected.

function RasGetConnectionName: String;
var  rasConn: TRasConn;
     cb, cbConnections: LongWord;
     i: Integer;
begin
   Result := '';
     
   rasConn.dwSize := SizeOf_TRasConn;
   cb := SizeOf_TRasConn;
   RasLastError := ApiRasEnumConnections( rasConn, cb, cbConnections );
   if RasLastError <> 0 then exit;
   if cbConnections < 1 then exit;
   
   for i:=0 to 255 do begin
      if rasConn.szEntryName[i] = chr(0) then break;
      Result := Result + rasConn.szEntryName[i];
   end;
end;                       

                                           
// ---------------------------------------------------------------------------
// RasGetStatus: Get status of connection
//    connection: Connection identifier
//    Returns: Status (e.g. RASCS_Connected, RASCS_Disconnected)

function RasGetStatus( connection: LongWord ): LongWord;  
var  status: TRasConnStatus;
begin  
   Result := RASCS_Disconnected;
                                                   
   status.dwSize := SizeOf_TRasConnStatus;
   RasLastError := ApiRasGetConnectStatus( connection, status ); 
   if RasLastError <> 0 then exit;
   
   Result := status.rasconnstate;
end;


// ---------------------------------------------------------------------------
// RasIsConnected: Check connection
//    connection: Connection identifier
//    Returns: True if connected

function RasIsConnected( connection: LongWord ): Boolean;
// Returns True, if given connection is (still) connected.
begin
   Result := ( RasGetStatus(connection) = RASCS_Connected );
end;


// ---------------------------------------------------------------------------
// RasAnyConnected: Check if any connection is established
//    Returns: True if connected

function RasAnyConnected(): Boolean;
// Returns True, if given connection is (still) connected.
var  connection: LongWord;
begin
   Result := False;
   connection := RasGetConnection();
   if connection = 0 then exit;
   Result := ( RasGetStatus(connection) = RASCS_Connected );
end;


// ---------------------------------------------------------------------------
// RasDial: Dial phonebook entry
//    EntryName: Name of phonebook entry to dial
//    Username: Username to login
//    Password: Password to login
//    Returns: Connection identifier on success, 0 on failure.
(*
   // Example:
   var connection: LongWord;
   Begin
      connection := RasDial( 'myProvider', 'myName', 'myPassword' );
      if connection = 0 then begin
         writeln( 'Dialing failed: ' + RasErrorText(RasLastError) );
      end else begin
         // [transfer data here]
         RasHangup( connection );
      end;
   End.
*)

function RasDial( EntryName, Username, Password: String ): LongWord;
var  params: TRasDialParams;
     connection: LongWord;
     i: Integer;
begin
   Result := 0;
                                       
   params.dwSize := SizeOf_TRasDialParams; 
   params.szPhoneNumber[0] := chr(0);
   params.szCallbackNumber[0] := chr(0);
   params.szDomain[0] := chr(0);

   for i:= 1 to length(EntryName) do params.szEntryName[i-1] := EntryName[i];
   params.szEntryName[length(EntryName)] := chr(0);

   for i:= 1 to length(Username) do params.szUserName[i-1] := Username[i];
   params.szUserName[length(Username)] := chr(0);

   for i:= 1 to length(Password) do params.szPassword[i-1] := Password[i];
   params.szPassword[length(Password)] := chr(0);
                                            
   RasLastError := ApiRasDial( 0, 0, params, 0, 0, connection );
   if RasLastError <> 0 then exit;
   
   Result := connection;
end;


// ---------------------------------------------------------------------------
// RasHangup: Hangup specific connection
//    connection: connection identifier
//    Returns: True if not connected or disconnected successfully

function RasHangup( connection: LongWord ): Boolean;
var  i: Integer;
begin
   Result := True;

   RasLastError := ApiRasHangup( connection );
   Result := ( RasLastError = 0 );
   if not Result then exit;
   
   for i := 1 to 30 do begin // wait until terminated
      Sleep( 100 );
      RasGetStatus( connection );
      if RasLastError = 6 then begin // 6=ERROR_INVALID_HANDLE
         RasLastError := 0;
         break;
      end;
   end;
end;


// ---------------------------------------------------------------------------
// RasHangup: Hangup all active connections
//    Returns: True if not connected or all disconnected successfully

function RasHangupAll(): Boolean;
var  connection: LongWord;
begin
   Result := False;
   repeat
      connection := RasGetConnection();
      if connection <> 0 then begin
         if not RasHangup( connection ) then exit;
      end;
   until connection = 0;
   Result := True;
end;                                        


// ---------------------------------------------------------------------------
// RasEnumEntries: Get list of available phonebook entries
//    RasList: TStringList that is filled with names
//    Returns: True if list could be filled.
(*
   // Example:
   var RasList: TStringList;
       i: Integer;
   Begin
      RasList := TStringList.Create();
      RasEnumEntries( RasList );
      for i := 0 to RasList.Count - 1 do writeln( RasList.Strings[i] );
      RasList.Free;
   End.
*)

function RasEnumEntries( RasList: TStringList ): Boolean;
var  RasEntries    : String;
     RasEntriesSize: LongWord;
     RasEntryCount : LongWord;
     e, i, p: Integer;
     s: String;
begin
     Result := False;
     RasList.Clear;

     RasEntriesSize := SizeOf_TRasEntryName * 1;

     SetLength( RasEntries, RasEntriesSize );
     RasEntries[1] := chr(8); // .dwSize := 264/SizeOf_TRasEntryName;
     RasEntries[2] := chr(1);
     RasEntries[3] := chr(0);
     RasEntries[4] := chr(0);

     RasLastError := ApiRasEnumEntries( 0, 0, PChar(RasEntries),
                                        RasEntriesSize, RasEntryCount );
     
     if RasLastError <> 0 then begin
     
        if RasEntriesSize = 0 then exit;

        SetLength( RasEntries, RasEntriesSize );
        RasEntries[1] := chr(8);
        RasEntries[2] := chr(1);
        RasEntries[3] := chr(0);
        RasEntries[4] := chr(0);
        
        RasLastError := ApiRasEnumEntries( 0, 0, PChar(RasEntries),
                                           RasEntriesSize, RasEntryCount );
     
     end;
                        
     if RasLastError = 0 then begin
     
        Result := True;

        for e := 0 to RasEntryCount - 1 do begin
           p := SizeOf_TRasEntryName * e + 5;
           s := '';
           for i:=0 to 255 do begin
              if RasEntries[p] = chr(0) then break;
              s := s + RasEntries[p];
              p := p + 1;
           end;
           RasList.Add( s );
        end;
        
     end;
end;       

// ===========================================================================