Finally fixes the freezes in Windows

git-svn-id: https://svn.code.sf.net/p/lazarus-ccr/svn@2080 8e941d3f-bd1b-0410-a28a-d453659cc2b4
This commit is contained in:
sekelsenmat 2011-10-18 09:16:42 +00:00
parent b39e1cce61
commit f2b3539ab5
2 changed files with 34 additions and 22 deletions

View File

@ -18,7 +18,7 @@
<AutoIncrementBuild Value="True"/> <AutoIncrementBuild Value="True"/>
<MinorVersionNr Value="3"/> <MinorVersionNr Value="3"/>
<RevisionNr Value="5"/> <RevisionNr Value="5"/>
<BuildNr Value="746"/> <BuildNr Value="748"/>
<StringTable ProductVersion="0.3.5.737"/> <StringTable ProductVersion="0.3.5.737"/>
</VersionInfo> </VersionInfo>
<BuildModes Count="2"> <BuildModes Count="2">

View File

@ -22,7 +22,10 @@ unit mplayer;
interface interface
uses uses
Classes, SysUtils, playerclass, process, debug, functions; //{$ifdef Windows}
//Windows,
//{$endif}
Classes, SysUtils, Forms, playerclass, process, debug, functions;
type type
@ -33,6 +36,7 @@ type
FMPlayerPath: string; FMPlayerPath: string;
MPlayerProcess: TProcess; MPlayerProcess: TProcess;
FLastGet_Pos: integer; FLastGet_Pos: integer;
MPlayerFormatSettings: TFormatSettings;
procedure SendCommand(cmd:string); procedure SendCommand(cmd:string);
function GetProcessOutput:string; function GetProcessOutput:string;
function GetMPlayerPlaying: boolean; function GetMPlayerPlaying: boolean;
@ -94,38 +98,43 @@ const MPLAYER_BINARY='mplayer.exe';
{ TMPlayerClass } { TMPlayerClass }
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
procedure TMPlayerClass.SendCommand(cmd: string); procedure TMPlayerClass.SendCommand(cmd: string);
var
res: DWORD;
begin begin
DebugOutLn('[TMPlayerClass.sendcommand] START cmd=' + cmd, 3); DebugOutLn('[TMPlayerClass.sendcommand] START cmd=' + cmd, 3);
cmd:=cmd+#10; //MPLayer always needs #10 as Lineending, no matter if win32 or linux cmd:=cmd+#10; //MPLayer always needs #10 as Lineending, no matter if win32 or linux
try try
if GetMPlayerPlaying then if GetMPlayerPlaying then
begin begin
DebugOutLn('[TMPlayerClass.sendcommand] 2', 3); //DebugOutLn('[TMPlayerClass.sendcommand] 2', 3);
MPlayerProcess.Input.write(cmd[1], length(cmd)); MPlayerProcess.Input.write(cmd[1], length(cmd));
//Windows.WriteFile(MPlayerProcess.Input.Handle,cmd[1],length(cmd), res, nil);
end; end;
DebugOutLn('[TMPlayerClass.sendcommand] 3', 3); DebugOutLn('[TMPlayerClass.sendcommand] END', 3);
except except
DebugOutLn('EXCEPTION sending command to mplayer', 3); DebugOutLn('EXCEPTION sending command to mplayer', 3);
end; end;
end; end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
function TMPlayerClass.GetProcessOutput: string; function TMPlayerClass.GetProcessOutput: string;
var AStringList: TStringList; var
AStringList: TStringList;
begin begin
// writeln('getoutput'); // writeln('getoutput');
AStringList:=TStringList.Create; AStringList:=TStringList.Create;
try try
if GetMPlayerPlaying then AStringList.LoadFromStream(MPlayerProcess.Output); if GetMPlayerPlaying then AStringList.LoadFromStream(MPlayerProcess.Output);
if AStringList.Count>0 then if AStringList.Count>0 then
Result:=AStringList.Strings[0] Result:=AStringList.Text//Strings[0]
else else
Result := ''; Result := '';
// writeln(Result); // writeln(Result);
except except
writeln('EXCEPTION reading mplayer output');result:=''; writeln('EXCEPTION reading mplayer output');result:='';
end; end;
//writeln('endget'); //writeln('endget');
AStringList.Free; AStringList.Free;
DebugOutLn('[TMPlayerClass.GetProcessOutput] Result=' + Result, 3);
end; end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
@ -145,6 +154,8 @@ begin
inherited; inherited;
FMPlayerPath := GetMPlayerPath(); FMPlayerPath := GetMPlayerPath();
MPlayerFormatSettings := SysUtils.DefaultFormatSettings;
MPlayerFormatSettings.DecimalSeparator := '.';
end; end;
//+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ //+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
destructor TMPlayerClass.destroy; destructor TMPlayerClass.destroy;
@ -182,6 +193,7 @@ end;
function TMPlayerClass.play(index: integer): byte; function TMPlayerClass.play(index: integer): byte;
var var
MPOptions: String; MPOptions: String;
i: Integer;
begin begin
DebugOutLn('[TMPlayerClass.play]', 3); DebugOutLn('[TMPlayerClass.play]', 3);
if (index<Playlist.ItemCount) and (index>=0) then if (index<Playlist.ItemCount) and (index>=0) then
@ -212,7 +224,7 @@ begin
DebugOutLn(MPlayerProcess.CommandLine,5); DebugOutLn(MPlayerProcess.CommandLine,5);
FLastGet_Pos:=0; FLastGet_Pos:=0;
MPlayerProcess.Options:= MPlayerProcess.Options + [poUsePipes, poDefaultErrorMode, poStderrToOutPut, poNoConsole]; MPlayerProcess.Options:= MPlayerProcess.Options + [poUsePipes, poDefaultErrorMode{, poStderrToOutPut}, poNoConsole];
MPlayerProcess.Execute; MPlayerProcess.Execute;
if MPlayerProcess.Running then if MPlayerProcess.Running then
@ -361,7 +373,7 @@ begin
until (pos('time_pos', tmps)>0) or (i>=3); until (pos('time_pos', tmps)>0) or (i>=3);
i:=LastDelimiter('=', tmps); i:=LastDelimiter('=', tmps);
if i > 0 then begin if i > 0 then begin
time:= StrToFloat(Copy(tmps, i+1, Length(tmps))); time:= StrToFloat(Copy(tmps, i+1, Length(tmps)), MPlayerFormatSettings);
time:=time*1000; time:=time*1000;
result:=round(time); result:=round(time);
end else result:=-1; end else result:=-1;
@ -398,7 +410,7 @@ begin
sleep(8); sleep(8);
tmps:=GetProcessOutput; tmps:=GetProcessOutput;
inc(i); inc(i);
DebugOutLn('[TMPlayerClass.Get_FilePosition] ' + tmps, 3); DebugOutLn('[TMPlayerClass.Get_FilePosition] GetProcessOutput=' + tmps, 3);
until (pos('percent_pos', tmps)>0) or (i>=5); until (pos('percent_pos', tmps)>0) or (i>=5);
// writeln('getpos'); // writeln('getpos');