www.pudn.com > AVideoCapture.rar > MainUnt.pas

unit MainUnt; 
 
interface 
 
uses 
  Windows, Messages, Sysutils, Variants, Classes, Graphics, Controls, Forms, 
  Dialogs, ExtCtrls, StdCtrls, OleCtrls, SFLIVESERVERLib_TLB, Menus, 
  CoolTrayIcon, RainButton, RainComboBox, RainCheckBox, RainForm, DB, 
  ADODB, ScktComp, ComCtrls, ImgList; 
 
type 
  TMain = class(TForm) 
    GroupBox1: TGroupBox; 
    RunModel: TRadioGroup; 
    GroupBox3: TGroupBox; 
    Label11: TLabel; 
    Label10: TLabel; 
    TrayIcon: TCoolTrayIcon; 
    GroupBox2: TGroupBox; 
    Label8: TLabel; 
    Label9: TLabel; 
    Label19: TLabel; 
    Label20: TLabel; 
    RainForm1: TRainForm; 
    Teacherch: TRainCheckBox; 
    BeginBtn: TRainButton; 
    StopBtn: TRainButton; 
    TVFormat: TRainComboBox; 
    VideoBox: TRainComboBox; 
    VideoSource: TRainComboBox; 
    OtherCBox: TRainComboBox; 
    OVideoSource: TRainComboBox; 
    OVFormat: TRainComboBox; 
    Otherch: TRainCheckBox; 
    SaveDialog: TSaveDialog; 
    ClientSocket: TClientSocket; 
    Bevel2: TBevel; 
    QueryTimer: TTimer; 
    ImageList: TImageList; 
    TrayIconPopupMenu: TPopupMenu; 
    TrayIconPopupMenuSet: TMenuItem; 
    TrayIconPopupMenuHide: TMenuItem; 
    TrayIconPopupMenuShow: TMenuItem; 
    TrayIconPopupMenuExit: TMenuItem; 
    LogoTimer: TTimer; 
    AutoCBox: TRainCheckBox; 
    ActiveTimer: TTimer; 
    UserPowerTimer: TTimer; 
    SaveBtn: TRainButton; 
    ServerBtn: TRainButton; 
    DesktopTimer: TTimer; 
    GroupBox4: TGroupBox; 
    Label23: TLabel; 
    ScreenModeBox: TRainComboBox; 
    Label6: TLabel; 
    ScreenQualityEdit: TEdit; 
    GroupBox5: TGroupBox; 
    Label4: TLabel; 
    VideoBps: TEdit; 
    Label5: TLabel; 
    AudioBps: TRainComboBox; 
    Label7: TLabel; 
    Label17: TLabel; 
    FpsEdit: TEdit; 
    Label18: TLabel; 
    Label1: TLabel; 
    GroupBox6: TGroupBox; 
    Label13: TLabel; 
    TSWWidth: TEdit; 
    Label14: TLabel; 
    TSWHeigth: TEdit; 
    Label15: TLabel; 
    CaptionEdit: TEdit; 
    Label21: TLabel; 
    RECCast: TRainCheckBox; 
    SaveNameEdit: TEdit; 
    Bevel5: TBevel; 
    procedure VideoBpsKeyPress(Sender: TObject; var Key: Char); 
    procedure CastAddrKeyPress(Sender: TObject; var Key: Char); 
    procedure FormCreate(Sender: TObject); 
    procedure ClientSocketConnect(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ClientSocketDisconnect(Sender: TObject; 
      Socket: TCustomWinSocket); 
    procedure ClientSocketError(Sender: TObject; Socket: TCustomWinSocket; 
      ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
    procedure ClientSocketRead(Sender: TObject; Socket: TCustomWinSocket); 
    procedure QueryTimerTimer(Sender: TObject); 
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
    procedure TrayIconPopupMenuClick(Sender: TObject); 
    procedure TrayIconClick(Sender: TObject); 
    procedure ComBoxDropDown(Sender: TObject); 
    procedure LogoTimerTimer(Sender: TObject); 
    procedure ActiveTimerTimer(Sender: TObject); 
    procedure UserPowerTimerTimer(Sender: TObject); 
    procedure StopCastTimerTimer(Sender: TObject); 
    procedure StopSaveFileTimerTimer(Sender: TObject); 
    procedure TextMoveTimerTimer(Sender: TObject); 
    procedure RainBtnClick(Sender: TObject); 
    procedure DesktopTimerTimer(Sender: TObject); 
    procedure CheckBoxClick(Sender: TObject); 
  private 
    { Private declarations } 
  public 
    { Public declarations } 
    procedure MyStopDesktopCast(); 
    procedure MyBeginDesktopCast(); 
  end; 
 
var 
  Main: TMain; 
implementation 
 
uses UserPowerUnt, LiveSrvCastUnt, AVideoStatusUnt, AVideoFunctionUnt, LogonUnt, OptionsSetUnt, CastOprUnt, SockUnt; 
 
{$R *.dfm} 
 
procedure PowerOff(Force: Boolean = False); 
var 
  hToken: THandle; 
  tkp: TTokenPrivileges; 
  tkpo: TTokenPrivileges; 
  zero: DWORD; 
begin 
  if Win32Platform = VER_PLATFORM_WIN32_NT then {// we've got to do a whole buch of things}  begin 
    zero := 0; 
    if not OpenProcessToken(GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) then begin 
      MessageBox(0, 'PowerOff Error', 'OpenProcessToken() Failed', MB_OK); 
      Exit; 
    end; // if not OpenProcessToken( GetCurrentProcess(), TOKEN_ADJUST_PRIVILEGES or TOKEN_QUERY, hToken) 
 
    // SE_SHUTDOWN_NAME 
    if not LookupPrivilegeValue(nil, 'SeShutdownPrivilege', tkp.Privileges[0].Luid) then begin 
      MessageBox(0, 'PowerOff Error', 'LookupPrivilegeValue() Failed', MB_OK); 
      Exit; 
    end; // if not LookupPrivilegeValue( nil, 'SeShutdownPrivilege' , tkp.Privileges[0].Luid ) 
    tkp.PrivilegeCount := 1; 
    tkp.Privileges[0].Attributes := SE_PRIVILEGE_ENABLED; 
    AdjustTokenPrivileges(hToken, False, tkp, SizeOf(TTokenPrivileges), tkpo, zero); 
    if Boolean(GetLastError()) then begin 
      MessageBox(0, 'PowerOff Error', 'AdjustTokenPrivileges() Failed', MB_OK); 
      Exit; 
    end // if Boolean( GetLastError() ) 
    else if Force then 
      ExitWindowsEx(EWX_POWEROFF, 1) 
    else ExitWindowsEx(EWX_REBOOT, 1); 
  end // if OSVersion = 'Windows NT' 
  else // just shut the machine down 
    if Force then ExitWindowsEx(EWX_POWEROFF, 1) 
    else ExitWindowsEx(EWX_REBOOT, 1); 
end; 
 
procedure TMain.RainBtnClick(Sender: TObject); 
begin 
  case TRainButton(Sender).tag of 
    1: begin //文件录制 
        SaveDialog.filename := SaveNameEdit.Text; 
        if SaveDialog.Execute then 
          if SaveDialog.filename = SaveNameEdit.Text then 
            Exit 
          else 
            SaveNameEdit.Text := SaveDialog.filename; 
        LiveSrvCast.LiveSrv.SaveFileName[0] := SaveNameEdit.Text; 
      end; 
    2: MyBeginDesktopCast; //开始广播 
    3: MyStopDesktopCast; //停止广播 
    4: MyLocSerOpr_Allow; //服务器托管 
  end; 
end; 
 
procedure TMain.VideoBpsKeyPress(Sender: TObject; var Key: Char); 
begin 
  if not (Key in ['0'..'9', #8]) then Key := #0; 
end; 
 
procedure TMain.CastAddrKeyPress(Sender: TObject; var Key: Char); 
begin 
  if not (Key in ['0'..'9', #8, #46]) then Key := #0; 
end; 
 
procedure TMain.FormCreate(Sender: TObject); 
var 
  i: Integer; 
begin 
  MemFile := CreateFileMapping($FFFFFFFF, nil, PAGE_READWRITE, 0, SizeOf(TGoData), 'AVideoCapture'); 
  Godata := MapViewOfFile(MemFile, FILE_MAP_WRITE, 0, 0, 0); 
  if MemFile = 0 then //只运行一个实例 
    FillChar(Godata^, SizeOf(TGoData), 0); 
  Godata^.TargetWnd := Handle; 
  //只运行一个实例 
  Desktop := False; //默认操作权交由远程服务器 
  TrayIconHint(2); 
  //Sleep(sleeptimer); 
  TrayIconPopupMenuSet.Enabled := False; 
  for i := 0 to 2 do 
    FilesList[i] := Tstringlist.Create; 
  AppliInitialize; //程序初始化 
  Share_Path := Tstringlist.Create; 
  Left := (Screen.Width - Width) div 2; 
  TrayIcon.MinimizeToTray := True; //最小化及关闭图标时进入系统托盘 
  ActiveTimer.Enabled := True; 
end; 
 
procedure TMain.MyStopDesktopCast(); 
begin 
  myStopCast('0'); 
  LiveSrvCast.LiveSrv.StopPreview(1); 
  BeginBtn.Enabled := True; 
  ServerBtn.Enabled := True; 
  StopBtn.Enabled := False; 
  RECCast.Checked := False; 
  LiveSrvCast.close; 
  DesktopTimer.Enabled := True; 
  sendcommand(SocketClient, desktopstatus, ''); 
end; 
 
procedure TMain.MyBeginDesktopCast(); 
begin 
  if (VideoBox.ItemIndex >= 0) and (VideoSource.ItemIndex >= 0) then 
    LiveSrvCast.MainVideoMItem.Enabled := True; 
  if (OtherCBox.ItemIndex >= 0) and (OVideoSource.ItemIndex >= 0) then 
    LiveSrvCast.SubVideoMItem.Enabled := True; 
  try 
    with LiveSrvCast.LiveSrv do begin 
      if (MultiAddr[0] <> '') and (MultiPort[0] < 0) then 
        RunMode[0] := RunModel.ItemIndex 
      else begin 
        RunModel.ItemIndex := 0; 
        RunMode[0] := 0; 
      end; 
      VideoBitRate[0] := StrToInt(VideoBps.Text); 
      AudioBitRate[0] := StrToInt(AudioBps.Text); 
      CapVideoDevice[0] := 100; 
      SetCapScreenMode(0, ScreenModeBox.ItemIndex, StrToInt(ScreenQualityEdit.Text)); 
      SetCapScreenSetting(0, 0, StrToInt(FpsEdit.Text), 0, 0, 0); 
      CapAudioDevice[0] := 0; 
      sendvideo[0] := True; 
      sendaudio[0] := True; 
      showaudio[0] := True; 
      if BeginCast(0) then begin 
        BeginBtn.Enabled := False; 
        ServerBtn.Enabled := False; 
        StopBtn.Enabled := True; 
        MySetForm(0, LiveSrvCast.LiveSrv, TVFormat.Text, 25); 
        //if RECCast.Checked then 
        //SaveFileName[0] := SaveNameEdit.Text; 
        close; 
        Logon.CaptionPa.Caption := CaptionEdit.Text; 
        Logon.Show; 
        LogoTimer.Enabled := True; 
        if Teacherch.Checked then begin 
          CastFileName[1] := ''; //设置广播文件路径 不广播文件 为空运行之前 
          CapVideoDevice[1] := VideoBox.ItemIndex; // 指定视频卡 - 1 不捕捉，100桌面 运行之前 
          CapAudioDevice[1] := -1; // 指定视频卡 - 1 ~ 10 - 1 不捕捉 运行之前 
          ShowVideo[1] := True; //显示画面 运行之前 
          VideoSource[1] := Main.VideoSource.ItemIndex; //视频来源 - 10 不设置，只查看是否使用老式接口 任何时间 
          SaveFileName[1] := ''; // ExtractFileDir(Application.ExeName) + '\aas.asf'; //长度255 为0不录像，反之要录像 任何时间 
          RunMode[1] := 0; //运行模式 0 只监听 1 只组播 2 组播&监听 运行之前 
          LiveSrvCast.Width := StrToInt(TSWWidth.Text) + 8; 
          LiveSrvCast.Height := StrToInt(TSWHeigth.Text) + 8; 
          MySetForm(1, LiveSrvCast.LiveSrv, TVFormat.Text, 25); 
          SetWndSize(1, 0, 0, Width, Height); 
          if StartPreview(1, -1) then 
            teachvideo := True; 
        end 
        else 
          LiveSrvCast.Show; 
      end; 
      DesktopTimer.Enabled := False; 
      sendcommand(SocketClient, desktopstatus, IntToStr(RunMode[0])); 
    end; 
  except 
    Application.MessageBox('请设置好相关参数', '参数不完全', mb_okcancel); 
    Exit; 
  end; 
end; 
 
procedure TMain.ClientSocketConnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
  TrayIconHint(0); 
  QueryTimer.Enabled := False; 
  sendcommand(SocketClient, Enter, IntToStr(cardcount)); 
  TrayIconHint(7); 
end; 
 
procedure TMain.ClientSocketDisconnect(Sender: TObject; 
  Socket: TCustomWinSocket); 
var 
  i: Integer; 
begin 
  TrayIconHint(6); 
  for i := 0 to 2 do 
    //if LiveSrvCast.LiveSrv.IsChannelRunning(i) then //查询频道是否正在运行中任何时间有效 
    myStopCast(IntToStr(i)); 
  QueryTimer.Enabled := True; 
end; 
 
procedure TMain.ClientSocketError(Sender: TObject; Socket: TCustomWinSocket; 
  ErrorEvent: TErrorEvent; var ErrorCode: Integer); 
var 
  i: Integer; 
begin 
  TrayIconHint(6); 
  for i := 0 to 2 do 
    //if LiveSrvCast.LiveSrv.IsChannelRunning(i) then //查询频道是否正在运行中任何时间有效 
    myStopCast(IntToStr(i)); //停止广播 
  ClientSocket.Active := False; 
  QueryTimer.Enabled := True; 
  ErrorCode := 0; 
end; 
 
procedure TMain.ClientSocketRead(Sender: TObject; 
  Socket: TCustomWinSocket); 
begin 
  Command_Deal(ClientSocket.Socket.ReceiveText); 
end; 
 
procedure TMain.QueryTimerTimer(Sender: TObject); 
begin 
  try 
    ClientSocket.open; {打开Internet WinSocket控件ClientSocket使用Socket技术传送数据的客户端} 
  except 
    ClientSocket.close; 
    TrayIconHint(6); 
  end; 
end; 
 
procedure TMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean); 
begin 
  CanClose := False; 
  TrayIcon.Hidemainform; //进入系统托盘 
end; 
 
procedure TMain.TrayIconPopupMenuClick(Sender: TObject); 
begin 
  try 
    case TMenuItem(Sender).tag of 
      4: TrayIcon.Hidemainform; //隐藏程序界面 
      1: ShwMainForm; //显示程序界面 
      2: appliexit; //退出应用程序 
      3: OptionsSet.ShowModal; //设置 
    end; 
  except 
  end; 
end; 
 
procedure TMain.TrayIconClick(Sender: TObject); 
begin 
  if Visible = True then 
    TrayIcon.Hidemainform //隐藏程序界面 
  else ShwMainForm; //显示程序界面 
end; 
 
procedure TMain.ComBoxDropDown(Sender: TObject); 
var 
  i: Integer; 
begin 
  case TRainComboBox(Sender).tag of 
    1, 4: begin //增加视频卡 
        TRainComboBox(Sender).Items.Clear; 
        for i := 0 to 2 do 
          if videoCard[i].Name <> '' then 
            TRainComboBox(Sender).Items.Add(videoCard[i].Name); 
      end; 
    2: begin //增加视频源——主教 
        TRainComboBox(Sender).Items.Clear; 
        for i := 0 to 9 do 
          if (VideoBox.ItemIndex >= 0) and (videoCard[VideoBox.ItemIndex].Source[i] <> '') then 
            TRainComboBox(Sender).Items.Add(videoCard[VideoBox.ItemIndex].Source[i]); 
      end; 
    5: begin //增加视频源——辅助 
        TRainComboBox(Sender).Items.Clear; 
        for i := 0 to 9 do 
          if (OtherCBox.ItemIndex >= 0) and (videoCard[OtherCBox.ItemIndex].Source[i] <> '') then 
            TRainComboBox(Sender).Items.Add(videoCard[OtherCBox.ItemIndex].Source[i]); 
      end; 
    8: begin //增加本地IP 
        TRainComboBox(Sender).Items.Clear; 
        for i := 0 to 2 do 
          if localIPSrc[i].Addr <> '' then 
            TRainComboBox(Sender).Items.Add(localIPSrc[i].Addr); 
      end; 
  end; 
end; 
 
procedure TMain.LogoTimerTimer(Sender: TObject); 
begin 
  LogoTimer.Enabled := False; 
  Logon.close; 
  if teachvideo = True then begin 
    LiveSrvCast.Top := 0; 
    LiveSrvCast.Left := Screen.Width - LiveSrvCast.Width; 
    LiveSrvCast.Show; 
  end; 
end; 
 
procedure TMain.ActiveTimerTimer(Sender: TObject); 
begin 
  ActiveTimer.Enabled := False; 
  try 
    GetAVideoCardsource(LiveSrvCast.LiveSrv); 
    TrayIconHint(1); //获取音视频卡及源信息 
  except 
    Main.TrayIcon.Hidemainform; 
    Main.ActiveTimer.Enabled := True; 
    TrayIconHint(15); 
    Exit; 
  end; 
  try 
    GetLocalIP; 
    TrayIconHint(5); //获取本地IP 
    TrayIcon.Hidemainform; 
  except 
    Main.TrayIcon.Hidemainform; 
    Main.ActiveTimer.Enabled := True; 
    TrayIconHint(16); 
    Exit; 
  end; 
  try 
    ClientSocket.open; //打开Socket,连接服务器 
  except 
    ClientSocket.close; 
    QueryTimer.Enabled := True; 
    TrayIconHint(6); 
  end; 
end; 
 
procedure TMain.UserPowerTimerTimer(Sender: TObject); 
begin 
  UserPowerTimerevent(); 
end; 
 
procedure TMain.StopSaveFileTimerTimer(Sender: TObject); 
begin 
  MyStopSaveFile(IntToStr(TTimer(Sender).tag - 10)); 
end; 
 
procedure TMain.StopCastTimerTimer(Sender: TObject); 
begin 
  myStopCast(IntToStr(TTimer(Sender).tag - 20)); 
end; 
 
procedure TMain.TextMoveTimerTimer(Sender: TObject); 
begin 
  MyTextMove(IntToStr(TTimer(Sender).tag - 30)); 
end; 
 
procedure TMain.DesktopTimerTimer(Sender: TObject); 
begin 
  MyLocSerOpr_Allow; 
end; 
 
procedure TMain.CheckBoxClick(Sender: TObject); 
begin 
  case TRainCheckBox(Sender).tag of 
    1: begin //自动调整位置 
        if AutoCBox.Checked then begin 
          TSWWidth.Enabled := True; 
          TSWHeigth.Enabled := True; 
        end 
        else begin 
          TSWWidth.Enabled := False; 
          TSWHeigth.Enabled := False; 
        end; 
      end; 
    2: begin //录制文件 
        if RECCast.Checked then begin 
          SaveBtn.Enabled := True; 
          SaveNameEdit.Text := ExtractFileDir(Application.ExeName) + '\SaveFiles\' + DateToStr(Date) + '--' + FormatDateTime('hh-mm-ss', Now) + '.asf'; 
        end 
        else begin 
          SaveBtn.Enabled := False; 
          SaveNameEdit.Text := ''; 
        end; 
        LiveSrvCast.LiveSrv.SaveFileName[0] := SaveNameEdit.Text; 
      end; 
    3: begin //主教视频 
        if Teacherch.Checked then begin 
          VideoBox.Enabled := True; 
          VideoSource.Enabled := True; 
          TVFormat.Enabled := True; 
        end 
        else begin 
          LiveSrvCast.LiveSrv.CapVideoDevice[1] := -1; 
          VideoBox.Enabled := False; 
          VideoSource.Enabled := False; 
          TVFormat.Enabled := False; 
        end; 
      end; 
    4: begin //附加视频 
        if Otherch.Checked then begin 
          OtherCBox.Enabled := True; 
          OVideoSource.Enabled := True; 
          OVFormat.Enabled := True; 
        end 
        else begin 
          LiveSrvCast.LiveSrv.CapVideoDevice[2] := -1; 
          OtherCBox.Enabled := False; 
          OVideoSource.Enabled := False; 
          OVFormat.Enabled := False; 
        end; 
      end; 
  end; 
end; 
 
end.