分享 解决flashengin1.08对flash8之后的callfunction和onflashcall问题 ( 积分: 0 )

  • 主题发起人 ball_cao
  • 开始时间
B

ball_cao

Unregistered / Unconfirmed
GUEST, unregistred user!
最近在做delphi和flash的接口。
发现了一个很好的flash控件flashengine。我用的时候最新版本是1.08。该控件除了支持普通的flash播放功能外，比TShockwaveFlash还多了一个背景透明的能力。这对于提高客户体验是非常有帮助的功能。
在使用中，发现了flashengine的TfeFlashPlayer的问题，它只针对flash8以前的版本封装了TCallLabel、TCallFrame等功能，没有提供Flash8以后提供的CallFunction(宿主程序调用flash函数)和OnFlashCall(flash调用宿主程序)的函数和事件。

在一天的研究中，我原本计划增加TShockwaveFlash的画背景功能，但在研究中我发现TfeFlashPlayer使用的是和TShockwaveFlash同一个ocx的接口(接口的uuid是相同的)，因此判断，不可能同一个ocx只对一个类TShockwaveFlash提供了接口而没有对另一个类TfeFlashPlayer开放。经过研究，发现是fe_flashplayer.pas中定义接口的部分屏蔽(也许是漏加)了上面所说的一个函数和一个事件。下面贴出修改后的fe_flashplayer.pas的源码。
有兴趣研究的可以用winmerge比较一下改后的代码和原始的文件。
如只需使用将下面代码直接覆盖原来的fe_flashplayer.pas即可

unit fe_flashplayer;

{$TYPEDADDRESS OFF} // Unit must be compiled without type-checked pointers.
{.$WARN SYMBOL_PLATFORM OFF}
{$WRITEABLECONST ON}
{.$VARPROPSETTER ON}
interface

uses Windows, SysUtils, ActiveX, Classes, Graphics, OleCtrls, OleServer, StdVCL,
fe_flashole, fe_flashwnd, fe_stream;



// *********************************************************************//
// GUIDS declared in the TypeLibrary. Following prefixes are used:
// Type Libraries : LIBID_xxxx
// CoClasses : CLASS_xxxx
// DISPInterfaces : DIID_xxxx
// Non-DISP interfaces: IID_xxxx
// *********************************************************************//
const
// TypeLibrary Major and minor versions
ShockwaveFlashObjectsMajorVersion = 1;
ShockwaveFlashObjectsMinorVersion = 0;

LIBID_ShockwaveFlashObjects: TGUID = '{D27CDB6B-AE6D-11CF-96B8-444553540000}';

IID_IShockwaveFlash: TGUID = '{D27CDB6C-AE6D-11CF-96B8-444553540000}';
DIID__IShockwaveFlashEvents: TGUID = '{D27CDB6D-AE6D-11CF-96B8-444553540000}';
CLASS_ShockwaveFlash: TGUID = '{D27CDB6E-AE6D-11CF-96B8-444553540000}';
CLASS_FlashProp: TGUID = '{1171A62F-05D2-11D1-83FC-00A0C9089C5A}';
IID_IFlashFactory: TGUID = '{D27CDB70-AE6D-11CF-96B8-444553540000}';
IID_IDispatchEx: TGUID = '{A6EF9860-C720-11D0-9337-00A0C90DCAA9}';
IID_IFlashObjectInterface: TGUID = '{D27CDB72-AE6D-11CF-96B8-444553540000}';
IID_IServiceProvider: TGUID = '{6D5140C1-7436-11CE-8034-00AA006009FA}';
CLASS_FlashObjectInterface: TGUID = '{D27CDB71-AE6D-11CF-96B8-444553540000}';
type

// *********************************************************************//
// Forward declaration of types defined in TypeLibrary
// *********************************************************************//
IShockwaveFlash = interface;
IShockwaveFlashDisp = dispinterface;
_IShockwaveFlashEvents = dispinterface;
IFlashFactory = interface;
IDispatchEx = interface;
IFlashObjectInterface = interface;
IServiceProvider = interface;

// *********************************************************************//
// Declaration of CoClasses defined in Type Library
// (NOTE: Here we map each CoClass to its Default Interface)
// *********************************************************************//
ShockwaveFlash = IShockwaveFlash;
FlashProp = IUnknown;
FlashObjectInterface = IFlashObjectInterface;


// *********************************************************************//
// Declaration of structures, unions and aliases.
// *********************************************************************//
PUserType1 = ^DISPPARAMS; {*}
PSYSUINT1 = ^SYSUINT; {*}
PUserType2 = ^TGUID; {*}


// *********************************************************************//
// Interface: IShockwaveFlash
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {D27CDB6C-AE6D-11CF-96B8-444553540000}
// *********************************************************************//
IShockwaveFlash = interface(IDispatch)
['{D27CDB6C-AE6D-11CF-96B8-444553540000}']
function Get_ReadyState: Integer; safecall;
function Get_TotalFrames: Integer; safecall;
function Get_Playing: WordBool; safecall;
procedure Set_Playing(pVal: WordBool); safecall;
function Get_Quality: SYSINT; safecall;
procedure Set_Quality(pVal: SYSINT); safecall;
function Get_ScaleMode: SYSINT; safecall;
procedure Set_ScaleMode(pVal: SYSINT); safecall;
function Get_AlignMode: SYSINT; safecall;
procedure Set_AlignMode(pVal: SYSINT); safecall;
function Get_BackgroundColor: Integer; safecall;
procedure Set_BackgroundColor(pVal: Integer); safecall;
function Get_Loop: WordBool; safecall;
procedure Set_Loop(pVal: WordBool); safecall;
function Get_Movie: WideString; safecall;
procedure Set_Movie(const pVal: WideString); safecall;
function Get_FrameNum: Integer; safecall;
procedure Set_FrameNum(pVal: Integer); safecall;
procedure SetZoomRect(left: Integer; top: Integer; right: Integer; bottom: Integer);

