sakurasuite/sample_seeker/Unit1.pas

   1 unit Unit1;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
   7   SakuraSeeker, ComCtrls, Menus, ExtCtrls, StdCtrls, TestDSstp;
   8
   9 type
  10   TForm1 = class(TForm)
  11     ListView1: TListView;
  12     StatusBar1: TStatusBar;
  13     SakuraSeeker1: TSakuraSeeker;
  14     MainMenu1: TMainMenu;
  15     File1: TMenuItem;
  16     Update1: TMenuItem;
  17     Exit1: TMenuItem;
  18     Timer1: TTimer;
  19     Panel1: TPanel;
  20     Button1: TButton;
  21     TestDSstp1: TTestDSstp;
  22     Button2: TButton;
  23     procedure FormCreate(Sender: TObject);
  24     procedure Exit1Click(Sender: TObject);
  25     procedure Update1Click(Sender: TObject);
  26     procedure SakuraSeeker1AfterDetection(Sender: TObject);
  27     procedure SakuraSeeker1DetectResultChanged(Sender: TObject);
  28     procedure Timer1Timer(Sender: TObject);
  29     procedure Button1Click(Sender: TObject);
  30     procedure Button2Click(Sender: TObject);
  31   private
  32     { Private \90é\8c¾ }
  33   protected
  34     procedure GetMessage(var Message: TWMCopyData); message WM_COPYDATA;
  35   public
  36     { Public \90é\8c¾ }
  37     procedure Update;
  38   end;
  39
  40 var
  41   Form1: TForm1;
  42
  43 implementation
  44
  45 {$R *.DFM}
  46
  47 procedure TForm1.FormCreate(Sender: TObject);
  48 var SakuraSeeker: TSakuraSeeker;
  49 begin
  50   SakuraSeeker := TSakuraSeeker.Create(Self);
  51   SakuraSeeker.BeginDetect;
  52 end;
  53
  54 procedure TForm1.Exit1Click(Sender: TObject);
  55 begin
  56   Close;
  57 end;
  58
  59 procedure TForm1.Update1Click(Sender: TObject);
  60 begin
  61   SakuraSeeker1.BeginDetect;
  62   Update;
  63 end;
  64
  65 procedure TForm1.Update;
  66 var i: integer;
  67     Item: TListItem;
  68 begin
  69   ListView1.Items.Clear;
  70   for i := 0 to SakuraSeeker1.Count-1 do begin
  71     Item := ListView1.Items.Add;
  72     Item.Caption := SakuraSeeker1[i].ProcessID;
  73     Item.SubItems.Add(IntToStr(SakuraSeeker1[i].HWnd));
  74     Item.SubItems.Add(SakuraSeeker1[i].Name);
  75   end;
  76 end;
  77
  78 procedure TForm1.SakuraSeeker1AfterDetection(Sender: TObject);
  79 begin
  80   StatusBar1.SimpleText := IntToStr(SakuraSeeker1.Count) + '\8c\8f   ' +
  81   DateTimeToStr(Now);
  82   Update;
  83 end;
  84
  85 procedure TForm1.SakuraSeeker1DetectResultChanged(Sender: TObject);
  86 begin
  87   ShowMessage('Status Changed!');
  88 end;
  89
  90 procedure TForm1.Timer1Timer(Sender: TObject);
  91 begin
  92   SakuraSeeker1.BeginDetect;
  93 end;
  94
  95 procedure TForm1.Button1Click(Sender: TObject);
  96 var Target: THandle;
  97     Dat: TCopyDataStruct;
  98     Str: String;
  99 begin
 100   if ListView1.Selected = nil then Exit;
 101   Target := SakuraSeeker1[ListView1.Selected.Index].HWnd;
 102
 103   Str := 'SEND SSTP/1.4'#13#10'HWnd: '+IntToStr(Form1.Handle)+#13#10'Charset: Shift_JIS'#13#10 +
 104          'Sender: Tester'#13#10'Script: \t\82Ä\82·\82Ä\82·\81B\e'#13#10#13#10;
 105
 106   Dat.dwData := 9801;
 107   Dat.cbData := Length(Str);
 108   Dat.lpData := PChar(Str);
 109
 110   SendMessage(Target, WM_COPYDATA, Form1.Handle, LPARAM(@Dat));
 111
 112 end;
 113
 114 procedure TForm1.GetMessage(var Message: TWMCopyData);
 115 begin
 116   inherited;
 117   ShowMessage(PChar(Message.CopyDataStruct^.lpData));
 118 end;
 119
 120 procedure TForm1.Button2Click(Sender: TObject);
 121 begin
 122   if SakuraSeeker1.Count > 0 then
 123     TestDSstp1.Go(SakuraSeeker1[0].HWnd);
 124 end;
 125
 126 end.