client.pas

冰河反弹版之独孤夕客专版 今天我决定把这个版本的冰河反弹版程序源码公布

unit Client;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ExtCtrls, DSPack, DirectShow9, StdCtrls, DSUtil,
  IdBaseComponent, IdComponent, IdTCPConnection, IdTCPClient, jpeg, Menus;

type
  TClientForm = class(TForm)
    FilterGraph: TFilterGraph;
    Grabber: TSampleGrabber;
    Filter: TFilter;
    VideoWindow: TVideoWindow;
    Image: TImage;
    Panel: TPanel;
    MainMenu: TMainMenu;
    VideoPanel: TPanel;
    Devices: TMenuItem;
    Connect: TMenuItem;
    ConnectServer: TMenuItem;
    help: TMenuItem;
    About: TMenuItem;
    DeconnectServer: TMenuItem;
    Label1: TLabel;
    Panel1: TPanel;
    procedure GrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
    procedure FormCreate(Sender: TObject);
    procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
    procedure AboutClick(Sender: TObject);
    procedure ConnectServerClick(Sender: TObject);
    procedure DeconnectServerClick(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
    procedure OnSelectDevice(sender: TObject);
  end;

var
  ClientForm: TClientForm;
  SysDev: TSysDevEnum;

implementation

uses
  About, Connect;

{$R *.dfm}

procedure TClientForm.GrabberBuffer(sender: TObject; SampleTime: Double; pBuffer: Pointer; BufferLen: Integer);
var
  hr: HRESULT;
  BIHeaderPtr: PBitmapInfoHeader;
  MediaType: TAMMediaType;
  BitMapHandle: HBitmap;
  DIBPtr: Pointer;
  jpg: TJpegImage;
  memStream: TMemoryStream;
begin
  Image.Canvas.Lock;
  try
    hr := Grabber.SampleGrabber.GetConnectedMediaType(MediaType);
    if hr <> S_OK then
      Exit;
    try
      if IsEqualGUID(MediaType.majortype, MEDIATYPE_Video) then
      begin
        BIHeaderPtr := nil;
        if IsEqualGUID(MediaType.formattype, FORMAT_VideoInfo) then
          if MediaType.cbFormat = SizeOf(TVideoInfoHeader) then
            BIHeaderPtr := @(PVideoInfoHeader(MediaType.pbFormat)^.bmiHeader);
        if not Assigned(BIHeaderPtr) then
          Exit;
        BitmapHandle := CreateDIBSection(0, PBitmapInfo(BIHeaderPtr)^, DIB_RGB_COLORS, DIBPtr, 0, 0);
        if BitmapHandle <> 0 then
        begin
          if DIBPtr = nil then
            Exit;
          if BufferLen > Integer(BIHeaderPtr^.biSizeImage) then
            BufferLen := BIHeaderPtr^.biSizeImage;
          Move(pBuffer^, DIBPtr^, BufferLen);
          Image.Picture.Bitmap.Handle := BitmapHandle;
        end;
      end;
    finally
      FreeMediaType(@MediaType);
    end;

    memStream := TMemoryStream.Create;
    jpg := TJpegImage.Create;
    jpg.Assign(Image.Picture.Bitmap);
    jpg.CompressionQuality := 10;
    jpg.JPEGNeeded;
    jpg.Compress;
    jpg.SaveToStream(memStream);
    jpg.Free;

    if ConnectForm.TCPClient.Connected then
    begin
      try
        ConnectForm.TCPClient.WriteInteger(memStream.Size);
        ConnectForm.TCPClient.WriteBuffer(memStream.Memory^, memStream.Size, True);
      except
      end;
    end;
    memStream.Free;
  finally
    Image.Canvas.Unlock;
  end;
end;

procedure TClientForm.FormCreate(Sender: TObject);
var
  i: Integer;
  Device: TMenuItem;
begin
  SysDev := TSysDevEnum.Create(CLSID_VideoInputDeviceCategory);
  if SysDev.CountFilters > 0 then
    for i := 0 to SysDev.CountFilters - 1 do
    begin
      Device := TMenuItem.Create(Devices);
      Device.Caption := SysDev.Filters[i].FriendlyName;
      Device.Tag := i;
      Device.OnClick := OnselectDevice;
      Devices.Add(Device);
    end;
end;

procedure TClientForm.OnSelectDevice(sender: TObject);
begin
  FilterGraph.ClearGraph;
  FilterGraph.Active := False;
  Filter.BaseFilter.Moniker := SysDev.GetMoniker(TMenuItem(Sender).tag);
  FilterGraph.Active := True;
  with FilterGraph as ICaptureGraphBuilder2 do
    CheckDSError(RenderStream(@PIN_CATEGORY_PREVIEW, nil, Filter as IBaseFilter, Grabber as IBaseFilter, VideoWindow as IbaseFilter));
  FilterGraph.Play;
end;

procedure TClientForm.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
  SysDev.Free;
  FilterGraph.ClearGraph;
  FilterGraph.Active := False;
  if ConnectForm.TCPClient.Connected then
    ConnectForm.TCPClient.Disconnect;
end;

procedure TClientForm.AboutClick(Sender: TObject);
begin
  AboutForm.Show;
end;

procedure TClientForm.ConnectServerClick(Sender: TObject);
begin
  ConnectForm.Show;
end;

procedure TClientForm.DeconnectServerClick(Sender: TObject);
begin
  if ConnectForm.TCPClient.Connected then
    ConnectForm.TCPClient.Disconnect;
end;

end.