safecall;
procedure Zoom(factor: SYSINT); safecall;
procedure Pan(x: Integer; y: Integer; mode: SYSINT); safecall;
procedure Play; safecall;
procedure Stop; safecall;
procedure Back; safecall;
procedure Forward; safecall;
procedure Rewind; safecall;
procedure StopPlay; safecall;
procedure GotoFrame(FrameNum: Integer); safecall;
function CurrentFrame: Integer; safecall;
function IsPlaying: WordBool; safecall;
function PercentLoaded: Integer; safecall;
function FrameLoaded(FrameNum: Integer): WordBool; safecall;
function FlashVersion: Integer; safecall;
function Get_WMode: WideString; safecall;
procedure Set_WMode(const pVal: WideString); safecall;
function Get_SAlign: WideString; safecall;
procedure Set_SAlign(const pVal: WideString); safecall;
function Get_Menu: WordBool; safecall;
procedure Set_Menu(pVal: WordBool); safecall;
function Get_Base: WideString; safecall;
procedure Set_Base(const pVal: WideString); safecall;
function Get_Scale: WideString; safecall;
procedure Set_Scale(const pVal: WideString); safecall;
function Get_DeviceFont: WordBool; safecall;
procedure Set_DeviceFont(pVal: WordBool); safecall;
function Get_EmbedMovie: WordBool; safecall;
procedure Set_EmbedMovie(pVal: WordBool); safecall;
function Get_BGColor: WideString; safecall;
procedure Set_BGColor(const pVal: WideString); safecall;
function Get_Quality2: WideString; safecall;
procedure Set_Quality2(const pVal: WideString); safecall;
procedure LoadMovie(layer: SYSINT; const url: WideString); safecall;
procedure TGotoFrame(const target: WideString; FrameNum: Integer); safecall;
procedure TGotoLabel(const target: WideString; const label_: WideString); safecall;
function TCurrentFrame(const target: WideString): Integer; safecall;
function TCurrentLabel(const target: WideString): WideString; safecall;
procedure TPlay(const target: WideString); safecall;
procedure TStopPlay(const target: WideString); safecall;
procedure SetVariable(const name: WideString; const value: WideString); safecall;
function GetVariable(const name: WideString): WideString; safecall;
procedure TSetProperty(const target: WideString; property_: SYSINT; const value:

WideString); safecall;
function TGetProperty(const target: WideString; property_: SYSINT): WideString;

safecall;
procedure TCallFrame(const target: WideString; FrameNum: SYSINT); safecall;
procedure TCallLabel(const target: WideString; const label_: WideString); safecall;
procedure TSetPropertyNum(const target: WideString; property_: SYSINT; value: Double);

safecall;
function TGetPropertyNum(const target: WideString; property_: SYSINT): Double; safecall;
function TGetPropertyAsNumber(const target: WideString; property_: SYSINT): Double;

safecall;
function Get_SWRemote: WideString; safecall;
procedure Set_SWRemote(const pVal: WideString); safecall;
function Get_FlashVars: WideString; safecall;
procedure Set_FlashVars(const pVal: WideString); safecall;
function Get_AllowScriptAccess: WideString; safecall;
procedure Set_AllowScriptAccess(const pVal: WideString); safecall;
function Get_MovieData: WideString; safecall;
procedure Set_MovieData(const pVal: WideString); safecall;
function Get_InlineData: IUnknown; safecall;
procedure Set_InlineData(const ppIUnknown: IUnknown); safecall;
function Get_SeamlessTabbing: WordBool; safecall;
procedure Set_SeamlessTabbing(pVal: WordBool); safecall;
procedure EnforceLocalSecurity; safecall;
function Get_Profile: WordBool; safecall;
procedure Set_Profile(pVal: WordBool); safecall;
function Get_ProfileAddress: WideString; safecall;
procedure Set_ProfileAddress(const pVal: WideString); safecall;
function Get_ProfilePort: Integer; safecall;
procedure Set_ProfilePort(pVal: Integer); safecall;
function CallFunction(const request: WideString): WideString; safecall;
procedure SetReturnValue(const returnValue: WideString); safecall;
procedure DisableLocalSecurity; safecall;
function Get_AllowNetworking: WideString; safecall;
procedure Set_AllowNetworking(const pVal: WideString); safecall;
function Get_AllowFullScreen: WideString; safecall;
procedure Set_AllowFullScreen(const pVal: WideString); safecall;
property ReadyState: Integer read Get_ReadyState;
property TotalFrames: Integer read Get_TotalFrames;
property Playing: WordBool read Get_Playing write Set_Playing;
property Quality: SYSINT read Get_Quality write Set_Quality;
property ScaleMode: SYSINT read Get_ScaleMode write Set_ScaleMode;
property AlignMode: SYSINT read Get_AlignMode write Set_AlignMode;
property BackgroundColor: Integer read Get_BackgroundColor write Set_BackgroundColor;
property Loop: WordBool read Get_Loop write Set_Loop;
property Movie: WideString read Get_Movie write Set_Movie;
property FrameNum: Integer read Get_FrameNum write Set_FrameNum;
property WMode: WideString read Get_WMode write Set_WMode;
property SAlign: WideString read Get_SAlign write Set_SAlign;
property Menu: WordBool read Get_Menu write Set_Menu;
property Base: WideString read Get_Base write Set_Base;
property Scale: WideString read Get_Scale write Set_Scale;
property DeviceFont: WordBool read Get_DeviceFont write Set_DeviceFont;
property EmbedMovie: WordBool read Get_EmbedMovie write Set_EmbedMovie;
property BGColor: WideString read Get_BGColor write Set_BGColor;
property Quality2: WideString read Get_Quality2 write Set_Quality2;
property SWRemote: WideString read Get_SWRemote write Set_SWRemote;
property FlashVars: WideString read Get_FlashVars write Set_FlashVars;
property AllowScriptAccess: WideString read Get_AllowScriptAccess write

