ocx 线程

Question

activeform 中创建一个线程在网页中使用：如果ocx 被一个页面使用时，再用它创建线程总是失败。如何解决？请高手帮忙。

Answer 1

GetLastError判断一下是什么错误。

Answer 2

代码：
unit DownLoadThread;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,UrlMon,ActiveX;
const
  S_ABORT = HRESULT($80004004);type    TFileDownLoadThread = class;    TDownLoadProcessEvent = procedure(Sender:TFileDownLoadThread;Progress, ProgressMax:Cardinal;ulStatusCode: ULONG;
            szStatusText: LPCWSTR) of object;
    TDownLoadCompleteEvent = procedure(Sender:TFileDownLoadThread) of object ;
    TDownLoadFailEvent = procedure(Sender:TFileDownLoadThread;Reason:LongInt) of object ;    TDownLoadMonitor = class( TInterfacedObject, IBindStatusCallback )
    private
        FShouldAbort: Boolean;
        FThread:TFileDownLoadThread;
    protected
        function OnStartBinding( dwReserved: DWORD; pib: IBinding ): HResult; stdcall;
        function GetPriority( out nPriority ): HResult; stdcall;
        function OnLowResource( reserved: DWORD ): HResult; stdcall;
        function OnProgress( ulProgress, ulProgressMax, ulStatusCode: ULONG;
            szStatusText: LPCWSTR): HResult; stdcall;
        function OnStopBinding( hresult: HResult; szError: LPCWSTR ): HResult; stdcall;
        function GetBindInfo( out grfBINDF: DWORD; var bindinfo: TBindInfo ): HResult; stdcall;
        function OnDataAvailable( grfBSCF: DWORD; dwSize: DWORD; formatetc: PFormatEtc;
            stgmed: PStgMedium ): HResult; stdcall;
        function OnObjectAvailable( const iid: TGUID; punk: IUnknown ): HResult; stdcall;
    public
        constructor Create(AThread:TFileDownLoadThread);
        property ShouldAbort: Boolean read FShouldAbort write FShouldAbort;
    end;    TFileDownLoadThread = class( TThread )
    private
        FSourceURL: string;
        FSaveFileName: string;
        FulStatusCode: ULONG;
        FszStatusText: LPCWSTR ;
        FProgress,FProgressMax:Cardinal;
        FOnProcess: TDownLoadProcessEvent;
        FOnComplete: TDownLoadCompleteEvent;
        FOnFail: TDownLoadFailEvent;
        FMonitor: TDownLoadMonitor;
    protected
        procedure Execute; override;
        procedure UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText:string);
        procedure DoUpdateUI;
    public
        constructor Create( ASrcURL, ASaveFileName: string; AProgressEvent:TDownLoadProcessEvent = nil;
          ACompleteEvent:TDownLoadCompleteEvent = nil;AFailEvent:TDownLoadFailEvent=nil;CreateSuspended: Boolean=False );
        property SourceURL: string read FSourceURL;
        property SaveFileName: string read FSaveFileName;
        property OnProcess: TDownLoadProcessEvent read FOnProcess write FOnProcess;
        property OnComplete: TDownLoadCompleteEvent read FOnComplete write FOnComplete;
        property OnFail: TDownLoadFailEvent read FOnFail write FOnFail;
    end;implementationconstructor TDownLoadMonitor.Create(AThread: TFileDownLoadThread);
begin
  inherited Create;
  FThread:=AThread;
  FShouldAbort:=False;
end;function TDownLoadMonitor.GetBindInfo( out grfBINDF: DWORD; var bindinfo: TBindInfo ): HResult;
begin
  result := S_OK;
end;function TDownLoadMonitor.GetPriority( out nPriority ): HResult;
begin
  Result := S_OK;
end;function TDownLoadMonitor.OnDataAvailable( grfBSCF, dwSize: DWORD; formatetc: PFormatEtc; stgmed: PStgMedium ): HResult;
begin
  Result := S_OK;
end;function TDownLoadMonitor.OnLowResource( reserved: DWORD ): HResult;
begin
  Result := S_OK;
end;function TDownLoadMonitor.OnObjectAvailable( const iid: TGUID; punk: IInterface ): HResult;
begin
  Result := S_OK;
end;function TDownLoadMonitor.OnProgress( ulProgress, ulProgressMax, ulStatusCode: ULONG; szStatusText: LPCWSTR ): HResult;
begin
  if FThread<>nil then
     FThread.UpdateProgress(ulProgress,ulProgressMax,ulStatusCode,'');
  if FShouldAbort then
     Result := E_ABORT
  else
     Result := S_OK;
end;function TDownLoadMonitor.OnStartBinding( dwReserved: DWORD; pib: IBinding ): HResult;
begin
  Result := S_OK;
end;function TDownLoadMonitor.OnStopBinding( hresult: HResult; szError: LPCWSTR ): HResult;
begin
  Result := S_OK;
end;{ TFileDownLoadThread }
constructor TFileDownLoadThread.Create( ASrcURL, ASaveFileName: string;AProgressEvent:TDownLoadProcessEvent ;
          ACompleteEvent:TDownLoadCompleteEvent;AFailEvent:TDownLoadFailEvent; CreateSuspended: Boolean );
begin
  if (@AProgressEvent=nil) or (@ACompleteEvent=nil) or (@AFailEvent=nil) then
    CreateSuspended:=True;
  inherited Create( CreateSuspended );
  FSourceURL:=ASrcURL;
  FSaveFileName:=ASaveFileName;
  FOnProcess:=AProgressEvent;
  FOnComplete:=ACompleteEvent;
  FOnFail:=AFailEvent;
