ocx 线程

[bingbingliangliang]

activeform 中创建一个线程

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

[bingbingliangliang]

那我在你不忙的时候请教，呵呵。。。。谢谢

[大大怪老张]

贴代码，肯定是你写的问题

[bingbingliangliang]

代码：
unit DownLoadThread;

interface

uses
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;

implementation

constructor 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.

[bingbingliangliang]

///========下载界面

unit UnitDown;

interface

uses
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;

implementation

uses 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窗体

高手看看那有问题？

[僵哥]

GetLastError判断一下是什么错误。

[bingbingliangliang]

楼上能不能跟你QQ聊？

后来看了一下，线程创建了，但是线程不能正常执行。

[僵哥]

QQ:83039548
上班时间，比较忙。

[大大怪老张]

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

[shuihan20e]

路过帮顶