Set_AllowScriptAccess;
property MovieData: WideString read Get_MovieData write Set_MovieData;
property InlineData: IUnknown read Get_InlineData write Set_InlineData;
property SeamlessTabbing: WordBool read Get_SeamlessTabbing write Set_SeamlessTabbing;
property Profile: WordBool read Get_Profile write Set_Profile;
property ProfileAddress: WideString read Get_ProfileAddress write Set_ProfileAddress;
property ProfilePort: Integer read Get_ProfilePort write Set_ProfilePort;
property AllowNetworking: WideString read Get_AllowNetworking write Set_AllowNetworking;
property AllowFullScreen: WideString read Get_AllowFullScreen write Set_AllowFullScreen;
end;

// *********************************************************************//
// DispIntf: IShockwaveFlashDisp
// Flags: (4416) Dual OleAutomation Dispatchable
// GUID: {D27CDB6C-AE6D-11CF-96B8-444553540000}
// *********************************************************************//
IShockwaveFlashDisp = dispinterface
['{D27CDB6C-AE6D-11CF-96B8-444553540000}']
property ReadyState: Integer readonly dispid -525;
property TotalFrames: Integer readonly dispid 124;
property Playing: WordBool dispid 125;
property Quality: SYSINT dispid 105;
property ScaleMode: SYSINT dispid 120;
property AlignMode: SYSINT dispid 121;
property BackgroundColor: Integer dispid 123;
property Loop: WordBool dispid 106;
property Movie: WideString dispid 102;
property FrameNum: Integer dispid 107;
procedure SetZoomRect(left: Integer; top: Integer; right: Integer; bottom: Integer);

dispid 109;
procedure Zoom(factor: SYSINT); dispid 118;
procedure Pan(x: Integer; y: Integer; mode: SYSINT); dispid 119;
procedure Play; dispid 112;
procedure Stop; dispid 113;
procedure Back; dispid 114;
procedure Forward; dispid 115;
procedure Rewind; dispid 116;
procedure StopPlay; dispid 126;
procedure GotoFrame(FrameNum: Integer); dispid 127;
function CurrentFrame: Integer; dispid 128;
function IsPlaying: WordBool; dispid 129;
function PercentLoaded: Integer; dispid 130;
function FrameLoaded(FrameNum: Integer): WordBool; dispid 131;
function FlashVersion: Integer; dispid 132;
property WMode: WideString dispid 133;
property SAlign: WideString dispid 134;
property Menu: WordBool dispid 135;
property Base: WideString dispid 136;
property Scale: WideString dispid 137;
property DeviceFont: WordBool dispid 138;
property EmbedMovie: WordBool dispid 139;
property BGColor: WideString dispid 140;
property Quality2: WideString dispid 141;
procedure LoadMovie(layer: SYSINT; const url: WideString); dispid 142;
procedure TGotoFrame(const target: WideString; FrameNum: Integer); dispid 143;
procedure TGotoLabel(const target: WideString; const label_: WideString); dispid 144;
function TCurrentFrame(const target: WideString): Integer; dispid 145;
function TCurrentLabel(const target: WideString): WideString; dispid 146;
procedure TPlay(const target: WideString); dispid 147;
procedure TStopPlay(const target: WideString); dispid 148;
procedure SetVariable(const name: WideString; const value: WideString); dispid 151;
function GetVariable(const name: WideString): WideString; dispid 152;
procedure TSetProperty(const target: WideString; property_: SYSINT; const value:

WideString); dispid 153;
function TGetProperty(const target: WideString; property_: SYSINT): WideString; dispid

154;
procedure TCallFrame(const target: WideString; FrameNum: SYSINT); dispid 155;
procedure TCallLabel(const target: WideString; const label_: WideString); dispid 156;
procedure TSetPropertyNum(const target: WideString; property_: SYSINT; value: Double);

dispid 157;
function TGetPropertyNum(const target: WideString; property_: SYSINT): Double; dispid

158;
function TGetPropertyAsNumber(const target: WideString; property_: SYSINT): Double;

dispid 172;
property SWRemote: WideString dispid 159;
property FlashVars: WideString dispid 170;
property AllowScriptAccess: WideString dispid 171;
property MovieData: WideString dispid 190;
property InlineData: IUnknown dispid 191;
property SeamlessTabbing: WordBool dispid 192;
procedure EnforceLocalSecurity; dispid 193;
property Profile: WordBool dispid 194;
property ProfileAddress: WideString dispid 195;
property ProfilePort: Integer dispid 196;
function CallFunction(const request: WideString): WideString; dispid 198;
procedure SetReturnValue(const returnValue: WideString); dispid 199;
procedure DisableLocalSecurity; dispid 200;
property AllowNetworking: WideString dispid 201;
property AllowFullScreen: WideString dispid 202;
end;

// *********************************************************************//
// DispIntf: _IShockwaveFlashEvents
// Flags: (4112) Hidden Dispatchable
// GUID: {D27CDB6D-AE6D-11CF-96B8-444553540000}
// *********************************************************************//
_IShockwaveFlashEvents = dispinterface
['{D27CDB6D-AE6D-11CF-96B8-444553540000}']
procedure OnReadyStateChange(newState: Integer); dispid -609;
procedure OnProgress(percentDone: Integer); dispid 1958;
procedure FSCommand(const command: WideString; const args: WideString); dispid 150;
procedure FlashCall(const request: WideString); dispid 197;
end;

// *********************************************************************//
// Interface: IFlashFactory
// Flags: (0)
// GUID: {D27CDB70-AE6D-11CF-96B8-444553540000}
// *********************************************************************//
IFlashFactory = interface(IUnknown)
['{D27CDB70-AE6D-11CF-96B8-444553540000}']
end;

// *********************************************************************//
// Interface: IDispatchEx
// Flags: (4096) Dispatchable
// GUID: {A6EF9860-C720-11D0-9337-00A0C90DCAA9}
// *********************************************************************//
IDispatchEx = interface(IDispatch)
['{A6EF9860-C720-11D0-9337-00A0C90DCAA9}']
function GetDispID(const bstrName: WideString; grfdex: LongWord; out pid: Integer):

