bottleclient/FMOExplorer.pas

   1 unit FMOExplorer;
   2
   3 interface
   4
   5 uses
   6   Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
   7   Dialogs, ComCtrls, ImgList, ToolWin, ActnList,
   8   SakuraSeekerInstance, DirectSstp, Menus, Clipbrd;
   9
  10 type
  11   TfrmFMOExplorer = class(TForm)
  12     lvwList: TListView;
  13     ToolBar1: TToolBar;
  14     ImageList: TImageList;
  15     tbtnRestoreSurface: TToolButton;
  16     ToolButton2: TToolButton;
  17     tbtnKillFMO: TToolButton;
  18     tbtnRefresh: TToolButton;
  19     ActionList: TActionList;
  20     actKillFMO: TAction;
  21     actRestoreSurface: TAction;
  22     actRefresh: TAction;
  23     StatusBar: TStatusBar;
  24     DirectSstp: TDirectSstp;
  25     PopupMenu: TPopupMenu;
  26     mnKillFMO: TMenuItem;
  27     mnRestoreSurface: TMenuItem;
  28     ToolButton1: TToolButton;
  29     tbtnCopyInformation: TToolButton;
  30     actCopyInformation: TAction;
  31     mnSeparator: TMenuItem;
  32     mnCopyInformation: TMenuItem;
  33     procedure FormShow(Sender: TObject);
  34     procedure actRefreshExecute(Sender: TObject);
  35     procedure lvwListChange(Sender: TObject; Item: TListItem;
  36       Change: TItemChange);
  37     procedure actKillFMOExecute(Sender: TObject);
  38     procedure lvwListDblClick(Sender: TObject);
  39     procedure actCopyInformationExecute(Sender: TObject);
  40   private
  41     { Private \90é\8c¾ }
  42   public
  43     { Public \90é\8c¾ }
  44     procedure UpdateList;
  45   end;
  46
  47 var
  48   frmFMOExplorer: TfrmFMOExplorer;
  49
  50 implementation
  51
  52 const
  53   IconFMOEntry = 3;
  54   IconBrokenFMO = 4;
  55
  56 {$R *.dfm}
  57
  58 procedure TfrmFMOExplorer.FormShow(Sender: TObject);
  59 begin
  60   UpdateList;
  61 end;
  62
  63 procedure TfrmFMOExplorer.UpdateList;
  64 var i, j: integer;
  65     valid: boolean;
  66     HwndToVer, TmpStr: TStringList;
  67     s: String;
  68 begin
  69   lvwList.Clear;
  70   SakuraSeeker.BeginDetect;
  71   lvwList.Items.BeginUpdate;
  72   for i := 0 to SakuraSeeker.Count-1 do begin
  73     with lvwList.Items.Add do begin
  74       Caption := SakuraSeeker[i].SetName;
  75       SubItems.Add(SakuraSeeker[i].FMOName);
  76       SubItems.Add(SakuraSeeker[i].ProcessID);
  77       SubItems.Add(IntToStr(SakuraSeeker[i].HWnd));
  78       SubItems.Add('');
  79       SubItems.Add('?');
  80
  81       valid := (SakuraSeeker[i].Hwnd <> 0) and (SakuraSeeker[i].Name <> '')
  82         and (SakuraSeeker[i].KeroName <> '');
  83       if valid then
  84         ImageIndex := IconFMOEntry
  85       else
  86         ImageIndex := IconBrokenFMO;
  87         SubItems[4] := '\94j\91¹FMO';
  88     end;
  89   end;
  90   lvwList.Items.EndUpdate;
  91   StatusBar.Panels[0].Text := Format('%d\8c\8f', [SakuraSeeker.Count]);
  92
  93   HwndToVer := TStringList.Create;
  94   s := '';
  95   try
  96     for i := 0 to SakuraSeeker.Count-1 do begin
  97       s := HwndToVer.Values[IntToStr(SakuraSeeker[i].HWnd)];
  98       if s <> '' then begin
  99         lvwList.Items[i].SubItems[3] := s;
 100         lvwList.Items[i].SubItems[4] := '\90³\8fí';
 101       end else begin
 102         DirectSSTP.TargetHWnd := SakuraSeeker[i].HWnd;
 103         s := DirectSSTP.SstpEXECUTE('GetVersion');
 104         TmpStr := TStringList.Create;
 105         try
 106           TmpStr.Text := s;
 107           for j := 0 to TmpStr.Count-1 do
 108             if TmpStr[j] <> '' then begin
 109               s := TmpStr[j];
 110               Break;
 111             end;
 112         finally
 113           TmpStr.Free;
 114         end;
 115         if s <> '' then begin
 116           HwndToVer.Values[IntToStr(SakuraSeeker[i].HWnd)] := s;
 117           lvwList.Items[i].SubItems[3] := s;
 118           lvwList.Items[i].SubItems[4] := '\90³\8fí';
 119         end else begin
 120           lvwList.Items[i].SubItems[4] := '\89\9e\93\9a\82È\82µ';
 121           lvwList.Items[i].ImageIndex := IconBrokenFMO;
 122         end;
 123       end;
 124     end;
 125   finally
 126     HwndToVer.Free;
 127   end;
 128 end;
 129
 130 procedure TfrmFMOExplorer.actRefreshExecute(Sender: TObject);
 131 begin
 132   UpdateList;
 133 end;
 134
 135 procedure TfrmFMOExplorer.lvwListChange(Sender: TObject; Item: TListItem;
 136   Change: TItemChange);
 137 begin
 138   if Change <> ctState then Exit;
 139   actKillFMO.Enabled := lvwList.Selected <> nil;
 140   actCopyInformation.Enabled := lvwList.Selected <> nil;
 141 end;
 142
 143 procedure TfrmFMOExplorer.actKillFMOExecute(Sender: TObject);
 144 var i: integer;
 145 begin
 146   if lvwList.Selected = nil then Exit;
 147   for i := lvwList.Items.Count-1 downto 0 do
 148     if lvwList.Items[i].Selected and (SakuraSeeker.Process[i] <> nil) then begin
 149       SakuraSeeker.KillFMO(SakuraSeeker.Process[i].FMOName, SakuraSeeker.Process[i].ProcessID);
 150       lvwList.Items.Delete(i);
 151     end;
 152 end;
 153
 154 procedure TfrmFMOExplorer.lvwListDblClick(Sender: TObject);
 155 var i, index: integer;
 156     str: String;
 157 begin
 158   if lvwList.Selected = nil then Exit;
 159   index := lvwList.Selected.Index;
 160   for i := 0 to SakuraSeeker[index].Count-1 do begin
 161     if i > 0 then str := str + #13#10;
 162     str := str + SakuraSeeker[index].KeyAt[i] + ': ' + SakuraSeeker[index].DataAt[i];
 163   end;
 164   ShowMessage(str);
 165 end;
 166
 167 procedure TfrmFMOExplorer.actCopyInformationExecute(Sender: TObject);
 168 var
 169   Clip: TClipBoard;
 170   str: String;
 171   i, index: integer;
 172 begin
 173   if lvwList.Selected = nil then
 174     Exit;
 175   index := lvwList.Selected.Index;
 176   for i := 0 to SakuraSeeker[index].Count-1 do
 177   begin
 178     if i > 0 then str := str + #13#10;
 179     str := str + SakuraSeeker[index].KeyAt[i] + ': ' + SakuraSeeker[index].DataAt[i];
 180   end;
 181   Clip := ClipBoard();
 182   Clip.SetTextBuf(PChar(str));
 183 end;
 184
 185 initialization
 186
 187 frmFMOExplorer := nil;
 188
 189 end.