adras.pas

Async Professional 4.04

{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
  FillChar(DialDlgInfo, SizeOf(DialDlgInfo), #0);
  DialDlgInfo.dwSize := SizeOf(DialDlgInfo);
  Result := AdRasDialDlg(FPhonebook, FEntryName, FPhoneNumber, @DialDlgInfo);
  if (Result = ecOk) then
    DisconnectTimer.Enabled := True;
end;

procedure TApdCustomRasDialer.DialEventWindowProc(var Msg : TMessage);
begin
  try                                                                  
    Dispatch(Msg);
    if (Msg.Msg = DialEventMsg) then begin
      if (Msg.lParam <> ecOK) then
        DoOnDialError(Msg.lParam)
      else
        DoOnDialStatus(Msg.wParam);
    end else if Msg.Msg = WM_QUERYENDSESSION then                      
      Msg.Result := 1;                                                 
  except                                                               
    Application.HandleException(Self);                                 
  end;                                                                 
end;

procedure TApdCustomRasDialer.DoDisconnectTimer(Sender : TObject);
begin
  if (ConnectState = csRasDisconnected) then
    Hangup
  else
  DisconnectTimer.Enabled := True;
end;

procedure TApdCustomRasDialer.DoOnDialError(Error : Integer);
begin
  if Assigned(FStatusDisplay) then
    FStatusDisplay.UpdateDisplay(GetErrorText(Error));
  if Assigned(FOnDialError) then
      FOnDialError(Self, Error);
  Hangup;
end;

procedure TApdCustomRasDialer.DoOnDialStatus(Status : Integer);
{$IFDEF TRIALRUN}
  {$I TRIAL04.INC}
{$ENDIF}
begin
{$IFDEF TRIALRUN}
  TC;
{$ENDIF}
  if (Status = csRasConnected) then
      DoOnConnected
  else if (Status = csRasDisconnected) then
    DoOnDisconnected
  else begin
    if Assigned(FStatusDisplay) then begin
      if (Status = csConnectDevice) then
        FStatusDisplay.UpdateDisplay('Dialing ' + FPhoneNumber)
      else
        FStatusDisplay.UpdateDisplay(GetStatusText(Status));
    end;
    if Assigned(FOnDialStatus) then
      FOnDialStatus(Self, Status);
  end;
end;

procedure TApdCustomRasDialer.DoOnConnected;
begin
  if Assigned(FStatusDisplay) then
    FStatusDisplay.DestroyDisplay;
  if Assigned(FOnConnected) then
    FOnConnected(Self);
end;

procedure TApdCustomRasDialer.DoOnDisconnected;
begin
  DisconnectTimer.Enabled := False;
  if Assigned(FStatusDisplay) then
    FStatusDisplay.DestroyDisplay;
  if Assigned(FOnDisconnected) then
    FOnDisconnected(Self);
end;

function TApdCustomRasDialer.EditPhonebookEntry : Integer;
begin
  Result := ecRasCannotFindPhonebookEntry;
  if (FEntryName <> '') then
    Result := AdRasEditPhonebookEntry(0, FPhonebook, FEntryName);
end;

function TApdCustomRasDialer.GetErrorText(Error : Integer) : string;
begin
  Result := AdRasGetErrorstring(Error);
end;

function TApdCustomRasDialer.GetFullConnectStatus(
  PRCS : PRasConnStatus) : Integer;
begin
  FillChar(PRCS^, SizeOf(TRasConnStatus), #0);
  PRCS^.dwSize := SizeOf(TRasConnStatus);
  Result := AdRasGetConnectStatus(Connection, PRCS);
end;

function TApdCustomRasDialer.GetConnectState : Integer;
var
  RCS : TRasConnStatus;
begin
  Result := csOpenPort;
  if (GetFullConnectStatus(@RCS) = ecOK) then
    Result := RCS.RasConnState;
end;

function TApdCustomRasDialer.GetDeviceType : string;
var
  RCS : TRasConnStatus;
begin
  Result := '';
  if (GetFullConnectStatus(@RCS) = ecOK) then
    Result := StrPas(RCS.szDeviceType);
end;

function TApdCustomRasDialer.GetDeviceName : string;
var
  RCS : TRasConnStatus;
begin
  Result := '';
  if (GetFullConnectStatus(@RCS) = ecOK) then
    Result := StrPas(RCS.szDeviceName);
end;

function TApdCustomRasDialer.GetStatusText(Status : Integer) : string;
begin
  Result := 'Unknown status';
  if ((Status >= csRasBase) and (Status <= csRasBaseEnd)) or
     ((Status >= csRasPaused) and (Status <= csRasPausedEnd)) or
     (Status = csRasConnected) or (Status = csRasDisconnected) then
    Result := AproLoadStr(RasBaseStatusString + Status)
  else
    Result := '';
end;

procedure TApdCustomRasDialer.Hangup;
var                                                                      {!!.02}
  RCS : TRasConnStatus;                                                  {!!.02}
begin
  AdRasHangup(Connection);
  {FConnection := 0;}                                                    {!!.02}
  while (Connection <> 0) and                                            {!!.04}
    (GetFullConnectStatus(@RCS) <> ERROR_INVALID_HANDLE) do              {!!.04}
    Sleep(0);
  FConnection := 0;                                                      {!!.02}
  if Assigned(FStatusDisplay) then
    FStatusDisplay.DestroyDisplay;
  if not (csDestroying in ComponentState) then
    DoOnDisconnected;
end;

function TApdCustomRasDialer.GetConnection : THandle;
var
  PRCA : PRasConnArray;
  BuffSize : DWord;
  NumConns : DWord;
  i : Word;
  RasResult : Integer;
begin
  Result := FConnection;
  if (Result <> 0) then
    Exit;

  BuffSize := SizeOf(TRasConnArray);
  PRCA := AllocMem(BuffSize);
  try
    PRCA^[0].dwSize := SizeOf(TRasConn);
    RasResult := AdRasEnumConnections(PRasConn(PRCA), BuffSize, NumConns);
    if (RasResult = ecOK) and (NumConns > 0) then begin
      if (FEntryName = '') then  {return first connection found}
        Result := PRCA^[0].rasConn
      else
        for i := 0 to Pred(NumConns) do
          if (StrPas(PRCA^[I].szEntryName) = FEntryName) then begin
            Result := PRCA^[I].rasConn;
            Break;
          end;
    end;
  finally
    FreeMem(PRCA, BuffSize);
  end;
end;

function TApdCustomRasDialer.GetDialParameters : Integer;
var
  PW : Boolean;
begin
  Result := ecRasCannotFindPhonebookEntry;
  if (FEntryName = '') then
    Exit;

  FillChar(EntryDialParams, SizeOf(EntryDialParams), #0);
  EntryDialParams.dwSize := SizeOf(EntryDialParams);
  StrPCopy(EntryDialParams.szEntryName, FEntryName);
  Result := AdRasGetEntryDialParams(FPhonebook, @EntryDialParams, PW);
  if (Result = ecOK) then
    with EntryDialParams do begin
      FPhoneNumber := StrPas(szPhoneNumber);
      FCallBackNumber := StrPas(szCallbackNumber);
      FUserName := StrPas(szUserName);
      FDomain := StrPas(szDomain);
      if PW then
        FPassword := StrPas(szPassword)
      else
        FPassword := '';
    end;
end;

function TApdCustomRasDialer.ListConnections(List : TStrings) : Integer;
var
  PRCA : PRasConnArray;
  BuffSize : DWord;
  NumConns : DWord;
  i : Word;
begin
  if not Assigned(List) then
    CheckException(Self, ecBadArgument);

  List.Clear;
  BuffSize := SizeOf(TRasConnArray);
  PRCA := AllocMem(BuffSize);
  try
    PRCA^[0].dwSize := SizeOf(TRasConn);
    Result := AdRasEnumConnections(PRasConn(PRCA), BuffSize, NumConns);
    if (Result = ecOK) and (NumConns > 0) then
      for i := 0 to Pred(NumConns) do
        List.Add(StrPas(PRCA^[i].szEntryName));
  finally
    FreeMem(PRCA, BuffSize);
  end;
end;

function TApdCustomRasDialer.ListEntries(List : TStrings) : Integer;
var
  PREA : PRasEntryNameArray;
  BuffSize : DWord;
  NumEntries : DWord;
  i : Integer;
begin
  if not Assigned(List) then
    CheckException(Self, ecBadArgument);

  List.Clear;
  BuffSize := SizeOf(TRasEntryNameArray);
  PREA := AllocMem(BuffSize);
  PREA^[0].dwSize := SizeOf(TRasEntryName);
  try
    Result := AdRasEnumEntries(Phonebook, PRasEntryName(PREA),
      BuffSize, NumEntries);
    if (Result = ecOK) and (NumEntries > 0) then
      for i := 0 to Pred(NumEntries) do
        List.Add(StrPas(PREA^[I].szEntryName));
  finally
    FreeMem(PREA, SizeOf(TRasEntryNameArray));
  end;
end;

function TApdCustomRasDialer.MonitorDlg : Integer;
begin
  FillChar(MonitorDlgInfo, SizeOf(MonitorDlgInfo), #0);
  MonitorDlgInfo.dwSize := SizeOf(MonitorDlgInfo);
  Result := AdRasMonitorDlg(DeviceName, @MonitorDlgInfo);
end;

procedure TApdCustomRasDialer.Notification(AComponent: TComponent;
                                           Operation: TOperation);
  {new/deleted RAS status component}
begin
  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) then begin
    if (AComponent = FStatusDisplay) then
        StatusDisplay := nil;
  end else if (Operation = opInsert) then
    if (AComponent is TApdAbstractRasStatus) then
      if not Assigned(FStatusDisplay) then
        if not Assigned(TApdAbstractRasStatus(AComponent).FRasDialer) then begin
          StatusDisplay := TApdAbstractRasStatus(AComponent);
          StatusDisplay.RasDialer := Self;
        end;
end;

function TApdCustomRasDialer.PhonebookDlg : Integer;
begin
  FillChar(PhonebookDlgInfo, SizeOf(PhonebookDlgInfo), #0);
  PhonebookDlgInfo.dwSize := SizeOf(PhonebookDlgInfo);
  Result := AdRasPhonebookDlg(FPhonebook, FEntryName, @PhonebookDlgInfo);
end;

function TApdCustomRasDialer.SetDialParameters : Integer;
begin
  Result := ecRasCannotFindPhonebookEntry;
  if (FEntryName <> '') then
    Result := AdRasSetEntryDialParams(FPhonebook, AssembleDialParams, False);
end;

procedure TApdCustomRasDialer.SetEntryName(Value : string);
begin
  FEntryName := Value;
  if not (csDesigning in ComponentState) then                        
    GetDialParameters;
end;


function TApdCustomRasDialer.GetIsRasAvailable: Boolean;                 {!!.01}
var
  SysDir : array[0..255] of Char;
begin
  Result := False;
  if (GetSystemDirectory(SysDir, sizeof(SysDir)) > 0) then
    Result := FileExists(AddBackSlash(SysDir) + RASDLL + '.DLL');
end;

{ TApdAbstractRasStatus }
constructor TApdAbstractRasStatus.Create(AOwner : TComponent);
  {create the status form}
begin
  inherited Create(AOwner);
  FCtl3D := True;
  FPosition := poScreenCenter;
end;

destructor TApdAbstractRasStatus.Destroy;
  {get rid of the status form}
begin
  DestroyDisplay;
  if Assigned(FRasDialer) then
    FRasDialer.StatusDisplay := nil;
  inherited Destroy;
end;

procedure TApdAbstractRasStatus.Notification(AComponent : TComponent;
                                             Operation: TOperation);
  {dialer component added/deleted}
begin
  inherited Notification(AComponent, Operation);

  if (Operation = opRemove) then begin
    if (AComponent = FRasDialer) then
      FRasDialer := nil;
  end else if (Operation = opInsert) then begin
    if (AComponent is TApdRasDialer) then
      if not Assigned(FRasDialer) then
        if not Assigned(TApdRasDialer(AComponent).FStatusDisplay) then begin
          RasDialer := TApdRasDialer(AComponent);
          RasDialer.StatusDisplay := Self;
        end;
  end;
end;

procedure TApdAbstractRasStatus.SetCtl3D(Value : Boolean);
  {set Ctl3D property and pass to status form}
begin
  if (Value <> FCtl3D) then begin
    FCtl3D := Value;
    if Assigned(FDisplay) then
      FDisplay.Ctl3D := Value;
  end;
end;

procedure TApdAbstractRasStatus.SetPosition(Value : TPosition);
  {set Position property and pass to status form}
begin
  if (Value <> FPosition) then begin
    FPosition := Value;
    if Assigned(FDisplay) then
      FDisplay.Position := Value;
  end;
end;

end.