HResult; stdcall;
function RemoteInvokeEx(id: Integer; lcid: LongWord; dwFlags: LongWord; var pdp:

DISPPARAMS;
out pvarRes: OleVariant; out pei: EXCEPINFO;
const pspCaller: IServiceProvider; cvarRefArg: SYSUINT;
var rgiRefArg: SYSUINT; var rgvarRefArg: OleVariant): HResult;

stdcall;
function DeleteMemberByName(const bstrName: WideString; grfdex: LongWord): HResult;

stdcall;
function DeleteMemberByDispID(id: Integer): HResult; stdcall;
function GetMemberProperties(id: Integer; grfdexFetch: LongWord; out pgrfdex: LongWord):

HResult; stdcall;
function GetMemberName(id: Integer; out pbstrName: WideString): HResult; stdcall;
function GetNextDispID(grfdex: LongWord; id: Integer; out pid: Integer): HResult;

stdcall;
function GetNameSpaceParent(out ppunk: IUnknown): HResult; stdcall;
end;

// *********************************************************************//
// Interface: IFlashObjectInterface
// Flags: (4096) Dispatchable
// GUID: {D27CDB72-AE6D-11CF-96B8-444553540000}
// *********************************************************************//
IFlashObjectInterface = interface(IDispatchEx)
['{D27CDB72-AE6D-11CF-96B8-444553540000}']
end;

// *********************************************************************//
// Interface: IServiceProvider
// Flags: (0)
// GUID: {6D5140C1-7436-11CE-8034-00AA006009FA}
// *********************************************************************//
IServiceProvider = interface(IUnknown)
['{6D5140C1-7436-11CE-8034-00AA006009FA}']
function RemoteQueryService(var guidService: TGUID; var riid: TGUID; out ppvObject:

IUnknown): HResult; stdcall;
end;


// *********************************************************************//
// OLE Control Proxy class declaration
// Control Name : TfeFlashPlayer
// Help String : Shockwave Flash
// Default Interface: IShockwaveFlash
// Def. Intf. DISP? : No
// Event Interface: _IShockwaveFlashEvents
// TypeFlags : (2) CanCreate
// *********************************************************************//
TfeFlashPlayerOnReadyStateChange = procedure(ASender: TObject; newState: Integer) of

object;
TfeFlashPlayerOnProgress = procedure(ASender: TObject; percentDone: Integer) of object;
TfeFlashPlayerFSCommand = procedure(ASender: TObject; const command: WideString;
const args: WideString) of object;
TfeFlashPlayerFlashCall = procedure(ASender: TObject; const request: WideString) of

object;

TfeFlashPlayer = class(TfeWndControl)
private
FOnReadyStateChange: TfeFlashPlayerOnReadyStateChange;
FOnProgress: TfeFlashPlayerOnProgress;
FOnFSCommand: TfeFlashPlayerFSCommand;
FOnFlashCall: TfeFlashPlayerFlashCall;
FIntf: IShockwaveFlash;
FFlashList: TfeFlashList;
FFlashIndex: integer;
function GetControlInterface: IShockwaveFlash;
procedure SetFlashList(const Value: TfeFlashList);
procedure SetFlashIndex(const Value: integer);
function GetIsFlashAvailable: boolean;
function GetIntegerProp(const Index: Integer): Integer;
function GetIUnknownProp(const Index: Integer): IUnknown;
function GetWideStringProp(const Index: Integer): WideString;
function GetWordBoolProp(const Index: Integer): WordBool;
procedure SetIntegerProp(const Index, Value: Integer);
procedure SetIUnknownProp(const Index: Integer; const Value: IUnknown);
procedure SetWideStringProp(const Index: Integer; const Value: WideString);
procedure SetWordBoolProp(const Index: Integer; const Value: WordBool);
protected
FStream: TMemoryStream;
FTmpFileName, FTmpFileName2: String;
procedure TransparentChanged; override;
procedure CreateControl;
procedure InitControlData; override;
function InitFlash(video: boolean = false): Boolean;
procedure DoneFlash;
function Get_InlineData: IUnknown;
procedure Set_InlineData(const ppIUnknown: IUnknown);
property WMode: WideString index 133 read GetWideStringProp write SetWideStringProp

stored False;
public
constructor Create(AOwner: TComponent); override;
destructor Destroy; override;
procedure SetZoomRect(left: Integer; top: Integer; right: Integer; bottom: Integer);
procedure Zoom(factor: SYSINT);
procedure Pan(x: Integer; y: Integer; mode: SYSINT);
procedure Play;
procedure Stop;
procedure Back;
procedure Forward;
procedure Rewind;
procedure StopPlay;
procedure GotoFrame(FrameNum: Integer);
function CurrentFrame: Integer;
function IsPlaying: WordBool;
function PercentLoaded: Integer;
function FrameLoaded(FrameNum: Integer): WordBool;
function FlashVersion: Integer;
procedure LoadMovie(layer: SYSINT; const url: WideString);
procedure LoadMovieFromStream(layer: SYSINT; const Stream: TStream);
procedure LoadMovieFromResource(layer: SYSINT; const ResName: WideString);
procedure TGotoFrame(const target: WideString; FrameNum: Integer);
procedure TGotoLabel(const target: WideString; const label_: WideString);
function TCurrentFrame(const target: WideString): Integer;
function TCurrentLabel(const target: WideString): WideString;
procedure TPlay(const target: WideString);
procedure TStopPlay(const target: WideString);
procedure SetVariable(const name: WideString; const value: WideString);
function GetVariable(const name: WideString): WideString;
procedure TSetProperty(const target: WideString; property_: SYSINT; const value:

WideString);
function TGetProperty(const target: WideString; property_: SYSINT): WideString;
procedure TCallFrame(const target: WideString; FrameNum: SYSINT);
procedure TCallLabel(const target: WideString; const label_: WideString);
procedure TSetPropertyNum(const target: WideString; property_: SYSINT; value: Double);
function TGetPropertyNum(const target: WideString; property_: SYSINT): Double;
function TGetPropertyAsNumber(const target: WideString; property_: SYSINT): Double;
property ControlInterface: IShockwaveFlash read GetControlInterface;
property DefaultInterface: IShockwaveFlash read GetControlInterface;
property ReadyState: Integer index -525 read GetIntegerProp;
property TotalFrames: Integer index 124 read GetIntegerProp;
property InlineData: IUnknown index 191 read GetIUnknownProp write SetIUnknownProp;
property IsFlashAvailable: boolean read GetIsFlashAvailable;
function CallFunction(const request: WideString): WideString;
published
property Anchors;
property Align;
property DragCursor;
property DragMode;
property ParentShowHint;
property PopupMenu;
property ShowHint;
property Visible;
property OnDragDrop;
property OnDragOver;
property OnEndDrag;
property OnStartDrag;
property Playing: WordBool index 125 read GetWordBoolProp write SetWordBoolProp stored

