core.pas

拍摄程序,用来控制摄像机拍摄照片。拍摄程序,用来控制摄像机拍摄照片。拍摄程序,用来控制摄像机拍摄照片。

{   MPUI, an MPlayer frontend for Windows
    Copyright (C) 2005 Martin J. Fiedler <[e-mail]>

    This program is free software; you can redistribute it and/or modify
    it under the terms of the GNU General Public License as published by
    the Free Software Foundation; either version 2 of the License, or
    (at your option) any later version.

    This program is distributed in the hope that it will be useful,
    but WITHOUT ANY WARRANTY; without even the implied warranty of
    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
    GNU General Public License for more details.

    You should have received a copy of the GNU General Public License
    along with this program; if not, write to the Free Software
    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
}
unit Core;
interface
uses Windows, SysUtils, Classes, Forms, Menus, Controls, Dialogs;

const OSDFont='Arial.ttf';

type TStatus=(sNone,sOpening,sClosing,sPlaying,sPaused,sStopped,sError);
var Status:TStatus;

type TWin9xWarnLevel=(wlWarn,wlReject,wlAccept);
var Win9xWarnLevel:TWin9xWarnLevel;

var HomeDir:string;
var MediaURL:string;
    DisplayURL:string;
    FirstOpen:boolean;
    AutoPlay:boolean;
var AudioID:integer;
    SubID:integer;
var AudioOut:integer;
    AudioDev:integer;
    Postproc:integer;
    Deinterlace:integer;
    Aspect:integer;
    ReIndex:boolean;
    SoftVol:boolean;
    PriorityBoost:boolean;
    Params:string;
    Duration:string;
var HaveAudio,HaveVideo:boolean;
    NativeWidth,NativeHeight:integer;
    PercentPos:integer;
    SecondPos:integer;
    OSDLevel:integer;
var Volume:integer;
    Mute:boolean;
    LastVolume:integer;

var StreamInfo:record
      FileName, FileFormat, PlaybackTime: string;
      Video:record
        Decoder, Codec: string;
        Bitrate, Width, Height: integer;
        FPS, Aspect: real;
      end;
      Audio:record
        Decoder, Codec: string;
        Bitrate, Rate, Channels: integer;
      end;
      ClipInfo:array[0..9]of record
        Key, Value: string;
      end;
    end;

function SecondsToTime(Seconds:integer):string;
function EscapeParam(const Param:string):string;
procedure Init;
procedure Start;
procedure Stop;
procedure Restart;
procedure ForceStop;
function Running:boolean;
procedure Terminate;
procedure SendCommand(Command:string);
procedure SendVolumeChangeCommand(Volume:integer);
procedure SetOSDLevel(Level:integer);
procedure ResetStreamInfo;

implementation
uses Main,Log,plist,Info;

type TClientWaitThread=class(TThread)
                         private procedure ClientDone;
                         protected procedure Execute; override;
                         public hProcess:Cardinal;
                       end;
type TProcessor=class(TThread)
                  private Data:string;
                  private procedure Process;
                  protected procedure Execute; override;
                  public hPipe:Cardinal;
                end;

var ClientWaitThread:TClientWaitThread;
    Processor:TProcessor;
    ClientProcess,ReadPipe,WritePipe:Cardinal;
    FirstChance:boolean;
    ExplicitStop:boolean;
    ExitCode:DWORD;
    FontPath:string;
    LastLine:string;
    LineRepeatCount:integer;
    LastCacheFill:string;

procedure HandleInputLine(Line:string); forward;
procedure HandleIDLine(ID, Content: string); forward;


