2016年12月30日

ping

お久しぶりです。

久しぶりにdelphiを使った。

Embarcadero® RAD Studio 10.1 Berlin バージョン 24.0.25048.9432 

無料版である。

pingを実行したかった。

ExPingというフリーソフトがあるが、あれに機能を加えたいと思っている。

いきなりソースを貼る。
-----
unit Unit1;

interface

uses
  Winapi.Windows, Winapi.Messages, System.SysUtils, System.Variants, System.Classes, Vcl.Graphics,
  Vcl.Controls, Vcl.Forms, Vcl.Dialogs, Vcl.StdCtrls, IdBaseComponent,
  IdComponent, IdRawBase, IdRawClient, IdIcmpClient;

type
  TForm1 = class(TForm)
    Button1: TButton;
    IdIcmpClient1: TIdIcmpClient;
    Edit1: TEdit;
    Memo1: TMemo;
    Edit2: TEdit;
    Label1: TLabel;
    Edit3: TEdit;
    Label2: TLabel;
    Edit4: TEdit;
    Label3: TLabel;
    procedure Button1Click(Sender: TObject);
  private
    { Private 宣言 }
  public
    { Public 宣言 }
  end;

var
  Form1: TForm1;

implementation

{$R *.dfm}

function DoPing (Host: String; TimeOut: Integer) : String;
begin
//  ShowMessage('hello');
  TIdIcmpClient.Create();
  Form1.IdIcmpClient1 := TIdIcmpClient.Create(nil);
  Form1.IdIcmpClient1.ReceiveTimeout := TimeOut;

  Form1.IdICMPClient1.Host:= Host;
  Form1.IdICMPClient1.Ping();

  if (Form1.IdIcmpClient1.ReplyStatus.ReplyStatusType = rsTimeout) then
    begin
      Result :='Timeout'
    end
  else
    if(Form1.IdIcmpClient1.ReplyStatus.ReplyStatusType = rsEcho) then
      begin
        Result :=
                  Form1.IdIcmpClient1.ReplyStatus.FromIpAddress
                + ' -> '
                + Form1.IdIcmpClient1.ReplyStatus.ToIpAddress
                + '  '
                + IntToStr(Form1.IdIcmpClient1.ReplyStatus.BytesReceived)
                + ' Bytes received: '
                + ' TTL: '
                + IntToStr(Form1.IdIcmpClient1.ReplyStatus.TimeToLive)
                + ' time: ' + IntToStr(Form1.IdIcmpClient1.ReplyStatus.MsRoundTripTime)
    end;
  Form1.IdIcmpClient1.Free;
end;


procedure TForm1.Button1Click(Sender: TObject);
var
  Num: Integer;
  TimeOut: Integer;
  Interval:Integer;
  i:integer;
begin
  Num := StrToIntDef(Edit2.Text, 3);
  TimeOut := StrToIntDef(Edit3.Text, 1000);
  Interval := StrToIntDef(Edit4.Text, 1000);

  for i:=1 to Num do begin
    Memo1.Lines.Add(DoPing(Edit1.Text, TimeOut));
    Sleep(Interval);
  end;

end;

end.
-----


無題.png

これはまだ基本機能しかない。

ちなみにF9を押すとアプリは起動するが実行するとエラーになる。
実行ファイルを「管理者として実行」しないとダメだ。
実行ファイルはプロジェクトが保存されているフォルダ配下の Win32\Debug にある。


これからやること。

・回数に0を指定したら停止ボタンを押すまで実行し続ける。
・timeout以外のエラーの対応
・統計情報の表示
・実行結果と統計情報の自動保存機能
・複数宛先を指定した場合順番にでなく並列に実施し、宛先ごとに結果と統計を保存する。つまりマルチスレッドにする
・名前解決に失敗すると例外になるのでその対応

タグ:INDY
posted by delsoli at 07:39| Comment(0) | delphi | 更新情報をチェックする

2013年05月13日

WEBカメラのキャプチャ

最近ニコニコ生放送を見るようになった。大変な盛況ぶりである。けっこう多くの人が顔を出してしゃべっている。本名どころか住所や口座番号まで公表している人がいる。そのうち、自分でも放送やskypeがしたくなってきて、カメラを買ってきた。いわゆる「WEBカメラ」である。USBに接続して使うマイク内臓のものが3000円もしなかった。カメラを買うのは初めてではないが、前回はたしかwindows98、NT4.0の時代。Intelのカメラだったがもう捨ててしまって画素数がいくつだったのかも覚えていない。

配信はカメラで顔を写してしゃべるのが普通だがそれだけではなく、実行しているゲーム画面を映したり、車に載せたり、パソコンのデスクトップをそのまま放送することなどもできる。そしてそれをするためのソフトがいろいろあるのでそれを使えばいいのだが、単純にWEBカメラの画像を表示するだけであれば自分で作れるのではないかと思っていろいろ調べてみた。