False;
property Quality: Integer index 105 read GetIntegerProp write SetIntegerProp stored

False;
property ScaleMode: Integer index 120 read GetIntegerProp write SetIntegerProp stored

False;
property AlignMode: Integer index 121 read GetIntegerProp write SetIntegerProp stored

False;
property BackgroundColor: Integer index 123 read GetIntegerProp write SetIntegerProp

stored False;
property Loop: WordBool index 106 read GetWordBoolProp write SetWordBoolProp stored

False;
property Movie: WideString index 102 read GetWideStringProp write SetWideStringProp

stored False;
property FrameNum: Integer index 107 read GetIntegerProp write SetIntegerProp stored

False;
property SAlign: WideString index 134 read GetWideStringProp write SetWideStringProp

stored False;
property Menu: WordBool index 135 read GetWordBoolProp write SetWordBoolProp stored

False;
property Base: WideString index 136 read GetWideStringProp write SetWideStringProp

stored False;
property Scale: WideString index 137 read GetWideStringProp write SetWideStringProp

stored False;
property DeviceFont: WordBool index 138 read GetWordBoolProp write SetWordBoolProp

stored False;
property EmbedMovie: WordBool index 139 read GetWordBoolProp write SetWordBoolProp

stored False;
property BGColor: WideString index 140 read GetWideStringProp write SetWideStringProp

stored False;
property Quality2: WideString index 141 read GetWideStringProp write SetWideStringProp

stored False;
property SWRemote: WideString index 159 read GetWideStringProp write SetWideStringProp

stored False;
property FlashVars: WideString index 170 read GetWideStringProp write SetWideStringProp

stored False;
property AllowScriptAccess: WideString index 171 read GetWideStringProp write

SetWideStringProp stored False;
property MovieData: WideString index 190 read GetWideStringProp write SetWideStringProp

stored False;
property SeamlessTabbing: WordBool index 192 read GetWordBoolProp write SetWordBoolProp

stored False;
property OnReadyStateChange: TfeFlashPlayerOnReadyStateChange read FOnReadyStateChange

write FOnReadyStateChange;
property OnProgress: TfeFlashPlayerOnProgress read FOnProgress write FOnProgress;
property OnFSCommand: TfeFlashPlayerFSCommand read FOnFSCommand write FOnFSCommand;
property OnFlashCall: TfeFlashPlayerFlashCall read FOnFlashCall write FOnFlashCall;
{ list }
property FlashList: TfeFlashList read FFlashList write SetFlashList;
property FlashIndex: integer read FFlashIndex write SetFlashIndex default -1;
end;

// *********************************************************************//
// The Class CoFlashProp provides a Create and CreateRemote method to
// create instances of the default interface IUnknown exposed by
// the CoClass FlashProp. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoFlashProp = class
class function Create: IUnknown;
class function CreateRemote(const MachineName: string): IUnknown;
end;

// *********************************************************************//
// The Class CoFlashObjectInterface provides a Create and CreateRemote method to
// create instances of the default interface IFlashObjectInterface exposed by
// the CoClass FlashObjectInterface. The functions are intended to be used by
// clients wishing to automate the CoClass objects exposed by the
// server of this typelibrary.
// *********************************************************************//
CoFlashObjectInterface = class
class function Create: IFlashObjectInterface;
class function CreateRemote(const MachineName: string): IFlashObjectInterface;
end;

implementation

uses ComObj;

const
play_swf : array [0..204] of char =

(



#67,#87,#83,#7,#16,#1,#0,#0,#120,#156,#69,#142,#59,#14,#130,#64,#20,#69,#47,#140,#192,#104,#

52,#84



,#134,#198,#218,#222,#194,#206,#68,#19,#122,#10,#252,#180,#102,#130,#99,#36,#225,#99,#204,#1

96



,#200,#14,#92,#1,#53,#11,#176,#183,#52,#46,#192,#53,#225,#27,#48,#50,#197,#187,#239,#157,#11

5,#139



,#185,#193,#218,#3,#110,#5,#12,#13,#248,#102,#93,#215,#75,#246,#6,#112,#223,#160,#143,#76,#4

2,#63



,#207,#50,#4,#109,#202,#72,#197,#121,#134,#168,#93,#181,#93,#171,#75,#170,#45,#165,#20,#41,#

210



,#226,#26,#31,#100,#14,#161,#148,#136,#78,#187,#102,#63,#198,#137,#12,#68,#42,#113,#78,#68,#

129



,#114,#4,#14,#27,#191,#199,#141,#213,#162,#228,#48,#29,#67,#31,#152,#148,#38,#184,#25,#122,#

101,#15



,#156,#233,#211,#65,#107,#122,#84,#35,#197,#58,#98,#53,#93,#155,#186,#20,#78,#199,#89,#195,#

121



,#232,#97,#233,#14,#8,#104,#88,#225,#70,#243,#101,#143,#105,#78,#13,#66,#159,#103,#61,#223,#

206,#30

,#255,#239,#174,#72,#124,#1,#225,#222,#56,#82

);