function SplitLine(var Line:string):string;
var i:integer;
begin
  i:=Pos(#32,Line);
  if (length(Line)<72) OR (i<1) then begin
    Result:=Line;
    Line:='';
    exit;
  end;
  if(i>71) then begin
    Result:=Copy(Line,1,i-1);
    Delete(Line,1,i);
    exit;
  end;
  i:=72; while Line[i]<>#32 do dec(i);
  Result:=Copy(Line,1,i-1);
  Delete(Line,1,i);
end;

function EscapeParam(const Param:string):string;
begin
  if Pos(#32,Param)>0 then Result:=#34+Param+#34 else Result:=Param;
end;

function SecondsToTime(Seconds:integer):string;
var m,s:integer;
begin
  if Seconds<0 then Seconds:=0;
  m:=(Seconds DIV 60) MOD 60;
  s:= Seconds MOD 60;
  Result:=IntToStr(Seconds DIV 3600)
          +':'+char(48+m DIV 10)+char(48+m MOD 10)
          +':'+char(48+s DIV 10)+char(48+s MOD 10);
end;


procedure Init;
var WinDir:array[0..MAX_PATH]of char;
var OSVersion:_OSVERSIONINFOA;
begin
//  GetWindowsDirectory(@WinDir[0],MAX_PATH);
  GetEnvironmentVariable('windir',@WinDir[0],MAX_PATH);
  FontPath:=IncludeTrailingPathDelimiter(WinDir)+'Fonts\'+OSDFont;
  if FileExists(FontPath) then
    FontPath:=' -font '+EscapeParam(FontPath)
  else
    FontPath:='';
  HomeDir:=IncludeTrailingPathDelimiter(ExtractFileDir(ExpandFileName(ParamStr(0))));

  // check for Win9x
  FillChar(OSVersion,sizeof(OSVersion),0);
  OSVersion.dwOSVersionInfoSize:=sizeof(OSVersion);
  GetVersionEx(OSVersion);
  if OSVersion.dwPlatformId<VER_PLATFORM_WIN32_NT
    then Win9xWarnLevel:=wlWarn
    else Win9xWarnLevel:=wlAccept;
end;

procedure Start;
var DummyPipe1,DummyPipe2:THandle;
    si:TStartupInfo;
    pi:TProcessInformation;
    sec:TSecurityAttributes;
    CmdLine,s:string;
    Success:boolean; Error:DWORD;
    ErrorMessage:array[0..1023]of char;     
begin
  if ClientProcess<>0 then exit;
  if length(MediaURL)=0 then exit;

  if FirstOpen then begin
    with MainForm do begin
      MAudio.Clear;
      MAudio.Enabled:=false;
      MSubtitle.Clear;
      MSubtitle.Enabled:=false;
    end;
    AudioID:=-1; SubID:=-1;
  end;

  Status:=sOpening; MainForm.UpdateStatus;

  if Win9xWarnLevel=wlWarn then begin
    case MessageDlg(
           'MPUI will not run properly on Win9x systems. Continue anyway?',
           mtWarning,[mbYes,mbNo],0)
    of
      mrYes:Win9xWarnLevel:=wlAccept;
      mrNo:Win9xWarnLevel:=wlReject;
    end;
  end;
  if Win9xWarnLevel=wlReject then begin
    LogForm.TheLog.Text:='not executing MPlayer: invalid Operating System version';
    Status:=sError;
    MainForm.UpdateStatus;
    MainForm.SetupStop(True);
    exit;
  end; 

  FirstChance:=true;
  ClientWaitThread:=TClientWaitThread.Create(true);
  Processor:=TProcessor.Create(true);

  CmdLine:=EscapeParam(HomeDir+'mplayer.exe')+' -slave -identify'
          +' -wid '+IntToStr(MainForm.InnerPanel.Handle)+' -colorkey 0x101010'
          +' -nokeepaspect -framedrop -autosync 100'+FontPath;
  if ReIndex then CmdLine:=CmdLine+' -idx';
  if SoftVol then CmdLine:=CmdLine+' -softvol -softvol-max 1000';
  if PriorityBoost then CmdLine:=CmdLine+' -priority abovenormal';
  case AudioOut of
    0:CmdLine:=CmdLine+' -nosound';
    1:CmdLine:=CmdLine+' -ao null';
    2:CmdLine:=CmdLine+' -ao win32';
    3:CmdLine:=CmdLine+' -ao dsound:device='+IntToStr(AudioDev);
  end;
  if (AudioID>=0) AND (AudioOut>0) then CmdLine:=CmdLine+' -aid '+IntToStr(AudioID);
  if SubID>=0 then CmdLine:=CmdLine+' -sid '+IntToStr(SubID);
  case Aspect of
    1:CmdLine:=CmdLine+' -aspect 4:3';
    2:CmdLine:=CmdLine+' -aspect 16:9';
    3:CmdLine:=CmdLine+' -aspect 2.35';
  end;
  case Postproc of
    1:CmdLine:=CmdLine+' -autoq 10 -vf-add pp';
    2:CmdLine:=CmdLine+' -vf-add pp=hb/vb/dr';
  end;
  case Deinterlace of
    1:CmdLine:=CmdLine+' -vf-add lavcdeint';
    2:CmdLine:=CmdLine+' -vf-add kerndeint';
  end;
  if length(Params)>0 then
    CmdLine:=CmdLine+#32+Params;
  CmdLine:=CmdLine+#32+MediaURL;

  with LogForm do begin
    TheLog.Clear;
    AddLine('command line:');
    s:=CmdLine;
    while length(s)>0 do
      AddLine(SplitLine(s));
    AddLine('');
  end;

  HaveAudio:=true;
  HaveVideo:=true;
  NativeWidth:=0;
  NativeHeight:=0;
  PercentPos:=0;
  SecondPos:=-1;
  OSDLevel:=1;
  ExplicitStop:=false;
  Duration:='0:00:00';
  ResetStreamInfo;
  StreamInfo.FileName:=MediaURL;
  LastLine:=''; LineRepeatCount:=0;
  LastCacheFill:='';

  with sec do begin
    nLength:=sizeof(sec);
    lpSecurityDescriptor:=nil;
    bInheritHandle:=true;
  end;
  CreatePipe(ReadPipe,DummyPipe1,@sec,0);

  with sec do begin
    nLength:=sizeof(sec);
    lpSecurityDescriptor:=nil;
    bInheritHandle:=true;
  end;
  CreatePipe(DummyPipe2,WritePipe,@sec,0);

  FillChar(si,sizeof(si),0);
  si.cb:=sizeof(si);
  si.dwFlags:=STARTF_USESTDHANDLES;
  si.hStdInput:=DummyPipe2;
  si.hStdOutput:=DummyPipe1;
  si.hStdError:=DummyPipe1;
  Success:=CreateProcess(nil,PChar(CmdLine),nil,nil,true,DETACHED_PROCESS,nil,PChar(HomeDir),si,pi);
  Error:=GetLastError();

  CloseHandle(DummyPipe1);
  CloseHandle(DummyPipe2);

  if not Success then begin
    LogForm.AddLine('Error '+IntToStr(Error)+' while starting MPlayer:');
    FormatMessage(FORMAT_MESSAGE_FROM_SYSTEM,nil,Error,0,@ErrorMessage[0],1023,nil);
    LogForm.AddLine(ErrorMessage);
    if Error=2 then LogForm.AddLine('Please check if MPlayer.exe is installed in the same directory as MPUI.');
    ClientWaitThread.ClientDone;  // this is a synchronized function, so I may
                                  // call it here from this thread as well
    exit;
  end;

  ClientProcess:=pi.hProcess;
  ClientWaitThread.hProcess:=ClientProcess;
  Processor.hPipe:=ReadPipe;

  ClientWaitThread.Resume;
  Processor.Resume;
  MainForm.SetupStart;

  if AudioOut>1 then begin
    // init volume adjustments
    if AudioOut=3 then LastVolume:=100;  // DirectSound always starts at 100%
    if SoftVol then LastVolume:=-1;  // SoftVol always starts ... somewhere else
    if Volume<>LastVolume then
      SendVolumeChangeCommand(Volume);
    if Mute then SendCommand('mute');
  end;
end;

procedure TClientWaitThread.ClientDone;
var WasExplicit:boolean;
begin
  ClientProcess:=0;
  CloseHandle(ReadPipe); ReadPipe:=0;
  CloseHandle(WritePipe); WritePipe:=0;
  ClientWaitThread.Terminate;
  if Assigned(Processor) then Processor.Terminate;
  FirstOpen:=false;
  if (Status=sOpening) OR (ExitCode<>0) then Status:=sError else Status:=sStopped;
  DisplayURL:='';
  WasExplicit:=ExplicitStop OR (Status=sError);
  MainForm.UpdateStatus;
  MainForm.SetupStop(WasExplicit);
  MainForm.UpdateCaption;
  ExplicitStop:=false;
  if not WasExplicit then
    MainForm.NextFile(1,psPlayed);
end;

procedure TClientWaitThread.Execute;
begin
  WaitForSingleObject(hProcess,INFINITE);
  GetExitCodeProcess(hProcess,ExitCode);
  Synchronize(ClientDone);
end;

procedure TProcessor.Process;
var LastEOL,EOL,Len:integer;
begin
  Len:=length(Data);
  LastEOL:=0;
  for EOL:=1 to Len do
    if (EOL>LastEOL) AND ((Data[EOL]=#13) OR (Data[EOL]=#10)) then begin
      HandleInputLine(Copy(Data,LastEOL+1,EOL-LastEOL-1));
      LastEOL:=EOL;
      if (LastEOL<Len) AND (Data[LastEOL+1]=#10) then inc(LastEOL);
    end;
  if LastEOL<>0 then Delete(Data,1,LastEOL);
end;

procedure TProcessor.Execute;
const BufSize=1024;
var Buffer:array[0..BufSize]of char;
    BytesRead:cardinal;
begin
  Data:='';
  repeat
    BytesRead:=0;
    if not ReadFile(hPipe,Buffer[0],BufSize,BytesRead,nil) then break;
    Buffer[BytesRead]:=#0;
    Data:=Data+Buffer;
    Synchronize(Process);
  until BytesRead=0;
end;

function Running:boolean;
begin
  Result:=(ClientProcess<>0);
end;

procedure Stop;
begin
  Status:=sClosing; MainForm.UpdateStatus;
  ExplicitStop:=true;
  if FirstChance then begin
    SendCommand('quit');
    FirstChance:=false;
  end else
    Terminate;
end;

procedure Terminate;
begin
  if ClientProcess=0 then exit;
  TerminateProcess(ClientProcess,cardinal(-1));
end;

procedure ForceStop;
begin
  ExplicitStop:=true;