387 lines
15 KiB
ObjectPascal
387 lines
15 KiB
ObjectPascal
{$A+}
|
|
|
|
unit KOLRas;
|
|
|
|
interface
|
|
|
|
uses
|
|
Windows, KOL, RAS;
|
|
|
|
type
|
|
|
|
PRASObj =^TRASObj;
|
|
TKOLRAS = PRASObj;
|
|
TOnErrorEvent = procedure (Sender: PRASObj; Error: Integer) of object;
|
|
TOnConnectingEvent = procedure (Sender: PRASObj; Msg: Integer; State: Integer; Error: Longint) of object;
|
|
|
|
TRASObj = object(TObj)
|
|
private
|
|
FOnConnecting: TOnConnectingEvent; // event for asynchronous dialing
|
|
FOnError: TOnErrorEvent; // error event
|
|
FRASHandle: THRasConn; // connection handle
|
|
FRASName: string; // name of the RAS service
|
|
fState: TRASConnState;
|
|
fError: longint;
|
|
fTimer: PTimer;
|
|
connecting: boolean;
|
|
function GetConnected: Boolean;
|
|
function GetParams(Server: string; var DialParams: TRasDialParams): Boolean;
|
|
function GetPassword: string;
|
|
procedure GetRASHandle;
|
|
function GetUsername: string;
|
|
procedure SetRASName( Value: string );
|
|
function GetStatusString: string;
|
|
function GetErrorString: string;
|
|
procedure OnTimer(Sender: PObj);
|
|
public
|
|
destructor Destroy; virtual; // and destroy it
|
|
procedure Connect; // make a connection
|
|
procedure DisConnect(force: boolean); // close the connection
|
|
property Connected: Boolean read GetConnected; // is service connected?
|
|
property Status: TRASConnState read fState; // current RAS state
|
|
property Error: longint read fError; // last RAS error
|
|
property RASHandle: THRASConn read fRASHandle;
|
|
property StatusString: string read GetStatusString;
|
|
property ErrorString: string read GetErrorString;
|
|
property Password: string read GetPassword; // get the password
|
|
property RASName: string read FRASName write SetRASName; // name of RAS service
|
|
property Username: string read GetUsername; // username
|
|
property OnConnecting: TOnConnectingEvent read FOnConnecting write FOnConnecting; // asynch dialing event
|
|
property OnError: TOnErrorEvent read FOnError write FOnError; // error event
|
|
end;
|
|
|
|
function GetStatString(s: longint): string;
|
|
function GetErrString(e: longint): string;
|
|
function NewRASObj: PRASObj;
|
|
function GetRASConnected(Handles: PList): PStrList; // get all existing connections
|
|
function GetRASNames: PStrList; // get all possible connections
|
|
function IsRASConnected( const r: string ): Boolean; // test if a connection is available
|
|
procedure HangUp( const RASName: string );
|
|
|
|
implementation
|
|
|
|
var RASSave: PRASObj;
|
|
CBkSave: TOnConnectingEvent;
|
|
|
|
procedure RASCallback(Msg: Integer; State: TRasConnState; Error: Longint); stdcall;
|
|
begin
|
|
if assigned(RASSave) then begin
|
|
RASSAve.fState := State;
|
|
RASSave.fError := Error;
|
|
if Assigned(CBkSave) then begin
|
|
CBkSave( RASSave, Msg, State, Error );
|
|
end;
|
|
if (Assigned(RASSave.FOnError)) and (Error<>0) then begin
|
|
RASSave.FOnError( RASSave, Error );
|
|
end;
|
|
if State = $2000 then begin
|
|
RASSave.fTimer.Enabled := True;
|
|
RASSave.connecting := false;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function NewRASObj;
|
|
begin
|
|
New(Result, create); // create the component first
|
|
Result.FRASHandle := 0; // internal RAS handle
|
|
Result.FRASName := ''; // no default RAS name
|
|
Result.fTimer := NewTimer(1000); // watchdog timer
|
|
Result.fTimer.Enabled := True;
|
|
Result.fTimer.Enabled := False;
|
|
Result.fTimer.OnTimer := Result.OnTimer;
|
|
RASSave := Nil;
|
|
CBkSave := Nil;
|
|
end;
|
|
|
|
destructor TRASObj.Destroy;
|
|
begin
|
|
DisConnect(True);
|
|
RASSave := Nil;
|
|
CBkSave := Nil;
|
|
fTimer.Free;
|
|
inherited Destroy; // next destroy the object
|
|
end;
|
|
|
|
procedure TRASObj.Connect;
|
|
var DialParams: TRasDialParams; // local dial parameters
|
|
begin
|
|
if not Connected then begin // only if the service is not connected
|
|
if GetParams( FRASName, DialParams ) then begin // get actual dial parameters
|
|
connecting := true;
|
|
RASSave := @self; // save the object itself
|
|
CbkSave := FOnConnecting;
|
|
RasDial(nil, nil, DialParams, 0, @RASCallback, FRASHandle ); // call with a callback function
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
procedure TRASObj.DisConnect;
|
|
var s: TRasConnStatus;
|
|
begin
|
|
if Connected or force then begin // only if a connection is available
|
|
if FRASHandle<>0 then begin // only if a vaild handle is available
|
|
RasHangup( FRASHandle ); // hangup the RAS service
|
|
s.dwSize := sizeof(s);
|
|
repeat
|
|
sleep(0);
|
|
until RasGetConnectStatus( FRASHandle, s ) = ERROR_INVALID_HANDLE;
|
|
FRASHandle := 0;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRASObj.GetConnected: Boolean;
|
|
begin
|
|
Result := IsRASConnected( FRASName ); // test if a service with this name is established
|
|
if (Result) and (FRASHandle=0) then begin // if no handle is available
|
|
GetRASHandle; // try to read the handle
|
|
end;
|
|
end;
|
|
|
|
function TRASObj.GetParams(Server: string; var DialParams: TRasDialParams): Boolean;
|
|
var DialPassword: LongBool;
|
|
RASResult: LongInt;
|
|
begin
|
|
Result := true; // result is first vaild
|
|
FillChar( DialParams, SizeOf(TRasDialParams), 0); // clear the result record
|
|
DialParams.dwSize := Sizeof(TRasDialParams); // set the result array size
|
|
StrPCopy(DialParams.szEntryName, Server); // set the ras service name
|
|
DialPassword := true; // get the dial password
|
|
RASResult := RasGetEntryDialParams(nil, DialParams, DialPassword); // read the ras parameters
|
|
if (RASResult<>0) then begin // if the API call was not successful
|
|
Result := false; // result is not vaild
|
|
if (Assigned(FOnError)) then begin // if an error event is assigned
|
|
FOnError( @self, RASResult ); // call the error event
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRASObj.GetPassword: string;
|
|
var DialParams: TRasDialParams; // dial parameters for this service
|
|
begin
|
|
if GetParams( FRASName, DialParams ) then begin // if read of dial parameters was successful
|
|
Result := DialParams.szPassword; // copy the password string
|
|
end else begin // if read was not successful
|
|
Result := ''; // return an empty string
|
|
end;
|
|
end;
|
|
|
|
procedure TRASObj.GetRASHandle;
|
|
const cMaxRas = 100; // maximum number of ras services
|
|
var BufferSize: LongInt; // used for size of result buffer
|
|
RASBuffer: array[1..cMaxRas] of TRasConn; // the API result buffer itself
|
|
RASCount: LongInt; // number of found ras services
|
|
i: Integer; // loop counter
|
|
begin
|
|
FRASHandle := 0; // first no handle is available
|
|
FillChar( RASBuffer, SizeOf(RASBuffer), 0 ); // clear the API Buffer
|
|
RASBuffer[1].dwSize := SizeOf(TRasConn); // set the API buffer size for a single record
|
|
BufferSize := SizeOf(TRasConn) * cMaxRas; // calc complete buffer size
|
|
if RasEnumConnections(@RASBuffer[1], BufferSize, RASCount) = 0 then begin
|
|
for i := 1 to RASCount do begin // for all found ras services
|
|
if RASBuffer[i].szEntryName = RASName then begin // if the actual name is available
|
|
FRASHandle := RASBuffer[i].hrasconn; // save the found ras handle
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function TRASObj.GetUsername: string;
|
|
var DialParams: TRasDialParams; // dial parameters for this service
|
|
begin
|
|
if GetParams( FRASName, DialParams ) then begin // if read of dial parameters was successful
|
|
Result := DialParams.szUserName; // copy the user name string
|
|
end else begin // if read was not successful
|
|
Result := ''; // return an empty string
|
|
end;
|
|
end;
|
|
|
|
function TRASObj.GetStatusString;
|
|
begin
|
|
result := GetStatString(fState);
|
|
end;
|
|
|
|
function GetStatString;
|
|
begin
|
|
result := 'unexpected status: ' + int2str(s);
|
|
case s of
|
|
0: result := '';
|
|
1: result := 'port is opened';
|
|
2: result := 'call in progress';
|
|
3: result := 'device is connected';
|
|
4: result := 'all devices is connected';
|
|
5: result := 'authentication';
|
|
6: result := 'authnotify';
|
|
7: result := 'authretry';
|
|
8: result := 'authcallback';
|
|
9: result := 'authchangepassword';
|
|
10: result := 'authproject';
|
|
11: result := 'linkspeed';
|
|
12: result := 'authack';
|
|
13: result := 'reauthenticate';
|
|
14: result := 'authenticated';
|
|
15: result := 'prepareforcallback';
|
|
16: result := 'waitformodemreset';
|
|
17: result := 'waitforcallback';
|
|
18: result := 'projected';
|
|
19: result := 'startauthentication';
|
|
20: result := 'callbackcomplete';
|
|
21: result := 'logonnetwork';
|
|
$1000: result := 'interactive';
|
|
$1001: result := 'retryauthentication';
|
|
$1002: result := 'callbacksetbycaller';
|
|
$1003: result := 'password is expired';
|
|
$2000: result := 'connected';
|
|
$2001: result := 'disconnected';
|
|
end;
|
|
end;
|
|
|
|
function TRASObj.GetErrorString;
|
|
begin
|
|
result := GetErrString(fError);
|
|
end;
|
|
|
|
function GetErrString(e: longint): string;
|
|
begin
|
|
result := 'unexpected error: ' + int2str(e);
|
|
case e of
|
|
000: result := '';
|
|
600: result := 'operation is pending';
|
|
601: result := 'invalid port handle';
|
|
608: result := 'device does not exist';
|
|
615: result := 'port not found';
|
|
619: result := 'connection is terminated';
|
|
628: result := 'port was disconnected';
|
|
629: result := 'disconnected by remote';
|
|
630: result := 'hardware failure';
|
|
631: result := 'user disconnect';
|
|
633: result := 'port is in use';
|
|
638: result := 'PPP no address assigned';
|
|
651: result := 'device error';
|
|
676: result := 'line is busy';
|
|
678: result := 'no answer';
|
|
680: result := 'no dialtone';
|
|
691: result := 'authentication failure';
|
|
718: result := 'PPP timeout';
|
|
720: result := 'PPP no CP configured';
|
|
721: result := 'PPP no responce';
|
|
732: result := 'PPP is not converging';
|
|
734: result := 'PPP LCP terminated';
|
|
735: result := 'PPP adress rejected';
|
|
738: result := 'no PPP address assigned';
|
|
742: result := 'no remote encription';
|
|
743: result := 'remote requires encription';
|
|
752: result := 'script syntax error';
|
|
777: result := 'no answer timeout';
|
|
797: result := 'modem is not found';
|
|
end;
|
|
end;
|
|
|
|
procedure TRASObj.SetRASName( Value: string );
|
|
var DialParams: TRasDialParams; // dial parameters for this service
|
|
begin
|
|
if GetParams( Value, DialParams ) then begin
|
|
FRASName := Value;
|
|
GetRASHandle; // try to read an existing handle
|
|
end;
|
|
end;
|
|
|
|
function GetRASConnected;
|
|
const cMaxRas = 100; // maximum number of ras services
|
|
var BufferSize: LongInt; // used for size of result buffer
|
|
RASBuffer: array[1..cMaxRas] of TRasConn; // the API result buffer itself
|
|
RASCount: LongInt; // number of found ras services
|
|
i: Integer; // loop counter
|
|
begin
|
|
FillChar( RASBuffer, SizeOf(RASBuffer), 0 ); // clear the API Buffer
|
|
RASBuffer[1].dwSize := SizeOf(TRasConn); // set the API buffer size for a single record
|
|
BufferSize := SizeOf(TRasConn) * cMaxRas; // calc complete buffer size
|
|
Result := NewStrList;
|
|
if RasEnumConnections(@RASBuffer[1], BufferSize, RASCount) = 0 then begin
|
|
for i := 1 to RASCount do begin // for all found ras services
|
|
Result.Add( RASBuffer[i].szEntryName ); // copy the name of the ras service
|
|
if Handles <> nil then Handles.Add(pointer(RASBuffer[i].hrasconn));
|
|
end;
|
|
end;
|
|
if assigned(RASSave) then begin
|
|
if RASSAve.FRASHandle <> 0 then begin
|
|
if RASSave.connecting then begin
|
|
i := Result.IndexOf(RASSave.FRASName);
|
|
if i = -1 then begin
|
|
i := Result.Add(RASSave.FRASName);
|
|
if Handles <> nil then Handles.Add(pointer(RASSave.FRASHandle));
|
|
end;
|
|
if Handles <> nil then Handles.Items[i] := pointer(RASSave.FRASHandle);
|
|
end;
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function GetRASNames;
|
|
const cMaxRas = 100; // maximum number of ras services
|
|
var BufferSize: LongInt; // used for size of result buffer
|
|
RASBuffer: array[1..cMaxRas] of TRasEntryName; // the API result buffer itself
|
|
RASCount: LongInt; // number of found ras services
|
|
i: Integer; // loop counter
|
|
begin
|
|
Result := Nil;
|
|
FillChar( RASBuffer, SizeOf(RASBuffer), 0 ); // clear the API Buffer
|
|
RASBuffer[1].dwSize := SizeOf(TRasEntryname); // set the API buffer size for a single record
|
|
BufferSize := SizeOf(TRasEntryName) * cMaxRas;// calc complete buffer size
|
|
if RasEnumEntries(nil, nil, @RASBuffer[1], BufferSize, RASCount) = 0 then begin
|
|
Result := NewStrList;
|
|
for i := 1 to RASCount do begin // for all found ras services
|
|
Result.Add( RASBuffer[i].szEntryName ); // copy the name of the ras service
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
function IsRASConnected( const r: string ): Boolean;
|
|
var n: PStrList; // result object for connected services
|
|
i: Integer; // loop counter
|
|
p: PList;
|
|
begin
|
|
Result := false; // first the result is false
|
|
p := NewList;
|
|
n := GetRasConnected(p); // create the object for connected services
|
|
for i := 0 to n.Count - 1 do begin // for all connected services
|
|
if r = n.Items[i] then begin // if the ras name was found
|
|
Result := true; // the result is true now
|
|
Break; // break the loop, one is found
|
|
end;
|
|
end;
|
|
n.Free; // destroy the object for connected services
|
|
p.Free;
|
|
end;
|
|
|
|
procedure HangUP;
|
|
var e: PStrList;
|
|
h: PList;
|
|
i: integer;
|
|
begin
|
|
h := NewList;
|
|
e := GetRASConnected(h);
|
|
i := e.IndexOf(RASName);
|
|
if i > -1 then begin
|
|
RASHangUp(integer(h.Items[i]));
|
|
end;
|
|
e.Free;
|
|
h.Free;
|
|
end;
|
|
|
|
procedure TRASObj.OnTimer;
|
|
begin
|
|
if not connected then begin
|
|
fTimer.Enabled := False;
|
|
Disconnect(True);
|
|
if assigned(fOnConnecting) then begin
|
|
fState := $2001;
|
|
fError := 619;
|
|
fOnConnecting(@self, 0, $2001, 619);
|
|
end;
|
|
end;
|
|
end;
|
|
|
|
end.
|