function TfeFlashPlayer.CallFunction(const request: WideString): WideString;
begin
if not FFlashNotExists then
Result := DefaultInterface.CallFunction(request);
end;

constructor TfeFlashPlayer.Create(AOwner: TComponent);
begin
inherited Create(AOwner);
FStream := TMemoryStream.Create;
FFlashIndex := -1;
WMode := 'Transparent';
CreateWnd;
end;

destructor TfeFlashPlayer.Destroy;
begin
DoneFlash;
FStream.Free;
inherited;
end;

procedure TfeFlashPlayer.InitControlData;
const
CEventDispIDs: array [0..3] of DWORD = (
$FFFFFD9F, $000007A6, $00000096, $000000C5);
CControlData: TControlData2 = (
ClassID: '{D27CDB6E-AE6D-11CF-96B8-444553540000}';
EventIID: '{D27CDB6D-AE6D-11CF-96B8-444553540000}';
EventCount: 4;
EventDispIDs: @CEventDispIDs;
LicenseKey: nil (*HR:$80004002*);
Flags: $00000000;
Version: 401);
begin
ControlData := @CControlData;
TControlData2(CControlData).FirstEventOfs := Cardinal(@@FOnReadyStateChange) - Cardinal

(Self);
end;

procedure TfeFlashPlayer.CreateControl;

procedure DoCreate;
begin
FIntf := IUnknown(OleObject) as IShockwaveFlash;
end;

begin
if FIntf = nil then DoCreate;
end;

procedure TfeFlashPlayer.TransparentChanged;
begin
{ if Transparent then
WMode := 'Transparent'
else
WMode := '';}
end;

function TfeFlashPlayer.GetControlInterface: IShockwaveFlash;
begin
CreateControl;
Result := FIntf;
end;

function TfeFlashPlayer.Get_InlineData: IUnknown;
begin
Result := DefaultInterface.InlineData;
end;

procedure TfeFlashPlayer.Set_InlineData(const ppIUnknown: IUnknown);
begin
if not FFlashNotExists then DefaultInterface.Set_InlineData(ppIUnknown);
end;

procedure TfeFlashPlayer.SetZoomRect(left: Integer; top: Integer; right: Integer; bottom:

Integer);
begin
if not FFlashNotExists then DefaultInterface.SetZoomRect(left, top, right, bottom);
end;

procedure TfeFlashPlayer.Zoom(factor: SYSINT);
begin
if not FFlashNotExists then DefaultInterface.Zoom(factor);
end;

procedure TfeFlashPlayer.Pan(x: Integer; y: Integer; mode: SYSINT);
begin
if not FFlashNotExists then DefaultInterface.Pan(x, y, mode);
end;

procedure TfeFlashPlayer.Play;
begin
if not FFlashNotExists then DefaultInterface.Play;
end;

procedure TfeFlashPlayer.Stop;
begin
if not FFlashNotExists then DefaultInterface.Stop;
end;

procedure TfeFlashPlayer.Back;
begin
if not FFlashNotExists then DefaultInterface.Back;
end;

procedure TfeFlashPlayer.Forward;
begin
if not FFlashNotExists then DefaultInterface.Forward;
end;

procedure TfeFlashPlayer.Rewind;
begin
if not FFlashNotExists then DefaultInterface.Rewind;
end;

procedure TfeFlashPlayer.StopPlay;
begin
if not FFlashNotExists then DefaultInterface.StopPlay;
end;

procedure TfeFlashPlayer.GotoFrame(FrameNum: Integer);
begin
if not FFlashNotExists then DefaultInterface.GotoFrame(FrameNum);
end;

function TfeFlashPlayer.CurrentFrame: Integer;
begin
Result := DefaultInterface.CurrentFrame;
end;

function TfeFlashPlayer.IsPlaying: WordBool;
begin
Result := DefaultInterface.IsPlaying;
end;

function TfeFlashPlayer.PercentLoaded: Integer;
begin
Result := DefaultInterface.PercentLoaded;
end;

function TfeFlashPlayer.FrameLoaded(FrameNum: Integer): WordBool;
begin
Result := DefaultInterface.FrameLoaded(FrameNum);
end;

function TfeFlashPlayer.FlashVersion: Integer;
begin
Result := DefaultInterface.FlashVersion;
end;

function TfeFlashPlayer.InitFlash(video: boolean = false): Boolean;
var
i, l: Integer;
fs: TFileStream;
saveFileName: string;
myFTmpFileName, myFTmpFileName2: string;
M: TMemoryStream;
begin
FTmpFileName2 := '';

Result := False;
try
if video then
begin
SetLength(FTmpFileName, 1000);
l := GetTempPath(1000, PChar(FTmpFileName));
SetLength(FTmpFileName,l);
if (Length(FTmpFileName)>0) and (FTmpFileName[Length(FTmpFileName)]<>'/') then
FTmpFileName := FTmpFileName+'/';
l := Random(1000);
while FileExists(FTmpFileName+IntToStr(l)+'.swf') do
inc(l);
FTmpFileName := FTmpFileName+IntToStr(l)+'.swf';
fs := TFileStream.Create(FTmpFileName, fmCreate);
M := TMemoryStream.Create;
M.Write(play_swf, sizeOf(play_swf));
M.Position := 0;
fs.CopyFrom(M, M.Size);
M.Free;
fs.Free;

saveFileName := FTmpFileName;

SetLength(FTmpFileName, 1000);
l := GetTempPath(1000, PChar(FTmpFileName));
SetLength(FTmpFileName,l);
if (Length(FTmpFileName)>0) and (FTmpFileName[Length(FTmpFileName)]<>'/') then
FTmpFileName := FTmpFileName+'/';
l := Random(1000);
while FileExists(FTmpFileName+IntToStr(l)+'.flv') do
inc(l);
FTmpFileName := FTmpFileName+IntToStr(l)+'.flv';
fs := TFileStream.Create(FTmpFileName, fmCreate);
FStream.Position := 0;
fs.CopyFrom(FStream, FStream.Size);
fs.Free;