end;procedure TFileDownLoadThread.DoUpdateUI;
begin
  if Assigned(FOnProcess) then
     FOnProcess(Self,FProgress,FProgressMax,FulStatusCode,FszStatusText);
end;procedure TFileDownLoadThread.Execute;
var
  DownRet:HRESULT;
begin
  inherited;
  FMonitor:=TDownLoadMonitor.Create(Self);
  DownRet:= URLDownloadToFile( nil, PAnsiChar( FSourceURL ), PAnsiChar( FSaveFileName ), 0,FMonitor as IBindStatusCallback);
  if DownRet=S_OK then
  begin
    if Assigned(FOnComplete) then
        FOnComplete(Self);
  end
  else
  begin
    if Assigned(FOnFail) then
        FOnFail(Self,DownRet);
  end;
  FMonitor:=nil;
end;procedure TFileDownLoadThread.UpdateProgress(Progress, ProgressMax, StatusCode: Cardinal; StatusText: string);
begin
  FProgress:=Progress;
  FProgressMax:=ProgressMax;
  Synchronize(DoUpdateUI);
  if Terminated then
     FMonitor.ShouldAbort:=True;
end;
end.

Answer 3

///========下载界面unit UnitDown;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, ComCtrls,DownLoadThread, OleCtrls,ComObj,ShellApi ,
  ShockwaveFlashObjects_TLB,BonZLib,XMLIntf,XMLDoc, ExtCtrls, ActiveX;type
  TFrmDownLoad = class(TForm)
    IsClose: TCheckBox;
    ProgressBar1: TProgressBar;
    BtnOpen: TButton;
    BtnOpenPath: TButton;
    BtnClose: TButton;
    Label2: TLabel;
    Label4: TLabel;
    ReadyNumLb: TLabel;
    SavePathLb: TLabel;
    LeaveLb: TLabel;
    Label3: TLabel;
    Bevel1: TBevel;
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
    procedure FormShow(Sender: TObject);
    procedure BtnCloseClick(Sender: TObject);
    procedure BtnOpenClick(Sender: TObject);
    procedure BtnOpenPathClick(Sender: TObject);
  private
    FSourceURL: string;
    FSaveFileName: string;
    FSuccessful:Boolean;    procedure DownCompelete(Sender: TFileDownLoadThread);
    procedure DownFaild(Sender: TFileDownLoadThread; Reason: Integer);
    procedure DownProgress(Sender: TFileDownLoadThread; Progress,
      ProgressMax: Cardinal;ulStatusCode: ULONG; szStatusText: LPCWSTR);    { Private declarations }
  public
    { Public declarations }
     property SourceURL: string read FSourceURL write FSourceURL;
     property SaveFileName: string read FSaveFileName write FSaveFileName;
     property Successful:Boolean read FSuccessful write FSuccessful;
  end;var
  FrmDownLoad: TFrmDownLoad;implementationuses Math;{$R *.dfm}{ TFrmDownLoad }procedure TFrmDownLoad.DownCompelete(Sender: TFileDownLoadThread);
begin
  Label4.Caption:='下载完毕';
  BtnClose.Caption:='关 闭';
  BtnOpen.Enabled:=True;;
  BtnOpenPath.Enabled:=true;
  if IsClose.Checked then
    Self.Close;
end;procedure TFrmDownLoad.DownFaild(Sender: TFileDownLoadThread;
  Reason: Integer);
begin
  Label4.Caption:='下载失败';
end;procedure TFrmDownLoad.DownProgress(Sender: TFileDownLoadThread; Progress,
  ProgressMax: Cardinal; ulStatusCode: ULONG; szStatusText: LPCWSTR);begin
  Label4.Caption:='正在下载';
  if ProgressMax<>0 then
    self.Text:='下载完成：'+FloatToStr(round(Progress/ProgressMax*100*10)/10)+'%';  Self.ProgressBar1.Max:=ProgressMax;
  Self.ProgressBar1.Position:=Progress;
 
end;
procedure TFrmDownLoad.FormShow(Sender: TObject);
var
  downthread:TFileDownLoadThread;
begin
  try
    FSuccessful:=False;
    BtnOpen.Enabled:=False;
    BtnOpenPath.Enabled:=False;
    BtnClose.Caption:='取 消';
    downthread:=TFileDownLoadThread.Create(Self.SourceURL,Self.SaveFileName,DownProgress,DownCompelete,DownFaild,False);
    downthread.FreeOnTerminate:=True;
    SavePathLb.Caption:=SaveFileName;
  except
    Self.Close;
  end;
end;procedure TFrmDownLoad.BtnCloseClick(Sender: TObject);
begin
end;procedure TFrmDownLoad.BtnOpenClick(Sender: TObject);
var
  openfile:String;
begin
  openfile:=SaveFileName;
  if FileExists(openfile) then
  begin
    if ShellExecute(0, 'Open', PChar(openfile), '', '', SW_SHOWNORMAL) > 32 then
       Close
    else
      ShowMessage('打开文件失败');
  end;
end;procedure TFrmDownLoad.BtnOpenPathClick(Sender: TObject);
begin
  if DirectoryExists( ExtractFilePath(SaveFileName)) then
   ShellExecute(0, 'Open', PChar(ExtractFilePath(SaveFileName)), '', '', SW_SHOWNORMAL);
end;
end.
在activeform调用下载的时候 只是创建了TFrmDownLoad窗体高手看看那有问题？

Answer 4

没看出啥问题，你看看这个 http://vip.6to23.com/tianmingxin/Delphi/Tip/ocxproject.htm