home *** CD-ROM | disk | FTP | other *** search
/ Freelog 11 / Freelog011.iso / BestOf / PhoenixMail / Source / comps / DialUp.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-02-19  |  16.1 KB  |  494 lines
  1. {*****************************************************************************
  2.  *
  3.  *  DialUp.pas - TDialUp Component
  4.  *
  5.  *  Copyright (c) 1998-99 Michael Haller
  6.  *
  7.  *  Based on the component of BEALsoft (aberka@usa.net)
  8.  *  and the header of Davide Moretti (dmoretti@iper.net).
  9.  *
  10.  *  Author:     Michael Haller
  11.  *  E-mail:     michael@discountdrive.com
  12.  *  Homepage:   http://www.discountdrive.com/sunrise/
  13.  *
  14.  *  This program is free software; you can redistribute it and/or
  15.  *  modify it under the terms of the GNU General Public License
  16.  *  as published by the Free Software Foundation;
  17.  *
  18.  *  This program is distributed in the hope that it will be useful,
  19.  *  but WITHOUT ANY WARRANTY; without even the implied warranty of
  20.  *  MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  21.  *  GNU General Public License for more details.
  22.  *
  23.  *  You should have received a copy of the GNU General Public License
  24.  *  along with this program; if not, write to the Free Software
  25.  *  Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA
  26.  *
  27.  *----------------------------------------------------------------------------
  28.  *
  29.  *  Revision history:
  30.  *
  31.  *     DATE     REV                 DESCRIPTION
  32.  *  ----------- --- ----------------------------------------------------------
  33.  *  Feb-19-1999 JMR Changed from static DLL to dynamic DLL
  34.  *
  35.  *****************************************************************************}
  36.  
  37. unit DialUp;
  38.  
  39. interface
  40.  
  41. uses
  42.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  43.   ExtCtrls, DsgnIntf;
  44.  
  45. const
  46.   DNLEN = 15;
  47.   UNLEN = 256;
  48.   PWLEN = 256;
  49.  
  50.   RAS_MaxEntryName = 256;
  51.   RAS_MaxDeviceType = 16;
  52.   RAS_MaxDeviceName = 128;
  53.   RAS_MaxPhoneNumber = 128;
  54.   RAS_MaxCallbackNumber = RAS_MaxPhoneNumber;
  55.  
  56.   RASCS_PAUSED                    = $1000;
  57.   RASCS_DONE                      = $2000;
  58.  
  59.   RASCS_OpenPort                  = 0;
  60.   RASCS_PortOpened                = 1;
  61.   RASCS_ConnectDevice             = 2;
  62.   RASCS_DeviceConnected           = 3;
  63.   RASCS_AllDevicesConnected       = 4;
  64.   RASCS_Authenticate              = 5;
  65.   RASCS_AuthNotify                = 6;
  66.   RASCS_AuthRetry                 = 7;
  67.   RASCS_AuthCallback              = 8;
  68.   RASCS_AuthChangePassword        = 9;
  69.   RASCS_AuthProject               = 10;
  70.   RASCS_AuthLinkSpeed             = 11;
  71.   RASCS_AuthAck                   = 12;
  72.   RASCS_ReAuthenticate            = 13;
  73.   RASCS_Authenticated             = 14;
  74.   RASCS_PrepareForCallback        = 15;
  75.   RASCS_WaitForModemReset         = 16;
  76.   RASCS_WaitForCallback           = 17;
  77.   RASCS_Projected                 = 18;
  78.   RASCS_StartAuthentication       = 19;
  79.   RASCS_CallbackComplete          = 20;
  80.   RASCS_LogonNetwork              = 21;
  81.   RASCS_Interactive               = RASCS_PAUSED;
  82.   RASCS_RetryAuthentication       = RASCS_PAUSED + 1;
  83.   RASCS_CallbackSetByCaller       = RASCS_PAUSED + 2;
  84.   RASCS_PasswordExpired           = RASCS_PAUSED + 3;
  85.   RASCS_Connected                 = RASCS_DONE;
  86.   RASCS_Disconnected              = RASCS_DONE + 1;
  87.  
  88. type
  89.   THRasConn  = Longint;
  90.  
  91.   LPRasConnA = ^TRasConnA;
  92.   TRasConnA  = record
  93.     dwSize       : Longint;
  94.     hrasconn     : THRasConn;
  95.     szEntryName  : array[0..RAS_MaxEntryName] of AnsiChar;
  96.     szDeviceType : array[0..RAS_MaxDeviceType] of AnsiChar;
  97.     szDeviceName : array[0..RAS_MaxDeviceName] of AnsiChar;
  98.   end;
  99.  
  100.   LPRasConn = ^TRasConn;
  101.   TRasConn  = TRasConnA;
  102.  
  103.   LPRasConnState = ^TRasConnState;
  104.   TRasConnState  = Integer;
  105.  
  106.   LPRasConnStatusA = ^TRasConnStatusA;
  107.   TRasConnStatusA  = record
  108.     dwSize       : Longint;
  109.     rasconnstate : TRasConnState;
  110.     dwError      : LongInt;
  111.     szDeviceType : array[0..RAS_MaxDeviceType] of AnsiChar;
  112.     szDeviceName : array[0..RAS_MaxDeviceName] of AnsiChar;
  113.    end;
  114.  
  115.   LPRasConnStatus = ^TRasConnStatus;
  116.   TRasConnStatus  = TRasConnStatusA;
  117.  
  118.   LPRasEntryNameA = ^TRasEntryNameA;
  119.   TRasEntryNameA  = record
  120.     dwSize       : Longint;
  121.     szEntryName  : array[0..RAS_MaxEntryName] of AnsiChar;
  122.   end;
  123.  
  124.   LPRasEntryName = ^TRasEntryName;
  125.   TRasEntryName  = TRasEntryNameA;
  126.  
  127.   LPRasDialParamsA = ^TRasDialParamsA;
  128.   TRasDialParamsA  = record
  129.     dwSize           : LongInt;
  130.     szEntryName      : array[0..RAS_MaxEntryName] of AnsiChar;
  131.     szPhoneNumber    : array[0..RAS_MaxPhoneNumber] of AnsiChar;
  132.     szCallbackNumber : array[0..RAS_MaxCallbackNumber] of AnsiChar;
  133.     szUserName       : array[0..UNLEN] of AnsiChar;
  134.     szPassword       : array[0..PWLEN] of AnsiChar;
  135.     szDomain         : array[0..DNLEN] of AnsiChar;
  136.   end;
  137.  
  138.   LPRasDialParams = ^TRasDialParams;
  139.   TRasDialParams  = TRasDialParamsA;
  140.  
  141.   LPRasDialExtensions = ^TRasDialExtensions;
  142.   TRasDialExtensions  = record
  143.     dwSize            : LongInt;
  144.     dwfOptions        : LongInt;
  145.     hwndParent        : HWnd;
  146.     reserved          : LongInt;
  147.   end;
  148.  
  149. type
  150.   TAboutProperty = class(TPropertyEditor)
  151.   public
  152.     procedure Edit; override;
  153.     function GetAttributes: TPropertyAttributes; override;
  154.     function GetValue:string; override;
  155.   end;
  156.  
  157.   TOnStatusEvent = procedure(Sender: TObject; MessageText: String; Error: Boolean) of object;
  158.  
  159.   TDialUp = class(TComponent)
  160.   private
  161.     FTimer: TTimer;
  162.     FAbout: String;
  163.     FPassword: String;
  164.     FUsername: String;
  165.     FConnectTo: String;
  166.     hRasDLL: THandle;
  167.     StatusStr: String;
  168.     ErrorStat: Boolean;
  169.     AsyncStatus: Boolean;
  170.     FLangStrList: TStringList;
  171.     FPossibleConnections: TStringList;
  172.     FOnStatusEvent: TOnStatusEvent;
  173.     function StatusString(State: TRasConnState; Error: Integer; var ES: Boolean): String;
  174.     function GetActiveConnection: String;
  175.     procedure SetLangStrList(Value: TStringList);
  176.     function GetCurrentConnection: String;
  177.     procedure SetCurrentConnection(Value: String);
  178.     procedure SetPossibleConnections(Value: TStringList);
  179.     function GetPossibleConnections: TStringList;
  180.     procedure GetConnections(var SL: TStringList);
  181.     function GetRasInstalled: Boolean;
  182.   protected
  183.     procedure Timer(Sender: TObject); virtual;
  184.   public
  185.     constructor Create(AOwner: TComponent); override;
  186.     destructor Destroy; override;
  187.     function GoOnline: Boolean;
  188.     procedure GoOffline;
  189.     procedure ShowAbout;
  190.   published
  191.     property About: String read FAbout write FAbout;// stored False;
  192.     property Password: String read FPassword write FPassword;
  193.     property Username: String read FUsername write FUsername;
  194.     property CurrentConnection: String read GetCurrentConnection write SetCurrentConnection;
  195.     property ConnectTo: String read FConnectTo write FConnectTo;
  196.     property PossibleConnections: TStringList read GetPossibleConnections write SetPossibleConnections;
  197.     property LangStrList: TStringList read FLangStrList write SetLangStrList;
  198.     property OnStatusEvent: TOnStatusEvent read FOnStatusEvent write FOnStatusEvent;
  199.     property RasInstalled: Boolean read GetRasInstalled stored False;
  200.   end;
  201.  
  202. procedure Register;
  203.  
  204. implementation
  205.  
  206. var
  207.   xSelf: Pointer;
  208.  
  209.   RasHangUp: function (hConn: THRasConn): Longint; stdcall;
  210.   RasEnumConnections: function (RasConnArray: LPRasConn; var lpcb: Longint; var lpcConnections: Longint): Longint; stdcall;
  211.   RasGetConnectStatus: function (hConn: THRasConn; var lpStatus: TRasConnStatus): Longint; stdcall;
  212.   RasEnumEntries: function (Reserved: PAnsiChar; lpszPhoneBook: PAnsiChar; EntryNamesArray: LPRasEntryNameA; var lpcb: Longint; var lpcEntries: Longint): Longint; stdcall;
  213.   RasGetEntryDialParams: function (lpszPhoneBook: PAnsiChar; var lpDialParams: TRasDialParams; var lpfPassword: LongBool): Longint; stdcall;
  214.   RasGetErrorString: function (ErrorValue: Integer; ErrorString: PAnsiChar; cBufSize: Longint): Longint; stdcall;
  215.   RasDial: function (lpRasDialExt: LPRasDialExtensions; lpszPhoneBook: PAnsiChar; var Params: TRasDialParams; dwNotifierType: Longint; lpNotifier: Pointer; var RasConn: THRasConn): Longint; stdcall;
  216.   RasSetEntryDialParams: function (lpszPhoneBook: PAnsiChar; var lpDialParams: TRasDialParams; fRemovePassword: LongBool): Longint; stdcall;
  217.  
  218. procedure Register;
  219. begin
  220.   RegisterComponents('Michael Haller', [TDialUp]);
  221.   RegisterPropertyEditor(TypeInfo(String), TDialUp, 'About', TAboutProperty);
  222. end;
  223.  
  224. procedure TDialUp.Timer(Sender: TObject);
  225. begin
  226.   FTimer.Enabled := False;
  227.   if AsyncStatus = False then Exit;
  228.   if Assigned(FOnStatusEvent) then FOnStatusEvent(TDialUp(xSelf), StatusStr, ErrorStat);
  229.   AsyncStatus:=False;
  230. end;
  231.  
  232. procedure RasCallback(Msg: Integer; State: TRasConnState; Error: Integer); stdcall;
  233. begin
  234.   while TDialUp(xSelf).AsyncStatus = True do ;
  235.   TDialUp(xSelf).AsyncStatus := True;
  236.   TDialUp(xSelf).FTimer.Enabled := True;
  237.   TDialUp(xSelf).StatusStr := TDialUp(xSelf).StatusString(State, Error, TDialUp(xSelf).ErrorStat);
  238. end;
  239.  
  240. constructor TDialUp.Create(AOwner: TComponent);
  241. begin
  242.   inherited Create(AOwner);
  243.   AsyncStatus := False;
  244.   FTimer := TTimer.Create(Self);
  245.   FTimer.Enabled := False;
  246.   FTimer.Interval := 1;
  247.   FTimer.OnTimer := Timer;
  248.   FPossibleConnections := TStringList.Create;
  249.   FLangStrList := TStringList.Create;
  250.   FLangStrList.Add('Connecting to %s...');
  251.   FLangStrList.Add('Verifying username and password...');
  252.   FLangStrList.Add('An error occured while trying to connect to %s.');
  253.  
  254.   // Attempt to load the RASAPI32 DLL.  If the DLL loads, hRasDLL will
  255.   //   be non-zero.  Otherwise, hRasDLL will be zero.
  256.  
  257.   hRasDLL := LoadLibrary('RASAPI32.DLL');
  258.  
  259.   // Assign function pointers for the RAS functions.
  260.  
  261.   @RasEnumConnections    := GetProcAddress(hRasDLL, 'RasEnumConnectionsA');
  262.   @RasHangUp             := GetProcAddress(hRasDLL, 'RasHangUpA');
  263.   @RasGetConnectStatus   := GetProcAddress(hRasDLL, 'RasGetConnectStatusA');
  264.   @RasEnumEntries        := GetProcAddress(hRasDLL, 'RasEnumEntriesA');
  265.   @RasGetEntryDialParams := GetProcAddress(hRasDLL, 'RasGetEntryDialParamsA');
  266.   @RasGetErrorString     := GetProcAddress(hRasDLL, 'RasGetErrorStringA');
  267.   @RasDial               := GetProcAddress(hRasDLL, 'RasDialA');
  268.   @RasSetEntryDialParams := GetProcAddress(hRasDLL, 'RasSetEntryDialParamsA');
  269.  
  270. end;
  271.  
  272. destructor TDialUp.Destroy;
  273. begin
  274.  
  275.   // If the RASAPI32 DLL was loaded, then free it.
  276.  
  277.   if RasInstalled then
  278.     FreeLibrary(hRasDLL);
  279.  
  280.   FLangStrList.Free;
  281.   FPossibleConnections.Free;
  282.   FTimer.Free;
  283.   inherited Destroy;
  284. end;
  285.  
  286. function TDialUp.GetRasInstalled: Boolean;
  287. // Determines if RAS has been installed by checking for DLL handle.  If RAS
  288. //   has not been installed, hRasDLL is zero.
  289.  
  290. begin
  291.   Result := hRasDLL <> 0;
  292. end;
  293.  
  294. function TDialUp.GetCurrentConnection: String;
  295. begin
  296.   Result := GetActiveConnection;
  297. end;
  298.  
  299. procedure TDialUp.SetCurrentConnection(Value: String);
  300. begin
  301. end;
  302.  
  303. procedure TDialUp.SetPossibleConnections(Value: TStringList);
  304. begin
  305. end;
  306.  
  307. function TDialUp.GetPossibleConnections: TStringList;
  308. begin
  309.   FPossibleConnections.Clear;
  310.   GetConnections(FPossibleConnections);
  311.   Result := FPossibleConnections;
  312. end;
  313.  
  314. procedure TDialUp.SetLangStrList(Value: TStringList);
  315. begin
  316.   FLangStrList.Assign(Value);
  317. end;
  318.  
  319. function TDialUp.GoOnline: Boolean;
  320. var
  321.   hRAS: ThRASConn;
  322.   B: LongBool;
  323.   R: Integer;
  324.   C: array[0..100] of Char;
  325.   DialParams: TRasDialParams;
  326. begin
  327.   Result := False;
  328.  
  329.   if not RasInstalled then exit;
  330.  
  331.   try
  332.     GoOffline;
  333.     FillChar(DialParams, SizeOf(TRasDialParams), 0);
  334.     DialParams.dwSize := Sizeof(TRasDialParams);
  335.     StrPCopy(DialParams.szEntryName, FConnectTo);
  336.     B := False;
  337.     R := RasGetEntryDialParams(nil, DialParams, B);
  338.     if R <> 0 then begin
  339.       Result := False;
  340.       GoOffline;
  341.       if Assigned(FOnStatusEvent) then FOnStatusEvent(Self,  FLangStrList[28], True);
  342.       Exit;
  343.     end;
  344.     DialParams.dwSize := Sizeof(TRasDialParams);
  345.     StrPCopy(DialParams.szUserName, FUsername);
  346.     StrPCopy(DialParams.szPassword, FPassword);
  347.     R := RasSetEntryDialParams(nil, DialParams, False);
  348.     if R <> 0 then begin
  349.       Result := False;
  350.       GoOffline;
  351.       if Assigned(FOnStatusEvent) then FOnStatusEvent(Self,  FLangStrList[29], True);
  352.       Exit;
  353.     end;
  354.     xSelf := Self;
  355.     AsyncStatus := False;
  356.     hRAS := 0;
  357.     R := RasDial(nil, nil, DialParams, 0, @RasCallback, hRAS);
  358.     if R <> 0 then begin
  359.       Result := False;
  360.       RasGetErrorString(R, C, 100);
  361.       GoOffline;
  362.       if Assigned(FOnStatusEvent) then FOnStatusEvent(Self, C, True);
  363.       Exit;
  364.     end;
  365.     Result := True;
  366.   except
  367.     on E: Exception do begin
  368.       GoOffline;
  369.       if Assigned(FOnStatusEvent) then FOnStatusEvent(Self, E.Message, True);
  370.     end;
  371.   end;
  372. end;
  373.  
  374. procedure TDialUp.GetConnections(var SL: TStringList);
  375. var
  376.   BuffSize, Entries, R, I: Integer;
  377.   Entry: array[1..100] of TRasEntryName;
  378. begin
  379.  
  380.   if not RasInstalled then exit;
  381.  
  382.   SL.Clear;
  383.   Entry[1].dwSize := SizeOf(TRasEntryName);
  384.   BuffSize := SizeOf(TRasEntryName) * 100;
  385.   R := RasEnumEntries(nil, nil, @Entry[1], BuffSize, Entries);
  386.   if (R = 0) and (Entries > 0) then
  387.     for I := 1 to Entries do SL.Add(Entry[I].szEntryName);
  388. end;
  389.  
  390. function TDialUp.GetActiveConnection: String;
  391. var
  392.   BufSize, NumEntries, I, R: Integer;
  393.   Entries: array[1..100] of TRasConn;
  394.   Stat: TRasConnStatus;
  395. begin
  396.   Result := '';
  397.  
  398.   if not RasInstalled then exit;
  399.  
  400.   Entries[1].dwSize := SizeOf(TRasConn);
  401.   BufSize := SizeOf(TRasConn)*100;
  402.   FillChar(Stat, Sizeof(TRasConnStatus), 0);
  403.   Stat.dwSize := Sizeof(TRasConnStatus);
  404.   R := RasEnumConnections(@Entries[1], BufSize, NumEntries);
  405.   if R = 0 then
  406.     if NumEntries > 0 then
  407.       for I := 1 to NumEntries do begin
  408.         RasGetConnectStatus(Entries[I].HRasConn, Stat);
  409.         if Stat.RasConnState = RASCS_Connected then
  410.           Result := Entries[I].szEntryName+' ('+Entries[I].szDeviceName+')'
  411.      end;
  412. end;
  413.  
  414. procedure TDialUp.GoOffline;
  415. var
  416.   Entries: array[1..100] of TRasConn;
  417.   BufSize, NumEntries, R, I, E: Integer;
  418. begin
  419.  
  420.   if not RasInstalled then exit;
  421.  
  422.   for E := 0 to 6 do begin
  423.     Entries[1].dwSize := SizeOf(TRasConn);
  424.     R := RasEnumConnections(@Entries[1], BufSize, NumEntries);
  425.     if R = 0 then begin
  426.       if NumEntries > 0 then
  427.         for I := 1 to NumEntries do RasHangUp(Entries[I].HRasConn);
  428.     end;
  429.     Application.ProcessMessages;
  430.   end;
  431. end;
  432.  
  433. function TDialUp.StatusString(State: TRasConnState; Error: Integer; var ES: Boolean): String;
  434. var
  435.   C: array[0..100] of Char;
  436.   S: String;
  437. begin
  438.   S := 'Something went wrong...';
  439.   ES := False;
  440.  
  441.   if not RasInstalled then exit;
  442.  
  443.   if Error <> 0 then begin
  444.     RasGetErrorString(Error, C, 100);
  445.     ES := True;
  446.     S := C;
  447.   end else begin
  448.     case State of
  449.       //connecting
  450.       RASCS_OpenPort, RASCS_PortOpened, RASCS_ConnectDevice, RASCS_DeviceConnected,
  451.       RASCS_AllDevicesConnected, RASCS_PrepareForCallback, RASCS_WaitForModemReset,
  452.       RASCS_WaitForCallback, RASCS_Projected, RASCS_CallbackComplete, RASCS_LogonNetwork,
  453.       RASCS_Interactive, RASCS_CallbackSetByCaller, RASCS_Connected: S := Format(FLangStrList[0], [FConnectTo]);
  454.       //authenticateing
  455.       RASCS_Authenticate, RASCS_StartAuthentication, RASCS_Authenticated: S := FLangStrList[1];
  456.       //error
  457.       RASCS_AuthNotify, RASCS_AuthRetry, RASCS_AuthCallback, RASCS_AuthChangePassword,
  458.       RASCS_AuthProject, RASCS_AuthLinkSpeed, RASCS_AuthAck, RASCS_ReAuthenticate,
  459.       RASCS_RetryAuthentication, RASCS_Disconnected, RASCS_PasswordExpired: S := Format(FLangStrList[2], [FConnectTo]);
  460.     end;
  461.   end;
  462.   Result := S;
  463. end;
  464.  
  465. procedure TDialUp.ShowAbout;
  466. var
  467.   S: String;
  468. begin
  469.   S := 'TDialUp v1.0'+#13+#13+
  470.   'Copyright ⌐ 1998 Michael Haller (michael@discountdrive.com)  '+#13+#13+
  471.   'Based on the component of BEALsoft (aberka@usa.net)'+#13+
  472.   'and the header of Davide Moretti (dmoretti@iper.net).'+#13+#13+
  473.   'This component is provided "as is" without any warranties.'+#13+
  474.   'Use at your own risk!'+#13;
  475.   MessageDlg(S, mtInformation, [mbOK], 0);
  476. end;
  477.  
  478. procedure TAboutProperty.Edit;
  479. begin
  480.   TDialUp(GetComponent(0)).ShowAbout;
  481. end;
  482.  
  483. function TAboutProperty.GetAttributes: TPropertyAttributes;
  484. begin
  485.   GetAttributes := [paDialog, paReadOnly];
  486. end;
  487.  
  488. function TAboutProperty.GetValue: String;
  489. begin
  490.   GetValue := '(About)';
  491. end;
  492.  
  493. end.
  494.