FTmpFileName2 := saveFileName;

myFTmpFileName := FTmpFileName;
myFTmpFileName2 := FTmpFileName2;
for i := 1 to Length(myFTmpFileName) do
if myFTmpFileName = '/' then
myFTmpFileName := '/';
for i := 1 to Length(myFTmpFileName2) do
if myFTmpFileName2 = '/' then
myFTmpFileName2 := '/';

Movie := myFTmpFileName2 + '?' + 'fileName=' + myFTmpFileName;
end
else
begin
SetLength(FTmpFileName, 1000);
l := GetTempPath(1000, PChar(FTmpFileName));
SetLength(FTmpFileName,l);
if (Length(FTmpFileName)>0) and (FTmpFileName[Length(FTmpFileName)]<>'/') then
FTmpFileName := FTmpFileName+'/';
l := Random(1000);
while FileExists(FTmpFileName+IntToStr(l)+'.swf') do
inc(l);
FTmpFileName := FTmpFileName+IntToStr(l)+'.swf';
fs := TFileStream.Create(FTmpFileName, fmCreate);
FStream.Position := 0;
fs.CopyFrom(FStream, FStream.Size);
fs.Free;
Movie := FTmpFileName;
end;
Result := True;
except;
end;
end;

procedure TfeFlashPlayer.DoneFlash;
begin
Stop;
DeleteFile(FTmpFileName);
if FTmpFileName2 <> '' then
DeleteFile(FTmpFileName2);
FTmpFileName := '';
FTmpFileName2 := '';
end;

procedure TfeFlashPlayer.LoadMovie(layer: SYSINT; const url: WideString);
var
M: TMemoryStream;
l: Integer;
fs: TFileStream;
playFileName, url2: string;
i: integer;
begin
if FFlashNotExists then Exit;

if not FFlashNotExists then
begin
if Pos('.flv', url) > 0 then
begin
M := TMemoryStream.Create;
try
M.Write(play_swf, sizeOf(play_swf));
M.Position := 0;

SetLength(playFileName, 1000);
l := GetTempPath(1000, PChar(playFileName));
SetLength(playFileName, l);
if (Length(playFileName)>0) and (playFileName[Length(playFileName)]<>'/') then
playFileName := playFileName+'/';
l := Random(1000);
while FileExists(playFileName+IntToStr(l)+'.swf') do
inc(l);
playFileName := playFileName+IntToStr(l)+'.swf';
fs := TFileStream.Create(playFileName, fmCreate);
fs.CopyFrom(M, M.Size);
fs.Free;

for i := 1 to Length(playFileName) do
if playFileName = '/' then
playFileName := '/';
url2 := url;
for i := 1 to Length(url2) do
if url2 = '/' then
url2 := '/';

DefaultInterface.LoadMovie(layer, playFileName + '?fileName=' + url2);

deleteFile(playFileName);
finally
M.Free;
end;
end
else
begin
DefaultInterface.LoadMovie(layer, url);
end;
SetBounds(Left, Top, Width, Height);
end;
end;

procedure TfeFlashPlayer.LoadMovieFromStream(layer: SYSINT; const Stream: TStream);
var
Sign: array [1..3] of char;
begin
Stream.Position := 0;
Stream.Read(Sign, 3);
Stream.Position := 0;
if (Sign[1] = 'F') and (Sign[2] = 'L') and (Sign[3] = 'V') then
begin
FStream.SetSize(0);
Stream.Position := 0;
FStream.CopyFrom(Stream, Stream.Size);
FStream.Position := 0;
if FStream.Size > 0 then
begin
InitFlash(true);
SetBounds(Left, Top, Width, Height);
end;
end
else
begin
FStream.SetSize(0);
Stream.Position := 0;
FStream.CopyFrom(Stream, Stream.Size);
if FStream.Size > 0 then
begin
InitFlash;
SetBounds(Left, Top, Width, Height);
end;
end;
end;

procedure TfeFlashPlayer.LoadMovieFromResource(layer: SYSINT; const ResName: WideString);
var
R: TResourceStream;
begin
R := TResourceStream.Create(0, ResName, RT_RCDATA);
if R <> nil then
LoadMovieFromStream(layer, R);
R.Free;
end;

function TfeFlashPlayer.GetIntegerProp(const Index: Integer): Integer;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
Result := Temp.VInteger;
end;

function TfeFlashPlayer.GetIsFlashAvailable: boolean;
begin
Result := not FFlashNotExists;
end;

function TfeFlashPlayer.GetIUnknownProp(const Index: Integer): IUnknown;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
Result := IUnknown(Temp.VUnknown);
end;

procedure TfeFlashPlayer.SetFlashList(const Value: TfeFlashList);
begin
FFlashList := Value;
if FFlashList = nil then FFlashIndex := -1;
FlashIndex := FlashIndex;
end;

procedure TfeFlashPlayer.SetIntegerProp(const Index, Value: Integer);
var
Temp: TVarData;
begin
Temp.VType := varInteger;
Temp.VInteger := Value;
SetProperty(Index, Temp);
end;

procedure TfeFlashPlayer.SetIUnknownProp(const Index: Integer;
const Value: IUnknown);
var
Temp: TVarData;
begin
Temp.VType := VT_UNKNOWN;
Temp.VUnknown := Pointer(Value);
SetProperty(Index, Temp);
end;

procedure TfeFlashPlayer.SetFlashIndex(const Value: integer);
var
Flash: TMemoryStream;
begin
FFlashIndex := Value;
if (FFlashList <> nil) and (FFlashList.Flashs.Count > 0) and (FFlashIndex >= 0) then
begin
if FFlashIndex < 0 then FFlashIndex := 0;
if FFlashIndex >= FFlashList.Flashs.Count - 1 then
FFlashIndex := FFlashList.Flashs.Count - 1;