方法はいろいろあるのだが、私の環境(Windows7 Home Premium 64bit, Delphi 2007 for Win32)で動作確認できたのは下記サイトで公開されているものくらいだった。
http://www1.iwate-ed.jp/tantou/joho/material/interval_shot/

こちらではexeファイルとunitのpascalソースのみが公開されていて、exeファイルを実行するとちゃんと動くのだが、ソースを自分でdelphiで開いてコンパイルするとうまく動かない。1,2日ほど苦闘して改造しながらなんとか動くものができた。

このプログラムは特に追加で何かをインストールする必要はない。
ソースを見ると、AVICAP32.DLLを使って、
capCreateCaptureWindowA
capGetDriverDescriptionA
というAPIを呼び出し、

さらに
SendMessageA
SetWindowPos
などのAPIを使ってカメラの映像を表示させていた。

そしてその静止画映像をJPGで保存しているのだが、私はそこはbmpでそのまま保存するようにした。

動かなかったのは、保存した映像がサイズゼロの画像になってしまうところである。
でもフォーム上に画像は表示されているので、その位置をbitbltでコピーして保存した。

以下はソースの一部である。

function capCreateCaptureWindowA(WindowName: PChar;
dwStyle: Cardinal; x,y, nWidth,nHeight: Integer;
ParentWin: HWnd; nID: Integer): HWnd; stdcall;
external 'AVICAP32.DLL';

function capGetDriverDescriptionA(wDriverIndex: Short;
lpszName: String; cbName : Integer;
lpszVer : String; cbVer : Integer): Boolean; stdcall;
external 'AVICAP32.DLL';

procedure TForm1.btnConnectClickClick(Sender: TObject);
const
str_Connect = 'Webカメラに接続';
str_Disconn = '接続解除';
begin
if (Sender as TButton).Caption = str_Connect then
begin
CaptureWnd := capCreateCaptureWindowA('0',
WS_CHILD or WS_VISIBLE, CaptureLeft, CaptureTop,
CaptureWidth, CaptureHeight,Handle,0);
if CaptureWnd<>0 then
begin
//デバイスへの接続
SendMessageA(CaptureWnd,WM_CAP_DRIVER_CONNECT,0,0);
//プレビュースケール
SendMessageA(CaptureWnd,WM_CAP_SET_SCALE,-1,0);
//プレビューのコマ数(ミリ秒)
SendMessageA(CaptureWnd,WM_CAP_SET_PREVIEWRATE,30,0);
// プレビュー開始
SendMessageA(CaptureWnd,WM_CAP_SET_PREVIEW,-1,0);
//
SetWindowPos(CaptureWnd,HWND_BOTTOM, 0, 0,
CaptureImage.Width,CaptureImage.Height,
SWP_NOMOVE or SWP_NOZORDER);

end;
(Sender as TButton).Caption:= str_Disconn

end
else
begin
//if CaptureWnd<>0 then
SendMessage(CaptureWnd,WM_CAP_DRIVER_DISCONNECT,0,0);
DestroyWindow(CaptureWnd);
CaptureWnd := 0;
(Sender as TButton).Caption:= str_Connect;

end
end;


いろいろと試行錯誤しながら思ったのは、カメラと同様にデスクトップの状況もキャプチャできないかということである。それができるソフトはいろいろあるので可能なのだろうが、WEBを探してかんたんに見つかるような情報はなかった。

上記の部分で、キャプチャ対象としてカメラのソースを指定しているところを、デスクトップにしてやればデスクトップがキャプチャできるのではないかと思った。

最初は capCreateCaptureWindowA で指定している Handleかなと思ったのだがこれは parentwindowつまりその上にカメラの映像が表示されるウィンドウのことだ。ためしにここを デスクトップにしてみるとデスクトップ上に表示された。

ただしこれは「ウィンドウ」なのでフォームの中のビットマップなどにアサインすることはできないようだ。

最初に指定している'0'はWindownameとなっているが、これを1に変えても動作に変わりはなかった。






posted by delsoli at 23:30| Comment(0) | delphi | 更新情報をチェックする

2012年11月16日

formを使いたくない

Wed Jan 18 16:45:26 2012

formを使う場合は、typeのところにfunctionやprocedureを宣言するが、
formを作らないと当然そこが有効にならないので、
functionやprocedureが使えない。

この辺はあいまいなままなんとなく慣習で過ぎちゃったとこなんだよな・・・

unitだけを追加することができるから、多分プロジェクトソースの
uses節にFormsを書かないでもいけるような気がするのだが・・・

ちなみにFormsを書かないと、Application.Initializeなどができない。

ApplicationとはFormありきのもののようだ。

unitのソース。
まぎれもなくFormを使用しているが、表示はされない。
ちなみにFormをcreateしても、AlphaBlendというプロパティをTrueにしてAlphaBlendValueを0にするとFormは透明になるので見えない。
見た目は変わらないが、多分、createしないほうが余計なことをしないよね・・・?
posted by delsoli at 18:54| delphi | 更新情報をチェックする