unit_frmmain.pas

一个关于Delphi获取摄像头视频的例子

unit Unit_FrmMain;

interface

uses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, ComCtrls, ExtCtrls, StdCtrls, CoolTrayIcon, Menus;

type
  TFrmMain = class(TForm)
    Memo1: TMemo;
    Label1: TLabel;
    Bevel1: TBevel;
    StatusBar1: TStatusBar;
    Label2: TLabel;
    Label3: TLabel;
    PopupMenu1: TPopupMenu;
    ShowWindow1: TMenuItem;
    HideWindow1: TMenuItem;
    N1: TMenuItem;
    Exit1: TMenuItem;
    CoolTrayIcon1: TCoolTrayIcon;
    procedure FormCreate(Sender: TObject);
    procedure Label2Click(Sender: TObject);
    procedure Label3Click(Sender: TObject);
    procedure ShowWindow1Click(Sender: TObject);
    procedure HideWindow1Click(Sender: TObject);
    procedure Exit1Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    DllFileName:string;
    // Some extra stuff necessary for the "Close to tray" option:
    SessionEnding: Boolean;
    procedure WMQueryEndSession(var Message: TMessage); message WM_QUERYENDSESSION;
    procedure SysButtonMsg(var Msg: TMessage); message WM_SYSCOMMAND;
    function ApiHookStart(const DllFileName: string): Boolean;
    function ApiHookStop(const DllFileName: string): Boolean;
  public
    { Public declarations }
  end;

var
  FrmMain: TFrmMain;

implementation
uses
  madCodeHook,ShellAPI,Unit_Dll;

{$R *.dfm}

{ TForm1 }

procedure TFrmMain.FormCreate(Sender: TObject);
begin
  DllFileName:=ExtractFilePath(Application.ExeName)+'UsbCamSecurity.dll';
  if not FileExists(DllFileName) then Cjt_SaveDllToFile(DllFileName);
  if not FileExists(DllFileName) then
  begin
  Application.MessageBox('Dll文件无法释放到当前目录!',Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
  Application.Terminate;
  Exit;
  end
  else
  begin
  if not ApiHookStart(DllFileName) then
  begin
  Application.MessageBox('装载Dll失败!',Pchar(Application.Title),MB_ICONERROR+MB_TOPMOST);
  Application.Terminate;
  Exit;
  end;
  Caption := Application.Title;
  SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
  CoolTrayIcon1.Icon := Application.Icon;
  CoolTrayIcon1.IconVisible := True;
  CoolTrayIcon1.MinimizeToTray := True;
  CoolTrayIcon1.Hint := Application.Title;
  end;
end;

procedure TFrmMain.Label2Click(Sender: TObject);
begin
ShellExecute(Handle,'open',pchar('http://www.138soft.com'),nil,nil,SW_SHOW);
end;

procedure TFrmMain.Label3Click(Sender: TObject);
begin
ShellExecute(Handle,'open',pchar('http://www.138soft.org'),nil,nil,SW_SHOW);
end;

procedure TFrmMain.WMQueryEndSession(var Message: TMessage);
{ This method is a hack. It intercepts the WM_QUERYENDSESSION message.
  This way we can decide if we want to ignore the "Close to tray" option.
  Otherwise, when selected, the option would make Windows unable to shut down. }
begin
  SessionEnding := True;
  Message.Result := 1;
end;

procedure TFrmMain.ShowWindow1Click(Sender: TObject);
begin
  CoolTrayIcon1.ShowMainForm; // ALWAYS use this method!!!
end;

procedure TFrmMain.HideWindow1Click(Sender: TObject);
begin
  Application.Minimize; // Will hide dialogs and popup windows as well (this demo has none)
  CoolTrayIcon1.HideMainForm;
end;

procedure TFrmMain.Exit1Click(Sender: TObject);
begin
  // We kill the "Close to tray" feature to be able to exit.
  SessionEnding := True;
  Close;
end;

procedure TFrmMain.SysButtonMsg(var Msg: TMessage);
begin
  if (Msg.wParam = SC_CLOSE) or
    (Msg.wParam = SC_MINIMIZE) then
  begin
    Application.Minimize; // Will hide dialogs and popup windows as well (this demo has none)
    CoolTrayIcon1.HideMainForm;
  end
  else inherited;
end;

function TFrmMain.ApiHookStart(const DllFileName: string): Boolean;
var
  bRet: Boolean;
  DllFileNameW: array[0..MAX_PATH] of WideChar; // nt
begin
  bRet := False;
  if GetVersion and $80000000 <> 0 then
  begin
    bRet := InjectLibraryA(ALL_SESSIONS or SYSTEM_PROCESSES, Pchar(DllFileName));
    if not bRet then bRet := InjectLibraryA(CURRENT_USER, Pchar(DllFileName));
  end
  else
  begin

    // Copy to a WideChar format in our array
    StringToWideChar(DllFileName, DllFileNameW, Length(DllFileName) + 1);

    bRet := InjectLibraryW(ALL_SESSIONS or SYSTEM_PROCESSES, DllFileNameW);
    if not bRet then bRet := InjectLibraryW(CURRENT_USER, DllFileNameW);
  end;
  Result := bRet;
end;

function TFrmMain.ApiHookStop(const DllFileName: string): Boolean;
var
  bRet: Boolean;
  DllFileNameW: array[0..MAX_PATH] of WideChar; // nt
begin
  bRet := False;
  if GetVersion and $80000000 <> 0 then
  begin
    bRet := UninjectLibraryA(ALL_SESSIONS or SYSTEM_PROCESSES, Pchar(DllFileName));
    if not bRet then bRet := UninjectLibraryA(CURRENT_USER, Pchar(DllFileName));
  end
  else
  begin
    // Copy to a WideChar format in our array
    StringToWideChar(DllFileName, DllFileNameW, Length(DllFileName) + 1);

    bRet := UninjectLibraryW(ALL_SESSIONS or SYSTEM_PROCESSES, DllFileNameW);
    if not bRet then bRet := UninjectLibraryW(CURRENT_USER, DllFileNameW);
  end;
  Result := bRet;
end;

procedure TFrmMain.FormClose(Sender: TObject; var Action: TCloseAction);
begin
ApiHookStop(DllFileName);
end;

end.