用delphi7开发了一个Activex控件,在网页中调用,控件中的函数也能正常执行,但是在IE关闭时报错?高手请进

[gsoft]

用delphi7开发了一个Activex控件,在网页中调用,控件中的函数也能正常执行都正常,所取的信息也都能取到,但是在关闭IE时报错.
iexplore.exe 遇到问题需要关闭。我们对此引起的不便表示抱歉。

[whisht]

我这里不出错
PAS

unit OCXDemoImpl1;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ActiveX, AxCtrls, OCXDemoProj1_TLB, StdVcl, StdCtrls;

type
  TOCXDemo = class(TActiveForm, IOCXDemo)
    btn1: TButton;
    btn2: TButton;
    procedure btn1Click(Sender: TObject);
    procedure btn2Click(Sender: TObject);
  private
    { Private declarations }
    FEvents: IOCXDemoEvents;
    procedure ActivateEvent(Sender: TObject);
    procedure ClickEvent(Sender: TObject);
    procedure CreateEvent(Sender: TObject);
    procedure DblClickEvent(Sender: TObject);
    procedure DeactivateEvent(Sender: TObject);
    procedure DestroyEvent(Sender: TObject);
    procedure KeyPressEvent(Sender: TObject; var Key: Char);
    procedure PaintEvent(Sender: TObject);


    function GetHDSerialNumber(Drv: String): String;
    procedure WriteFile(const FileName, UserName: WideString);  

  protected
    { Protected declarations }

    procedure DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage); override;
    procedure EventSinkChanged(const EventSink: IUnknown); override;
    function Get_Active: WordBool; safecall;
    function Get_AlignDisabled: WordBool; safecall;
    function Get_AutoScroll: WordBool; safecall;
    function Get_AutoSize: WordBool; safecall;
    function Get_AxBorderStyle: TxActiveFormBorderStyle; safecall;
    function Get_Caption: WideString; safecall;
    function Get_Color: OLE_COLOR; safecall;
    function Get_DoubleBuffered: WordBool; safecall;
    function Get_DropTarget: WordBool; safecall;
    function Get_Enabled: WordBool; safecall;
    function Get_Font: IFontDisp; safecall;
    function Get_HelpFile: WideString; safecall;
    function Get_KeyPreview: WordBool; safecall;
    function Get_PixelsPerInch: Integer; safecall;
    function Get_PrintScale: TxPrintScale; safecall;
    function Get_Scaled: WordBool; safecall;
    function Get_ScreenSnap: WordBool; safecall;
    function Get_SnapBuffer: Integer; safecall;
    function Get_Visible: WordBool; safecall;
    function Get_VisibleDockClientCount: Integer; safecall;
    procedure _Set_Font(var Value: IFontDisp); safecall;
    procedure Set_AutoScroll(Value: WordBool); safecall;
    procedure Set_AutoSize(Value: WordBool); safecall;
    procedure Set_AxBorderStyle(Value: TxActiveFormBorderStyle); safecall;
    procedure Set_Caption(const Value: WideString); safecall;
    procedure Set_Color(Value: OLE_COLOR); safecall;
    procedure Set_DoubleBuffered(Value: WordBool); safecall;
    procedure Set_DropTarget(Value: WordBool); safecall;
    procedure Set_Enabled(Value: WordBool); safecall;
    procedure Set_Font(const Value: IFontDisp); safecall;
    procedure Set_HelpFile(const Value: WideString); safecall;
    procedure Set_KeyPreview(Value: WordBool); safecall;
    procedure Set_PixelsPerInch(Value: Integer); safecall;
    procedure Set_PrintScale(Value: TxPrintScale); safecall;
    procedure Set_Scaled(Value: WordBool); safecall;
    procedure Set_ScreenSnap(Value: WordBool); safecall;
    procedure Set_SnapBuffer(Value: Integer); safecall;
    procedure Set_Visible(Value: WordBool); safecall;
  public
    { Public declarations }
    procedure Initialize; override;
  end;

implementation

uses ComObj, ComServ;

{$R *.DFM}

[whisht]

PAS2

{ TOCXDemo }

procedure TOCXDemo.DefinePropertyPages(DefinePropertyPage: TDefinePropertyPage);
begin
  { Define property pages here.  Property pages are defined by calling
    DefinePropertyPage with the class id of the page.  For example,
      DefinePropertyPage(Class_OCXDemoPage); }
