就是在访问一个网址是,IE会弹出一个窗口,要用户名和密码,(就像登陆路由器时提示要密码的一样),而用户名和密码是已知的,如何在Delphi里打开这网址并登陆呢?麻烦大家。
解决方案 »
- 创建窗体动态链接库,成功运行,在文件夹里找不到后缀是.dll的对象
- 关于用delphi连接J2EE的三层结构,可有人做过?进来交流交流》》》》》》
- 一个非常难的问题!!!,在线求教,都搞了两天没解决.
- 简单的问题:局部对象变量存入 TList 的问题!
- 怎样使dbgrid被选中的一行(当前行)改变成绿色?
- 一个小问题 请大家指教!怎样 写两个控 件的响应事件
- 我要定做一款插件系统,有能力的DEPHLI 或者VC或者C+程序元联系我
- 看来此论坛无能人也!无人会回答此问题!都是一群笨蛋!!!
- 各位大侠,请问怎样将STRING转换为OBJECT型!有一点像VFP及VB里面的宏替换。(没人知道吗!)
- 恢复误删邮件问题
- fastreport2.5的使用问题!
- 免费开源的 CnPack IDE 专家包发布 0.9.2 版 !
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事件中提供用户名和密码。
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.
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.