rasdial1.pas

< Delphi网络通信协议分析与应用实现>>一书的源代码。

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.CheckTimerTimer(Sender: TObject);
var
    RasConnStatus : TRASCONNSTATUS;
    Status        : DWORD;
    Buf           : array [0..255] of Char;
begin
    if hRasConn = 0 then
        Exit;

    FillChar(RasConnStatus, SizeOf(RasConnStatus), 0);
    RasConnStatus.dwSize := SizeOf(RasConnStatus);
    Status := RasGetConnectStatusA(hRasConn, @RasConnStatus);
    if Status = ERROR_INVALID_HANDLE then begin
        LogMessage('Connection closed');
        DoDuration;
        Disconnected;
        Exit;
    end;

    if Status <> 0 then begin
        Buf := '';
        RasGetErrorStringA(Status, @Buf[0], SizeOf(Buf));
        LogMessage('Error #' + IntToStr(Status) + ' : ' + Buf);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.Dial(EntryName, UserName, Password : String);
var
    rdParams : TRASDIALPARAMS;
    dwRet    : DWORD;
    Buf      : array [0..255] of Char;
begin
    hRasConn := GetActiveConnHandle(EntryName);
    if hRasConn <> 0 then begin
        LogMessage('Connection already active');
        Connected;
        ConnectTime := $FFFFFFFF;
        Exit;
    end;

    // setup RAS Dial Parameters
    FillChar(rdParams, SizeOf(rdParams), 0);
    rdParams.dwSize              := SizeOf(TRASDIALPARAMS);
    strCopy(rdParams.szUserName,  PChar(UserName));
    strCopy(rdParams.szPassword,  PChar(Password));
    strCopy(rdParams.szEntryName, PChar(EntryName));
    rdParams.szPhoneNumber[0]    := #0;
    rdParams.szCallbackNumber[0] := '*';
    rdParams.szDomain            := '*';

    g_hWnd := Handle;
    hRasConn := 0;;
    dwRet  := RasDialA(nil, nil, @rdParams, 0, @RasDialFunc, @hRasConn);
    if dwRet <> 0 then begin
        RasGetErrorStringA(dwRet, @Buf[0], SizeOf(Buf));
        LogMessage(IntToStr(dwRet) + ' ' + Buf);
        Disconnected;
    end
    else begin
        LogMessage('Dialing ''' + EntryName + '''');
        CancelButton.Enabled  := TRUE;
        ConnectButton.Enabled := FALSE;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.SaveSettings;
var
    IniFile : TIniFile;
    EntryName : String;
    UserName  : String;
begin
    IniFile := TIniFile.Create(FIniFileName);
    IniFile.WriteString('Last', 'EntryName', EntryNameComboBox.Text);
    IniFile.WriteString('Last', 'UserName',  UserNameComboBox.Text);
    IniFile.WriteInteger('Last', 'AutoPW',    ord(ConfigureAutoForm.AutoPassword));
    IniFile.WriteInteger('Last', 'AutoUN',    ord(ConfigureAutoForm.AutoUserName));
    IniFile.WriteInteger('Last', 'AutoConnect',        ord(ConfigureAutoForm.AutoConnect));
    IniFile.WriteInteger('Last', 'AutoExecuteBrowser', ord(ConfigureAutoForm.AutoExecuteBrowser));
    IniFile.WriteInteger('Last', 'AutoExecuteMail',    ord(ConfigureAutoForm.AutoExecuteMail));
    IniFile.WriteInteger('Last', 'AutoExecuteNews',    ord(ConfigureAutoForm.AutoExecuteNews));
    IniFile.WriteInteger('Last', 'MonthlyDuration',    ord(ConfigureAutoForm.MonthlyDuration));
    IniFile.WriteString('Last', 'BrowserExe',          ConfigureAutoForm.BrowserExe);
    IniFile.WriteString('Last', 'MailExe',             ConfigureAutoForm.MailExe);
    IniFile.WriteString('Last', 'NewsExe',             ConfigureAutoForm.NewsExe);
    IniFile.WriteString('Last', 'BrowserDir',          ConfigureAutoForm.BrowserDir);
    IniFile.WriteString('Last', 'MailDir',             ConfigureAutoForm.MailDir);
    IniFile.WriteString('Last', 'NewsDir',             ConfigureAutoForm.NewsDir);
    if SavePWCheckBox.Checked then begin
        IniFile.WriteString('Last', '   Password', EnCrypt(PasswordEdit.Text));
        IniFile.WriteString('Last',     'SavePW',  '1');
        EntryName := CrunchName(Trim(EntryNameComboBox.Text));
        UserName  := CrunchName(Trim(UserNameComboBox.Text));
        if (UserName <> '') and (EntryName <> '') then
            IniFile.WriteString('RAS_ENTRY_' + EntryName,
                                'USER_' + UserName,
                                EnCrypt(PasswordEdit.Text));
    end
    else begin
        IniFile.WriteString('Last',     'Password', '');
        IniFile.WriteString('Last',     'SavePW',   '0');
    end;

    IniFile.Free;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.ConnectButtonClick(Sender: TObject);
begin
    DoConnect;
end;

{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.DoConnect;
begin
    SaveSettings;
    InfoListBox.Clear;
    Caption := ProgName + ' - Dialing';
    TimeAutoForm.Section := 'RAS_ENTRY_' + CrunchName(EntryNameComboBox.Text);
    if not TimeAutoForm.Check then begin
        LogMessage('Time Restriction Apply');
        Disconnected;
        Exit;
    end;
    DialingServer   := EntryNameComboBox.Text;
    DialingUserName := UserNameComboBox.Text;
    DialingPassword := PasswordEdit.Text;
    Dial(DialingServer, DialingUserName, DialingPassword);
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
    CheckTimer.Enabled    := FALSE;
    inherited;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.FormCloseQuery(Sender: TObject;
  var CanClose: Boolean);
var
    Status  : Integer;
begin
    SaveSettings;

    if hRasConn <> 0 then begin
        Status := Application.MEssageBox('Disconnect before exit ?',
                                         'Warning',
                                         MB_YESNOCANCEL);
        if Status = IDCANCEL then begin
            CanClose := FALSE;
            Exit;
        end;
        if Status = IDOK then begin
            RasHangUpA(hRasConn);
            hRasConn := 0;
        end;
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.CancelButtonClick(Sender: TObject);
begin
    DoCancel;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.DoCancel;
begin
    if ConnectTime = 0 then
        LogMessage('Canceled')
    else begin
        LogMessage('Disconnecting');
        DoDuration;
    end;

    Disconnected;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Encrypt(S : String) : String;
type
    PWORD = ^WORD;
var
    Len    : Integer;
    I      : Integer;
    V      : DWORD;
    P      : PChar;
    Buffer : String[255];
begin
    Buffer := S;
    Len := Length(Buffer) + 1;
    if (Len mod 2) <> 0 then
        Inc(Len);

    if Len < 10 then
        Len := 10;

    I := Length(Buffer);
    if I = 0 then
        Buffer := IntToStr(GetTickCount)
    else
        while Length(Buffer) < 10 do
            Buffer := Buffer + Buffer;
    SetLength(Buffer, I);

    Result := '';
    P := PChar(@Buffer[0]);
    for I := 1 to Len div 2 do begin
        V := 34567 + PWORD(P)^;
        P := P + 2;
        Result := Result + Format('%5.5d', [V]);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function Decrypt(S : String) : String;
type
    PWORD = ^WORD;
var
    Buffer : String;
    PW  : String[255];
    P   : PWORD;
    I   : Integer;
    V   : Integer;
begin
    PW := '                                   ';
    P := PWORD(@PW[0]);
    I := 1;
    while I <= Length(S) do begin
        Buffer := Copy(S, I, 5);
        I   := I + 5;
        V   := StrToInt(Buffer) - 34567;
        P^  := V;
        Inc(P);
    end;
    Result := PW;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.GetActiveConn;
var
    dwRet    : DWORD;
    nCB      : DWORD;
    Buf      : array [0..255] of Char;
begin
    aRasConn[0].dwSize := SizeOf(aRasConn[0]);
    nCB   := SizeOf(aRasConn);
    dwRet := RasEnumConnectionsA(@aRasConn, @nCB, @nRasConnCount);
    if dwRet <> 0 then begin
        RasGetErrorStringA(dwRet, @Buf[0], SizeOf(Buf));
        LogMessage(Buf);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
function TRasDialerForm.GetActiveConnHandle(szName : String) : THRASCONN;
var
    I : Integer;
begin
    GetActiveConn;
    if nRasConnCount > 0 then begin
        for I := 0 to nRasConnCount - 1 do begin
            if StrIComp(PChar(szName), aRasConn[I].szEntryName) = 0 then begin
                Result := aRasConn[I].hRasConn;
                Exit;
            end;
        end;
    end;
    Result := 0;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.DisplayActiveConn;
var
    I : Integer;
begin
    if nRasConnCount > 0 then begin
        LogMessage(IntToStr(nRasConnCount) + ' Existing connections');
        for I := 0 to nRasConnCount - 1 do
            LogMessage(aRasConn[I].szEntryName);
    end;
end;


{* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * *}
procedure TRasDialerForm.FormShow(Sender: TObject);
const
    FirstTime : Boolean = TRUE;
var
    IniFile   : TIniFile;
    SavePW    : String;
    AutoPW    : String;
    AutoFlag  : String;
    EntryName : String;
begin
    inherited;

    if FirstTime then begin
        FirstTime                       := FALSE;
        Caption                         := ProgName;
        AboutForm.ProgNameLabel.Caption := ProgName + ' ' + ProgVer;
        LoadPhoneBook;
        IniFile                := TIniFile.Create(FIniFileName);
        EntryName              := IniFile.ReadString('Last', 'EntryName', '');
        SelectPhoneBookEntry(EntryName);
        UserNameComboBox.Text      := IniFile.ReadString('Last', 'UserName',  '');
        AutoPW                 := IniFile.ReadString('Last', 'AutoPW',    '1');
        ConfigureAutoForm.AutoPassword := (AutoPW <> '0');
        AutoFlag               := IniFile.ReadString('Last', 'AutoUN',    '1');
        ConfigureAutoForm.AutoUserName := (AutoFlag <> '0');