end;

procedure TOCXDemo.EventSinkChanged(const EventSink: IUnknown);
begin
  FEvents := EventSink as IOCXDemoEvents;
  inherited EventSinkChanged(EventSink);
end;

procedure TOCXDemo.Initialize;
begin
  inherited Initialize;
  OnActivate := ActivateEvent;
  OnClick := ClickEvent;
  OnCreate := CreateEvent;
  OnDblClick := DblClickEvent;
  OnDeactivate := DeactivateEvent;
  OnDestroy := DestroyEvent;
  OnKeyPress := KeyPressEvent;
  OnPaint := PaintEvent;
end;

function TOCXDemo.Get_Active: WordBool;
begin
  Result := Active;
end;

function TOCXDemo.Get_AlignDisabled: WordBool;
begin
  Result := AlignDisabled;
end;

function TOCXDemo.Get_AutoScroll: WordBool;
begin
  Result := AutoScroll;
end;

function TOCXDemo.Get_AutoSize: WordBool;
begin
  Result := AutoSize;
end;

function TOCXDemo.Get_AxBorderStyle: TxActiveFormBorderStyle;
begin
  Result := Ord(AxBorderStyle);
end;

function TOCXDemo.Get_Caption: WideString;
begin
  Result := WideString(Caption);
end;

function TOCXDemo.Get_Color: OLE_COLOR;
begin
  Result := OLE_COLOR(Color);
end;

function TOCXDemo.Get_DoubleBuffered: WordBool;
begin
  Result := DoubleBuffered;
end;

function TOCXDemo.Get_DropTarget: WordBool;
begin
  Result := DropTarget;
end;

function TOCXDemo.Get_Enabled: WordBool;
begin
  Result := Enabled;
end;

function TOCXDemo.Get_Font: IFontDisp;
begin
  GetOleFont(Font, Result);
end;

function TOCXDemo.Get_HelpFile: WideString;
begin
  Result := WideString(HelpFile);
end;

function TOCXDemo.Get_KeyPreview: WordBool;
begin
  Result := KeyPreview;
end;

function TOCXDemo.Get_PixelsPerInch: Integer;
begin
  Result := PixelsPerInch;
end;

function TOCXDemo.Get_PrintScale: TxPrintScale;
begin
  Result := Ord(PrintScale);
end;

function TOCXDemo.Get_Scaled: WordBool;
begin
  Result := Scaled;
end;

function TOCXDemo.Get_ScreenSnap: WordBool;
begin
  Result := ScreenSnap;
end;

function TOCXDemo.Get_SnapBuffer: Integer;
begin
  Result := SnapBuffer;
end;

function TOCXDemo.Get_Visible: WordBool;
begin
  Result := Visible;
end;

function TOCXDemo.Get_VisibleDockClientCount: Integer;
begin
  Result := VisibleDockClientCount;
end;

