[Lev]

Originally Posted by Corvax

Hi,
I've got the same problem in Borland Delphi 5, 7: when send message with BSP_seek > 214748 - nothing happens.
I use BSPlayer version 0.85 build 492, 11. Nov, 2002.

Developers, any ideas? ;)

P.S. I thought that this bug would fixed in build 492.

Waiting for your raply (or fixing in next build).
Thanks a lot!
BSPlayer rulezz! :) But some bug must gone away... :)

YES!!! Now I have solved this problem!
This problem is in BPlayer version 0.85 build 492, 11. Nov, 2002.
in address: $4C0ED4
In this address we have two commands:

IMUL EAX, [EBX + 8], 2710H
CDQ

these commands mul milliseconds ([EBX + 8]) on 2710.
but it mul work incorrectly.
I replace these commands to three:
mov eax, [ebx+8]
movzx edx, al
xor al, al

And all work! But now we must send to BSPlayer not milliseconds, see example:

procedure TForm1.SeekTo(Position: Cardinal);// Milliseconds, real: (+- 256)
var i: Int64;
j: Cardinal;
begin
i := Int64(Position) * $2710;
j := (i and $FFFFFF00) + (i shr 32);
SendMessage(bsp_hand, WM_BSP_CMD, BSP_Seek, j);
end;

For patch BSPlayer I use WriteProcess.
You can see full example below, it tested on Windows 2000, Delphi 5, and
BPlayer version 0.85 build 492, 11. Nov, 2002.
----------------------------------------------------------------------------------------

unit Unit1;

interface

uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
StdCtrls, ExtCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
bsp_hand: HWND;
PHandle: HWND;
function RunPlayer(const PlayerStr, FileStr: string): Boolean;
procedure SeekTo(Position: Cardinal);// Milliseconds, real: (+- 256)
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.DFM}

uses bsp;

procedure TForm1.Button1Click(Sender: TObject);
begin
SeekTo(60*60*1000);
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
RunPlayer('c:\Program Files\BSPlayer\bplay.exe', 'd:\v\Harley.avi');
end;

procedure TForm1.SeekTo(Position: Cardinal);// Milliseconds, real: (+- 256)
var i: Int64;
j: Cardinal;
begin
i := Int64(Position) * $2710;
j := (i and $FFFFFF00) + (i shr 32);
SendMessage(bsp_hand, WM_BSP_CMD, BSP_Seek, j);
end;

function TForm1.RunPlayer(const PlayerStr, FileStr: string): Boolean;
const
Patch: array[0..1] of Cardinal = ($0F08438B, $C030D0B6);
// mov eax, [ebx+8] //3
// movzx edx, al //3
// xor al, al //2
var
SInf: STARTUPINFO;
PInf:PROCESS_INFORMATION;
BytesCount: Cardinal;
Buf: array[0..1] of Cardinal;
RunStr: PChar;
T: TDateTime;
begin
Result := False;
if PHandle <> 0 then
exit;
GetMem(RunStr, Length(PlayerStr) + Length(FileStr) + 6);
try
StrPCopy(RunStr,'"' + PlayerStr + '" "' + FileStr + '"');
FillChar(SInf, SizeOf(SInf), 0);
SInf.cb := SizeOf(SInf);
if not CreateProcess(nil, RunStr, nil, nil, FALSE, CREATE_NEW_CONSOLE, nil,
nil, SInf, PInf) then
begin
ShowMessage('Failed to run: ' + RunStr);
exit;
end;
PHandle := OpenProcess(PROCESS_ALL_ACCESS, False, PInf.dwProcessId);
if PHandle = 0 then begin
ShowMessage('Failed to open running process: ' + RunStr);
exit;
end;
T := Time;
repeat
bsp_hand := FindWindow('BSPlayer', nil);
Application.ProcessMessages;
if Time - T > 1/24/60 then begin
ShowMessage('Cannot find window for process: ' + RunStr);
exit;
end;
until bsp_hand <> 0;
if not ReadProcessMemory(PHandle, Pointer($4C0ED4), @Buf, 8, BytesCount)
then begin
ShowMessage('Failed to read process memory: ' + RunStr);
exit;
end;
if BytesCount <> 8 then begin
ShowMessage('Failed to read process memory: ' + RunStr);
exit;
end;
if (Buf[0] <> $10084369) and (Buf[1] <> $99000027) then begin
ShowMessage('Required only BSPlayer version 0.85 (C) 2000-2002 BST'+
#13#10'Build 492, 11 Nov, 2002.');
exit;
end;
if not WriteProcessMemory(PHandle, Pointer($4C0ED4), @Patch, 8, BytesCount)
then begin
ShowMessage('Failed to write process memory: ' + RunStr);
exit;
end;
if BytesCount <> 8 then begin
ShowMessage('Failed to write process memory: ' + RunStr);
exit;
end;
Result := True;
finally
FreeMem(RunStr);
end;
end;

procedure TForm1.FormCreate(Sender: TObject);
begin
PHandle := 0;
end;

procedure TForm1.FormDestroy(Sender: TObject);
begin
if PHandle = 0 then
exit;
TerminateProcess(PHandle, 0);
end;

end.