Files
2014-10-17 20:37:47 +02:00

549 lines
13 KiB
ObjectPascal

unit uMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, OleCtrls, ShockwaveFlashObjects_TLB, StdCtrls, ExtCtrls;
type
TfrmMain = class(TForm)
tmrWatchDog: TTimer;
procedure FormActivate(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
procedure tmrWatchDogTimer(Sender: TObject);
private
procedure NoRightClick(var Msg:TMsg; var handled:Boolean);
public
{ Public declarations }
end;
type
TMySWF = class(TShockwaveFlash)
public
procedure CreateWnd; override;
end;
type
TPipeThread = class(TThread)
protected
flashFile: string;
w: integer;
h: integer;
bgColor: integer;
bgTColor: TColor;
zoom: integer;
scalemode: integer;
quality: integer;
procedure Execute; override;
procedure displaySWF;
procedure freeSWF;
procedure setPos;
procedure setBGColor;
procedure setZoom;
procedure setQuality;
procedure setScalemode;
end;
TBuf = array[0..255] of byte;
var
frmMain: TfrmMain;
k: string;
t: TPipeThread;
flaPreview: TMySWF;
target: HWND = 0;
clicked: integer = 0;
xpos : integer = 0;
ypos : integer = 0;
implementation
{$R *.dfm}
procedure TfrmMain.NoRightClick(var Msg:TMsg; var handled:Boolean);
begin
if((Msg.message = WM_LBUTTONDOWN) and (Msg.wParam = MK_LBUTTON)) then
begin
clicked := 1;
xpos := LOWORD(Msg.lParam);
ypos := HIWORD(Msg.lParam);
end;
if((Msg.message = WM_RBUTTONDOWN) and (Msg.wParam = MK_RBUTTON)) then
begin
clicked := 2;
xpos := LOWORD(Msg.lParam);
ypos := HIWORD(Msg.lParam);
handled := true;
end
else
handled := false;
end;
procedure TMySWF.CreateWnd;
begin
inherited;
end;
function arrToStr(k: TBuf; len: integer): string;
var
s: string;
i: integer;
begin
s := '';
for i := 0 to len - 1 do
begin
if k[i] = 0 then
break;
s := s + '' + chr(k[i]);
end;
Result := s;
end;
procedure ReadPipe(pipe: cardinal; var buffer: TBuf; bytesToRead: cardinal);
var
numBytesRead: DWORD;
readResult: longbool;
begin
numBytesRead := 0;
readResult := ReadFile(pipe, buffer, bytesToRead, numBytesRead, nil);
if (not readResult) or (numBytesRead <> bytesToRead) then
begin
Application.Terminate;
end;
end;
procedure WritePipe(pipe: cardinal; var buffer: TBuf; bytesToWrite: cardinal);
var
written: cardinal;
writeResult: longbool;
begin
written := 0;
writeResult := WriteFile(pipe, buffer, bytesToWrite, written, nil);
if (not writeResult) or (written <> bytesToWrite) then
begin
Application.Terminate;
end;
end;
procedure TPipeThread.freeSWF();
begin
if Assigned(flaPreview) then
begin
try
flaPreview.Stop;
flaPreview.Movie := '';
flaPreview.Free;
flaPreview := nil;
except
on E: Exception do
begin
end;
end;
end;
end;
procedure TPipeThread.displaySWF();
begin
Windows.SetParent(frmMain.Handle, target);
freeSWF();
flaPreview := TMySWF.Create(frmMain);
flaPreview.Left := 0;
flaPreview.Top := 0;
flaPreview.Width := self.w;
flaPreview.Height := self.h;
frmMain.Caption := 'set movie:' + flashFile;
flaPreview.Parent := frmMain;
flaPreview.Movie := flashFile;
flaPreview.SetFocus;
end;
procedure TPipeThread.setBGColor();
begin
flaPreview.BackgroundColor := self.bgColor;
frmMain.Color := self.bgTColor;
end;
procedure TPipeThread.setPos();
begin
SetWindowPos(frmMain.Handle, 0, 0, 0, self.w, self.h, SWP_SHOWWINDOW);
flaPreview.Left := 0;
flaPreview.Top := 0;
flaPreview.Width := self.w;
flaPreview.Height := self.h;
flaPreview.CreateWnd;
end;
procedure TPipeThread.setZoom();
begin
flaPreview.Zoom(self.zoom);
end;
procedure TPipeThread.setQuality();
begin
flaPreview.Quality := self.quality;
end;
procedure TPipeThread.setScalemode();
begin
flaPreview.ScaleMode := self.scalemode;
end;
procedure TPipeThread.Execute();
var
pipe: cardinal;
buffer: TBuf;
pipename: PAnsiChar;
len: integer;
cmd: integer;
val: cardinal;
vals: string;
vars: string;
const
CMD_PLAY = 1;
CMD_RESIZE = 2;
CMD_BGCOLOR = 3;
CMD_CURRENT_FRAME = 4;
CMD_TOTAL_FRAMES = 5;
CMD_PAUSE = 6;
CMD_RESUME = 7;
CMD_PLAYING = 8;
CMD_REWIND = 9;
CMD_GOTO = 10;
CMD_CALL = 11;
CMD_GETVARIABLE = 12;
CMD_SETVARIABLE = 13;
CMD_CHECKCLICK = 14;
CMD_ZOOM = 15;
CMD_SET_QUALITY = 16;
CMD_SET_SCALEMODE = 17;
begin
try
pipename := PAnsiChar('\\.\\pipe\ffdec_flashplayer_' + ParamStr(1));
begin
pipe := CreateFile(pipename, GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, FILE_ATTRIBUTE_NORMAL, 0);
repeat
try
ReadPipe(pipe, buffer, 1);
cmd := buffer[0];
case cmd of
CMD_SET_QUALITY:
begin
ReadPipe(pipe, buffer, 1);
self.quality := buffer[0];
Synchronize(setQuality);
end;
CMD_SET_SCALEMODE:
begin
ReadPipe(pipe, buffer, 1);
self.scalemode := buffer[0];
Synchronize(setScalemode);
end;
CMD_CHECKCLICK:
begin
buffer[0]:=clicked;
len := 1;
if clicked>0 then
begin
len := len + 4;
buffer[1] := (xpos shr 8) mod 256;
buffer[2] := xpos mod 256;
buffer[3] := (ypos shr 8) mod 256;
buffer[4] := ypos mod 256;
end;
clicked := 0;
xpos := 0;
ypos := 0;
WritePipe(pipe,buffer,len);
end;
CMD_ZOOM:
begin
ReadPipe(pipe, buffer, 2);
self.zoom := buffer[0] * 256 + buffer[1];
Synchronize(setZoom);
end;
CMD_PLAY:
begin
ReadPipe(pipe, buffer, 1);
len := buffer[0];
ReadPipe(pipe, buffer, len);
self.flashFile := arrToStr(buffer, len);
try
Synchronize(displaySWF);
except
on E: Exception do
begin
freeSWF();
end;
end;
end;
CMD_RESIZE:
begin
ReadPipe(pipe, buffer, 4);
self.w := buffer[0] * 256 + buffer[1];
self.h := buffer[2] * 256 + buffer[3];
Synchronize(setPos);
end;
CMD_BGCOLOR:
begin
ReadPipe(pipe, buffer, 3);
self.bgColor := (buffer[0] shl 16)+(buffer[1] shl 8)+(buffer[2]);
self.bgTColor := RGB(buffer[0],buffer[1],buffer[2]);
Synchronize(setBGColor);
end;
CMD_CURRENT_FRAME:
begin
val := 0;
try
if flaPreview.ReadyState = 4 then
val := flaPreview.CurrentFrame
except
on E: Exception do
begin
freeSWF();
end;
end;
buffer[0] := (val shr 8) mod 256;
buffer[1] := val mod 256;
WritePipe(pipe, buffer, 2);
end;
CMD_TOTAL_FRAMES:
begin
val := 0;
try
if flaPreview.ReadyState = 4 then
val := flaPreview.TotalFrames
except
on E: Exception do
begin
freeSWF();
end;
end;
buffer[0] := (val shr 8) mod 256;
buffer[1] := val mod 256;
WritePipe(pipe, buffer, 2);
end;
CMD_PAUSE:
begin
try
flaPreview.Stop;
except
on E: Exception do
begin
freeSWF();
end;
end;
end;
CMD_RESUME:
begin
try
flaPreview.Play;
except
on E: Exception do
begin
freeSWF();
end;
end;
end;
CMD_PLAYING:
begin
buffer[0] := 0;
try
if flaPreview.ReadyState = 4 then
if flaPreview.IsPlaying then
buffer[0] := 1;
except
on E: Exception do
begin
freeSWF();
end;
end;
WritePipe(pipe, buffer, 1);
end;
CMD_REWIND:
begin
try
flaPreview.Rewind;
except
on E: Exception do
begin
freeSWF();
end;
end;
end;
CMD_GOTO:
begin
ReadPipe(pipe, buffer, 2);
val := (buffer[0] shl 8) + buffer[1];
try
flaPreview.GotoFrame(val);
except
on E: Exception do
begin
freeSWF();
end;
end;
end;
CMD_CALL:
begin
ReadPipe(pipe, buffer, 2);
val := (buffer[0] shl 8) + buffer[1];
ReadPipe(pipe, buffer, val);
SetString(vals, PChar(Addr(buffer)), val);
try
vals := flaPreview.CallFunction(vals);
except
on E: Exception do
begin
vals := '';
freeSWF();
end;
end;
val := length(vals);
buffer[0] := (val shr 8) mod 256;
buffer[1] := val mod 256;
WritePipe(pipe, buffer, 2);
Move(vals[1], buffer, val);
WritePipe(pipe, buffer, val);
end;
CMD_GETVARIABLE:
begin
ReadPipe(pipe, buffer, 2);
val := (buffer[0] shl 8) + buffer[1];
ReadPipe(pipe, buffer, val);
SetString(vals, PChar(Addr(buffer)), val);
try
vals := flaPreview.GetVariable(vals);
except
on E: Exception do
begin
vals := '';
freeSWF();
end;
end;
val := length(vals);
buffer[0] := (val shr 8) mod 256;
buffer[1] := val mod 256;
WritePipe(pipe, buffer, 2);
Move(vals[1], buffer, val);
WritePipe(pipe, buffer, val);
end;
CMD_SETVARIABLE:
begin
ReadPipe(pipe, buffer, 2);
val := (buffer[0] shl 8) + buffer[1];
ReadPipe(pipe, buffer, val);
SetString(vars, PChar(Addr(buffer)), val);
ReadPipe(pipe, buffer, 2);
val := (buffer[0] shl 8) + buffer[1];
ReadPipe(pipe, buffer, val);
SetString(vals, PChar(Addr(buffer)), val);
try
flaPreview.SetVariable(vars, vals);
except
on E: Exception do
begin
freeSWF();
end;
end;
end;
end;
except
on E: Exception do
begin
freeSWF();
end;
end;
until False;
CloseHandle(pipe);
end;
except
on E: Exception do
begin
end;
end;
end;
procedure TfrmMain.FormActivate(Sender: TObject);
begin
if (ParamCount >= 2) then
begin
flaPreview.Parent := frmMain;
ShowWindow(Application.Handle, SW_HIDE);
SetWindowLong(Application.Handle, GWL_EXSTYLE,
getWindowLong(Application.Handle, GWL_EXSTYLE) or WS_EX_TOOLWINDOW);
ShowWindow(Application.Handle, SW_SHOW);
SetForegroundWindow(HWND(StrToInt(ParamStr(2))));
frmMain.Caption := 'FlashPlayerWindow_' + ParamStr(2);
Application.Title := 'FlashPlayerWindow_' + ParamStr(2);
target := HWND(StrToInt(ParamStr(1)));
SetWindowLong(frmMain.Handle, GWL_STYLE, 0);
ShowWindow(frmMain.Handle, SW_SHOW);
frmMain.Left := 0;
frmMain.Top := 0;
Windows.SetParent(frmMain.Handle, target);
t := TPipeThread.Create(True);
t.Resume;
end;
end;
procedure TfrmMain.FormCreate(Sender: TObject);
begin
if (ParamCount >= 2) then
begin
Application.OnMessage := NoRightClick;
try
flaPreview := TMySWF.Create(frmMain);
flaPreview.Scale := 'noscale';
flaPreview.WMode := 'direct';
flaPreview.Menu := false;
flaPreview.AllowScriptAccess := 'always';
flaPreview.BackgroundColor := -1;
except
Application.Terminate;
end;
end;
end;
procedure TfrmMain.FormDestroy(Sender: TObject);
begin
t.Free;
end;
procedure TfrmMain.tmrWatchDogTimer(Sender: TObject);
begin
if target <> 0 then
begin
if not IsWindow(target) then
begin
Application.Terminate;
end;
end;
end;
end.