procedure TOCXDemo._Set_Font(var Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure TOCXDemo.ActivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnActivate;
end;

procedure TOCXDemo.ClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnClick;
end;

procedure TOCXDemo.CreateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnCreate;
end;

procedure TOCXDemo.DblClickEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDblClick;
end;

procedure TOCXDemo.DeactivateEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDeactivate;
end;

procedure TOCXDemo.DestroyEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnDestroy;
end;

procedure TOCXDemo.KeyPressEvent(Sender: TObject; var Key: Char);
var
  TempKey: Smallint;
begin
  TempKey := Smallint(Key);
  if FEvents <> nil then FEvents.OnKeyPress(TempKey);
  Key := Char(TempKey);
end;

procedure TOCXDemo.PaintEvent(Sender: TObject);
begin
  if FEvents <> nil then FEvents.OnPaint;
end;

procedure TOCXDemo.Set_AutoScroll(Value: WordBool);
begin
  AutoScroll := Value;
end;

procedure TOCXDemo.Set_AutoSize(Value: WordBool);
begin
  AutoSize := Value;
end;

procedure TOCXDemo.Set_AxBorderStyle(Value: TxActiveFormBorderStyle);
begin
  AxBorderStyle := TActiveFormBorderStyle(Value);
end;

procedure TOCXDemo.Set_Caption(const Value: WideString);
begin
  Caption := TCaption(Value);
end;

procedure TOCXDemo.Set_Color(Value: OLE_COLOR);
begin
  Color := TColor(Value);
end;

procedure TOCXDemo.Set_DoubleBuffered(Value: WordBool);
begin
  DoubleBuffered := Value;
end;

procedure TOCXDemo.Set_DropTarget(Value: WordBool);
begin
  DropTarget := Value;
end;

procedure TOCXDemo.Set_Enabled(Value: WordBool);
begin
  Enabled := Value;
end;

procedure TOCXDemo.Set_Font(const Value: IFontDisp);
begin
  SetOleFont(Font, Value);
end;

procedure TOCXDemo.Set_HelpFile(const Value: WideString);
begin
  HelpFile := String(Value);
end;

procedure TOCXDemo.Set_KeyPreview(Value: WordBool);
begin
  KeyPreview := Value;
end;

procedure TOCXDemo.Set_PixelsPerInch(Value: Integer);
begin
  PixelsPerInch := Value;
end;

procedure TOCXDemo.Set_PrintScale(Value: TxPrintScale);
begin
  PrintScale := TPrintScale(Value);
end;

procedure TOCXDemo.Set_Scaled(Value: WordBool);
begin
  Scaled := Value;
end;

procedure TOCXDemo.Set_ScreenSnap(Value: WordBool);
begin
  ScreenSnap := Value;
end;

procedure TOCXDemo.Set_SnapBuffer(Value: Integer);
begin
  SnapBuffer := Value;
end;

procedure TOCXDemo.Set_Visible(Value: WordBool);
begin
  Visible := Value;
end;



function TOCXDemo.GetHDSerialNumber(Drv: String): String;
var 
  VolumeSerialNumber : DWORD; 
  MaximumComponentLength : DWORD; 
  FileSystemFlags : DWORD; 
begin 
  if Drv[Length(Drv)] =':' then Drv := Drv + '\'; 
  GetVolumeInformation(pChar(Drv), 
                      nil, 
                      0, 
                      @VolumeSerialNumber, 
                      MaximumComponentLength, 
                      FileSystemFlags, 
                      nil, 
                      0); 
  Result := IntToHex(HiWord(VolumeSerialNumber), 4) + 
            '-' + 
            IntToHex(LoWord(VolumeSerialNumber), 4); 
  Result :=  Inttostr(VolumeSerialNumber); 

end;

procedure TOCXDemo.WriteFile(const FileName, UserName: WideString);
var
  F1: TextFile; 
  Attributes: Word; 
  strFileName:WideString; 
begin 
    if Length(FileName) = 0 then 
      strFileName := 'c:\test.txt'; 

    AssignFile(F1, strFileName); 
    Rewrite(F1); 
    Write(F1,UserName); 
    CloseFile(F1); 
    Attributes := $00000001 or $00000002 or $00000004; 
    //faReadOnly  = $00000001 platform; 
    // faHidden    = $00000002 platform; 
    //faSysFile  = $00000004 platform;
    //fileSetAttr(strFileName,Attributes); 
end;

procedure TOCXDemo.btn1Click(Sender: TObject);
begin
  ShowMessage(GetHDSerialNumber('C'));
end;

procedure TOCXDemo.btn2Click(Sender: TObject);
begin
  WriteFile('', 'test');
end;

initialization
  TActiveFormFactory.Create(
    ComServer,
    TActiveFormControl,
    TOCXDemo,
    Class_OCXDemo,
    1,
    '',
    OLEMISC_SIMPLEFRAME or OLEMISC_ACTSLIKELABEL,
    tmApartment);
end.

[whisht]

DFM

object OCXDemo: TOCXDemo
  Left = 227
  Top = 114
  Width = 533
  Height = 384
  Caption = 'OCXDemo'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  PixelsPerInch = 96
  TextHeight = 13
  object btn1: TButton
    Left = 120
    Top = 136
    Width = 75
    Height = 25
    Caption = 'btn1'
    TabOrder = 0
    OnClick = btn1Click
  end
  object btn2: TButton
    Left = 120
    Top = 168
    Width = 75
    Height = 25
    Caption = 'btn2'
    TabOrder = 1
    OnClick = btn2Click
  end
end

[whisht]

<HTML>
<H1> Delphi 7 ActiveX Test Page </H1><p>
You should see your Delphi 7 forms or controls embedded in the form below.
<HR><center><P>
<OBJECT
	  classid="clsid:7F861A3A-3FC4-4FC6-8B2C-BA82C6355E8F"
	  codebase="OCXDemoProj1.ocx#version=1,0,0,0"
	  width=350
	  height=250
	  align=center
	  hspace=0
	  vspace=0
>
</OBJECT>
</HTML>

[whisht]

看一下OCX是否注册成功，或者删除重新注册一下

[gsoft]

楼上,好象代码与我的一样,那估计是我IE有问题,我的电脑安装上SP3后,又安装过FPES,IIS出过错,估计是它的问题吧,谢谢楼上

[whisht]

[Quote=引用 12 楼 gsoft 的回复:]
楼上,好象代码与我的一样,那估计是我IE有问题,我的电脑安装上SP3后,又安装过FPES,IIS出过错,估计是它的问题吧,谢谢楼上
[/Quote]

就是用你的代码做的测试

[whisht]

OS：XP SP3 IE6

[gsoft]

如果没人有意见,我先不管它了,没时间!

如果没人来踩,明天结贴了

[gsoft]

就是我的代码,那太好了,OK,结贴

[k1988]

那要看你在这个控件里使用了什么资源，然后在Active Form控件窗口的OnClose事件中断开数据库连接及Socket连接及其它一切资源及终止线程等操作。也就是在退出你这个控件时要将资源释放和将代码停止活动

[hongqi162]

确认你在activex里面使用的资源都释放掉了，不要出现错误的地址操作什么的

[kye_jufei]

检查资源是否全部释放

[gsoft]

我在里面没有用什么资源,只是写了一个函数,取机器的硬盘号,还有一个函数是向本地写了一个文本文件.

function TActiveFormX.GetHDSerialNumber(Drv: String): String;
var
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
begin
if Drv[Length(Drv)] =':' then Drv := Drv + '\';
GetVolumeInformation(pChar(Drv),
nil,
0,
@VolumeSerialNumber,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
Result := IntToHex(HiWord(VolumeSerialNumber), 4) +
'-' +
IntToHex(LoWord(VolumeSerialNumber), 4);
Result := Inttostr(VolumeSerialNumber);
end;

procedure TSysInfo.WriteFile(const FileName, UserName: WideString);
var
F1: TextFile;
Attributes: Word;
strFileName:WideString;
begin
if Length(FileName) = 0 then
strFileName := 'c:\test.txt';

AssignFile(F1, strFileName);
Rewrite(F1);
Write(F1,UserName);
CloseFile(F1);
Attributes := $00000001 or $00000002 or $00000004;
//faReadOnly = $00000001 platform;
// faHidden = $00000002 platform;
//faSysFile = $00000004 platform;
//fileSetAttr(strFileName,Attributes);
end;

别的函数都没有使用

我在win2000 pro上通过IE访问,关闭正常,通过Windowxp上通过IE访问,关闭都报错.

????

[gsoft]

重发,以此贴代码为准
我在里面没有用什么资源,只是写了一个函数,取机器的硬盘号,还有一个函数是向本地写了一个文本文件.

function TActiveFormX.GetHDSerialNumber(Drv: String): String;
var
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
begin
if Drv[Length(Drv)] =':' then Drv := Drv + '\';
GetVolumeInformation(pChar(Drv),
nil,
0,
@VolumeSerialNumber,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
Result := IntToHex(HiWord(VolumeSerialNumber), 4) +
'-' +
IntToHex(LoWord(VolumeSerialNumber), 4);
Result := Inttostr(VolumeSerialNumber);
end;



procedure TActiveFormX.WriteFile(const FileName, UserName: WideString);
var
F1: TextFile;
Attributes: Word;
strFileName:WideString;
begin
if Length(FileName) = 0 then
strFileName := 'c:\test.txt';

AssignFile(F1, strFileName);
Rewrite(F1);
Write(F1,UserName);
CloseFile(F1);
Attributes := $00000001 or $00000002 or $00000004;
//faReadOnly = $00000001 platform;
// faHidden = $00000002 platform;
//faSysFile = $00000004 platform;
//fileSetAttr(strFileName,Attributes);
end;

别的函数都没有使用

我在win2000 pro上通过IE访问,关闭正常,通过Windowxp上通过IE访问,关闭都报错.

????

[zshsuming]

学习一下