就是在访问一个网址是,IE会弹出一个窗口,要用户名和密码,(就像登陆路由器时提示要密码的一样),而用户名和密码是已知的,如何在Delphi里打开这网址并登陆呢?麻烦大家。

解决方案 »

  1.   

    可以用INDY的TIdHTTP组件POST就可以了。
      

  2.   

    可以用TIdHttp实现。相关属性和事件:
    TIdHttp.Request.Username
    TIdHttp.Request.Password
    TIdHttp.Request.BasicAuthentication
    TIdHttp.OnSelectAuthorization
    TIdHttp.OnAuthorization如果网站采用Basic认证(最常见的情况),那么直接把TIdHttp.Request.BasicAuthentication改为True,并在TIdHttp.Post/TIdHttp.Get之前设置TIdHttp.Request.Username和TIdHttp.Request.Password即可。如果网站采用其他方式认证,则必须在TIdHttp.SelectAuthorization事件中指定对应的认证对象的类型,并在OnAuthorization事件中提供用户名和密码。
      

  3.   

    unit BBVideoFileSyncThread;interfaceuses
    Classes, Controls, ComCtrls, SyncObjs, ADODB, IniFiles, IndyHttpThread;type
    TBBVideoFileSyncThread = class; TBBVideoFileSyncFileNameEvent = procedure(Sender: TBBVideoFileSyncThread; FileName: string) of object; TBBVideoFileSyncThread = class(TThread)
    private
    FFilename: string;
    FFileNameQuery: TADOQuery;
    FFileNameEvent: TBBVideoFileSyncFileNameEvent;
    FIniSetting: TIniFile;
    FOverwrite: Boolean;
    FProgressBar: TProgressBar;
    FThread: TIndyHttpThread; FRunningLock: TCriticalSection;
    FRunning: Boolean;
    FStartNum: Integer;
    procedure SetRunningState(bRunning: Boolean); function GetPageCookie(sUrl: string): string; procedure GetNewFilename;
    procedure CallFileNameEvent;
    protected
    procedure Execute; override;
    public
    constructor Create(IniSetting: TIniFile; FileNameQuery: TADOQuery; Overwrite: Boolean = False; FileNameEvent: TBBVideoFileSyncFileNameEvent = nil; ProgressBar: TProgressBar = nil);
    destructor Destroy; override; function IsRunning: Boolean;
    procedure Start(iStartNum: Integer);
    procedure Stop;
    end;implementationuses
    Windows, SysUtils;{ TBBVideoFileSyncThread }procedure TBBVideoFileSyncThread.CallFileNameEvent;
    begin
    if Assigned(FFileNameEvent) then FFileNameEvent(self, FFilename);
    end;constructor TBBVideoFileSyncThread.Create(IniSetting: TIniFile; FileNameQuery: TADOQuery; Overwrite: Boolean; FileNameEvent: TBBVideoFileSyncFileNameEvent; ProgressBar: TProgressBar);
    begin
    FRunningLock := TCriticalSection.Create; if Assigned(IniSetting) then FIniSetting := IniSetting else raise Exception.Create('无效的IniSetting参数');
    if Assigned(FileNameQuery) then FFileNameQuery := FileNameQuery else raise Exception.Create('无效的FileNameQuery参数');
    FOverwrite := Overwrite;
    FFileNameEvent := FileNameEvent;
    FProgressBar := ProgressBar;
    inherited Create(False);
    end;destructor TBBVideoFileSyncThread.Destroy;
    begin
    FreeAndNil(FRunningLock);
    inherited;
    end;procedure TBBVideoFileSyncThread.Execute;
    var
    sLibPath, sPageUrlPattern, sFileUrlPattern: string;
    sFullFilename: string;
    fs: TFileStream;
    Option: TIndyHttpThreadOption;
    sUrl: string;
    bSuccess: Boolean;
    begin
    sLibPath := FIniSetting.ReadString('General', 'LibPath', 'C:\');
    sPageUrlPattern := FIniSetting.ReadString('URLPattern', 'PageUrlPattern', '');
    sFileUrlPattern := FIniSetting.ReadString('URLPattern', 'FileUrlPattern', ''); Option.Clear;
    Option.ProgressBar := FProgressBar;
    Option.FreeOnTerm := False;
    Option.RetryCount := FIniSetting.ReadInteger('FileSyncThread', 'RetryCount', 0);
    Option.RetryInterval := FIniSetting.ReadInteger('FileSyncThread', 'RetryInterval', 0);
    Option.Username := FIniSetting.ReadString('FileSyncThread', 'Username', '');
    Option.Password := FIniSetting.ReadString('FileSyncThread', 'Password', ''); while not Terminated do begin
    if IsRunning then begin
    try
    FFilename := '';
    Synchronize(GetNewFilename);
    if FFilename <> '' then begin
    sFullFilename := IncludeTrailingPathDelimiter(sLibPath) + FFilename;
    if (StrToIntDef(Copy(FFileName,1,4), 0) >= FStartNum) and ((not FileExists(sFullFilename)) or FOverwrite) then begin
    if Assigned(FFileNameEvent) then Synchronize(CallFileNameEvent);
    bSuccess := False;
    fs := TFileStream.Create(sFullFilename, fmCreate or fmShareDenyWrite);
    try
    Option.Cookie := GetPageCookie(Format(sPageUrlPattern, [StrToIntDef(Copy(FFilename,1,4),1000)]));
    if IsRunning then begin
    sUrl := Format(sFileUrlPattern, [Copy(FFilename,1,6)]);
    FThread := TIndyHttpThread.Get(sUrl, fs, @Option);
    try
    FThread.WaitFor;
    bSuccess := FThread.Success;
    finally
    FreeAndNil(FThread);
    end;
    end;
    finally
    fs.Free;
    end;
    if not bSuccess then DeleteFile(sFullFilename);
    end;
    end;
    except
          end;
    end;
    Sleep(10);
    end;
    end;procedure TBBVideoFileSyncThread.GetNewFilename;
    begin
    FFilename := '';
    with FFileNameQuery do begin
    if not Active then Open;
    if Eof then Requery;
    if RecordCount > 0 then begin
    FFilename := FieldByName('FileName').AsString;
    Next;
    end;
    end;
    end;function TBBVideoFileSyncThread.GetPageCookie(sUrl: string): string;
    const COOKIE_HEADER = 'set-cookie:';
    var
    Headers: TStringList;
    Thread: TIndyHttpThread;
    i: Integer;
    begin
    Result := '';
    if not IsRunning then Exit; Headers := TStringList.Create;
    try
    Thread := TIndyHttpThread.Head(sUrl, Headers);
    try
    Thread.WaitFor;
        finally
    Thread.Free;
    end; for i := 0 to Headers.Count-1 do begin
    if SameText(Copy(Headers[i],1,Length(COOKIE_HEADER)), COOKIE_HEADER) then begin
    Result := Trim(Copy(Headers[i], Length(COOKIE_HEADER)+1, Length(Headers[i])));
    Break;
    end;
    end;
    finally
    Headers.Free;
    end;
    end;function TBBVideoFileSyncThread.IsRunning: Boolean;
    begin
    FRunningLock.Acquire;
    try
    Result := FRunning;
    finally
    FRunningLock.Release;
    end;
    end;procedure TBBVideoFileSyncThread.SetRunningState(bRunning: Boolean);
    begin
    FRunningLock.Acquire;
    try
    FRunning := bRunning;
    finally
    FRunningLock.Release;
    end;
    end;procedure TBBVideoFileSyncThread.Start(iStartNum: Integer);
    begin
      FStartNum := iStartNum;
    SetRunningState(True);
    end;procedure TBBVideoFileSyncThread.Stop;
    begin
    SetRunningState(False);
    if Assigned(FThread) then FThread.Cancel;
    end;end.
      

  4.   

    不好意思,贴错代码了。刚才贴的是调用TIndyHttpThread类的代码,真正实现密码验证的是在TIndyHttpThread类里面。代码如下:unit IndyHttpThread;interfaceuses
    Classes, ComCtrls, IdComponent, IdHttp;type
    TIndyHttpThreadOption = record
    // Progress Bar Option
    ProgressBar: TProgressBar;
    // Termination Option
    FreeOnTerm: Boolean;
    TerminateHandler: TNotifyEvent;
    // Retry Option
    RetryCount: Integer;
    RetryInterval: Integer;
    // Cookie Option
    Cookie: string;
    // Login Option
    Username: string;
    Password: string;
    // Proxy Option
    ProxyServer: string;
    ProxyPort: Integer;
    ProxyUsername: string;
    ProxyPassword: string; procedure Clear;
    end;
    PIndyHttpThreadOption = ^TIndyHttpThreadOption; TIndyHttpThread = class(TThread)
    private
    FUrl: string;
    FContent: TStream;
    FOption: TIndyHttpThreadOption;
    FHeaderOutput: TStringList;
    FHeadOnly: Boolean;
    FHttp: TIdHttp;
    FSuccess: Boolean; FProgressMax: Integer;
    FProgressPos: Integer;
    procedure UpdateProgressBar;    procedure CopyOptions(POption: PIndyHttpThreadOption);
    procedure IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    procedure IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    protected
    procedure Execute; override;
    public
    property Content: TStream read FContent;
    property Success: Boolean read FSuccess; constructor Get(sUrl: string; Content: TStream; Option: PIndyHttpThreadOption = nil; HeaderOutput: TStringList = nil);
    constructor Head(sUrl: string; HeaderOutput: TStringList; Option: PIndyHttpThreadOption = nil); procedure Cancel;
    end;implementationuses
    SysUtils;{ TIndyHttpThread }procedure TIndyHttpThread.Cancel;
    begin
    self.Terminate;
    if Assigned(FHttp) then FHttp.Disconnect;
    end;procedure TIndyHttpThread.CopyOptions(POption: PIndyHttpThreadOption);
    begin
    with POption^ do begin
    // progress bar option
    FOption.ProgressBar := ProgressBar;
    // terminate option
    FOption.FreeOnTerm := FreeOnTerm;
    FOption.TerminateHandler := TerminateHandler;
    // retry option
    FOption.RetryCount := RetryCount;
    FOption.RetryInterval := RetryInterval;
    // cookie option
    FOption.Cookie := Cookie;
    // login option
    FOption.Username := Username;
    FOption.Password := Password;
    // proxy option
    FOption.ProxyServer := ProxyServer;
    FOption.ProxyPort := ProxyPort;
    FOption.ProxyUsername := ProxyUsername;
    FOption.ProxyPassword := ProxyPassword;
    end;
    end;procedure TIndyHttpThread.Execute;
    var i, iRetryCount, iRetryInterval: Integer;
    begin
    try
    FHttp := TIdHttp.Create(nil);
    try
    self.FreeOnTerminate := False; // default behaviour with FOption do begin
    // progress bar option
    if Assigned(ProgressBar) then begin
    FHttp.OnWorkBegin := IdHttpWorkBegin;
    FHttp.OnWork := IdHttpWork;
    end;
    // terminate option
    self.FreeOnTerminate := FreeOnTerm;
    self.OnTerminate := TerminateHandler;
    // retry option
    iRetryCount := RetryCount;
    iRetryInterval := RetryInterval;
    // cookie option
    FHttp.Request.CustomHeaders.Clear;
    if Cookie <> '' then FHttp.Request.CustomHeaders.Append(Format('Cookie: %s',[Cookie]));
    // login option
    FHttp.Request.Username := Username;
    FHttp.Request.Password := Password;
    // proxy option
    FHttp.ProxyParams.ProxyServer := ProxyServer;
    FHttp.ProxyParams.ProxyPort := ProxyPort;
    FHttp.ProxyParams.ProxyUsername := ProxyUsername;
    FHttp.ProxyParams.ProxyPassword := ProxyPassword;
    end; while iRetryCount >= 0 do begin
    try
    FHttp.HandleRedirects := True;
    FHttp.Request.BasicAuthentication := True; if not FHeadOnly then begin
    FHttp.Get(FUrl, FContent);
    FContent.Position := 0;
    end
    else FHttp.Head(FUrl); if Assigned(FHeaderOutput) then begin
    FHeaderOutput.Clear;
    for i := 0 to FHttp.Response.RawHeaders.Count-1 do FHeaderOutput.Append(FHttp.Response.RawHeaders[i]);
    end; FProgressPos := 0;
    Synchronize(UpdateProgressBar);
    Break; // break on successful operation to keep iRetryCount >= 0
    except
    if not Terminated then begin
    Sleep(iRetryInterval);
    Dec(iRetryCount);
    end
    else iRetryCount := 0;
    end;
    Dec(iRetryCount);
    end;
    FSuccess := (not Terminated) and (iRetryCount >= 0);
    finally
    FreeAndNil(FHttp);
    end;
    except
    FSuccess := False;
    end;
    end;constructor TIndyHttpThread.Get(sUrl: string; Content: TStream; Option: PIndyHttpThreadOption; HeaderOutput: TStringList);
    begin
    if sUrl <> '' then FUrl := sUrl else raise Exception.Create('无效的URL');
    if Assigned(Content) then FContent := Content else raise Exception.Create('无效的数据流对象');
    if Assigned(Option) then CopyOptions(Option) else FOption.Clear; FHeaderOutput := HeaderOutput; FHeadOnly := False; inherited Create(False);
    end;constructor TIndyHttpThread.Head(sUrl: string; HeaderOutput: TStringList; Option: PIndyHttpThreadOption);
    begin
    if sUrl <> '' then FUrl := sUrl else raise Exception.Create('无效的URL');
    FHeaderOutput := HeaderOutput;
    if Assigned(Option) then CopyOptions(Option) else FOption.Clear; FHeadOnly := True; inherited Create(False);
    end;procedure TIndyHttpThread.IdHTTPWork(ASender: TObject; AWorkMode: TWorkMode; AWorkCount: Int64);
    begin
    if AWorkMode = wmRead then begin
    FProgressPos := AWorkCount;
    Synchronize(UpdateProgressBar);
    end;
    end;procedure TIndyHttpThread.IdHTTPWorkBegin(ASender: TObject; AWorkMode: TWorkMode; AWorkCountMax: Int64);
    begin
    if AWorkMode = wmRead then begin
    FProgressMax := AWorkCountMax;
    FProgressPos := 0;
    Synchronize(UpdateProgressBar);
    end;
    end;procedure TIndyHttpThread.UpdateProgressBar;
    begin
    if not Assigned(FOption.ProgressBar) then Exit; with FOption.ProgressBar do begin
    Max := FProgressMax;
    Position := FProgressPos;
    end;
    end;{ TIndyHttpThreadOption }procedure TIndyHttpThreadOption.Clear;
    begin
    ProgressBar := nil;
    FreeOnTerm := False;
    TerminateHandler := nil;
    RetryCount := 0;
    RetryInterval := 0;
    Cookie := '';
    Username := '';
    Password := '';
    ProxyServer := '';
    ProxyPort := 0;
    ProxyUsername := '';
    ProxyPassword := '';
    end;end.