if FFlashList.Flashs.Items[FFlashIndex].Flash <> nil then
begin
Flash := FFlashList.Flashs.Items[FFlashIndex].Flash;
if Flash <> nil then
begin
LoadMovieFromStream(0, Flash);
end;
end;
end
else
if FFlashIndex < 0 then
begin

end;
end;

procedure TfeFlashPlayer.TGotoFrame(const target: WideString; FrameNum: Integer);
begin
if not FFlashNotExists then DefaultInterface.TGotoFrame(target, FrameNum);
end;

procedure TfeFlashPlayer.TGotoLabel(const target: WideString; const label_: WideString);
begin
if not FFlashNotExists then DefaultInterface.TGotoLabel(target, label_);
end;

function TfeFlashPlayer.TCurrentFrame(const target: WideString): Integer;
begin
Result := DefaultInterface.TCurrentFrame(target);
end;

function TfeFlashPlayer.TCurrentLabel(const target: WideString): WideString;
begin
Result := DefaultInterface.TCurrentLabel(target);
end;

procedure TfeFlashPlayer.TPlay(const target: WideString);
begin
if not FFlashNotExists then DefaultInterface.TPlay(target);
end;

procedure TfeFlashPlayer.TStopPlay(const target: WideString);
begin
if not FFlashNotExists then DefaultInterface.TStopPlay(target);
end;

procedure TfeFlashPlayer.SetVariable(const name: WideString; const value: WideString);
begin
if not FFlashNotExists then DefaultInterface.SetVariable(name, value);
end;

procedure TfeFlashPlayer.SetWideStringProp(const Index: Integer;
const Value: WideString);
var
Temp: TVarData;
begin
Temp.VType := varOleStr;
if Value <> '' then
Temp.VOleStr := PWideChar(Value)
else
Temp.VOleStr := nil;
SetProperty(Index, Temp);
end;

procedure TfeFlashPlayer.SetWordBoolProp(const Index: Integer;
const Value: WordBool);
var
Temp: TVarData;
begin
Temp.VType := varBoolean;
if Value then
Temp.VBoolean := WordBool(-1) else
Temp.VBoolean := WordBool(0);
SetProperty(Index, Temp);
end;

function TfeFlashPlayer.GetVariable(const name: WideString): WideString;
begin
Result := DefaultInterface.GetVariable(name);
end;

function TfeFlashPlayer.GetWideStringProp(const Index: Integer): WideString;
var
Temp: TVarData;
begin
Result := '';
GetProperty(Index, Temp);
Pointer(Result) := Temp.VOleStr;
end;

function TfeFlashPlayer.GetWordBoolProp(const Index: Integer): WordBool;
var
Temp: TVarData;
begin
GetProperty(Index, Temp);
Result := Temp.VBoolean;
end;

procedure TfeFlashPlayer.TSetProperty(const target: WideString; property_: SYSINT;
const value: WideString);
begin
if not FFlashNotExists then DefaultInterface.TSetProperty(target, property_, value);
end;

function TfeFlashPlayer.TGetProperty(const target: WideString; property_: SYSINT):

WideString;
begin
Result := DefaultInterface.TGetProperty(target, property_);
end;

procedure TfeFlashPlayer.TCallFrame(const target: WideString; FrameNum: SYSINT);
begin
if not FFlashNotExists then DefaultInterface.TCallFrame(target, FrameNum);
end;

procedure TfeFlashPlayer.TCallLabel(const target: WideString; const label_: WideString);
begin
if not FFlashNotExists then DefaultInterface.TCallLabel(target, label_);
end;

procedure TfeFlashPlayer.TSetPropertyNum(const target: WideString; property_: SYSINT; value:

Double);
begin
if not FFlashNotExists then DefaultInterface.TSetPropertyNum(target, property_, value);
end;

function TfeFlashPlayer.TGetPropertyNum(const target: WideString; property_: SYSINT):

Double;
begin
Result := DefaultInterface.TGetPropertyNum(target, property_);
end;

function TfeFlashPlayer.TGetPropertyAsNumber(const target: WideString; property_: SYSINT):

Double;
begin
Result := DefaultInterface.TGetPropertyAsNumber(target, property_);
end;

class function CoFlashProp.Create: IUnknown;
begin
Result := CreateComObject(CLASS_FlashProp) as IUnknown;
end;

class function CoFlashProp.CreateRemote(const MachineName: string): IUnknown;
begin
Result := CreateRemoteComObject(MachineName, CLASS_FlashProp) as IUnknown;
end;

class function CoFlashObjectInterface.Create: IFlashObjectInterface;
begin
Result := CreateComObject(CLASS_FlashObjectInterface) as IFlashObjectInterface;
end;

class function CoFlashObjectInterface.CreateRemote(const MachineName: string):

IFlashObjectInterface;
begin
Result := CreateRemoteComObject(MachineName, CLASS_FlashObjectInterface) as

IFlashObjectInterface;
end;

end.
 
白

白河愁

Unregistered / Unconfirmed
GUEST, unregistred user!
看上去不错，虽然对 COM 不感冒，还是支持一下。
 
B

ball_cao

Unregistered / Unconfirmed
GUEST, unregistred user!
看来这个问题比较生僻 结束了
 
Q

QSmile

Unregistered / Unconfirmed
GUEST, unregistred user!
非常感謝
 
您必须登录或注册才可回复。

Similar threads

I
提高分布式多层系统的效率之二（Pooler）
回复
0
查看
682
import
I
I
关于类似UltraEdit的文件改变监视
回复
0
查看
539
import
I
I
OLE和Office的事件关联
回复
0
查看
594
import
I
I
利用Delphi编写IE扩展
回复
0
查看
622
import
I
I
一个热键控件
回复
0
查看
601
import
I
顶部