main.pas

一个很不错的系统信息控件

unit Main;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, MSI_DeviceMonitor;

type
  Twnd_dm_Main = class(TForm)
    Box: TListBox;
    Button1: TButton;
    DeviceMonitor: TMiTeC_DeviceMonitor;
    Button2: TButton;
    sd: TSaveDialog;
    cbxAll: TCheckBox;
    Button3: TButton;
    cbxACtive: TCheckBox;
    cbxUSB: TCheckBox;
    procedure FormCreate(Sender: TObject);
    procedure cbxACtiveClick(Sender: TObject);
    procedure DeviceMonitorDeviceDisconect(Sender: TObject;
      DeviceDesc: TDeviceDesc);
    procedure DeviceMonitorDeviceConnect(Sender: TObject;
      DeviceDesc: TDeviceDesc);
    procedure Button3Click(Sender: TObject);
    procedure BoxDrawItem(Control: TWinControl; Index: Integer; Rect: TRect;
      State: TOwnerDrawState);
    procedure Button2Click(Sender: TObject);
    procedure BoxDblClick(Sender: TObject);
    procedure DeviceMonitorVolumeDisconnect(Sender: TObject; Drive: Char;
      Remote: Boolean);
    procedure DeviceMonitorVolumeConnect(Sender: TObject; Drive: Char;
      Remote: Boolean);
    procedure DeviceMonitorMessage(Sender: TObject; Msg: TMessage);
    procedure Button1Click(Sender: TObject);
  private
  public
    procedure AddLog(AText: string);
  end;

var
  wnd_dm_Main: Twnd_dm_Main;

implementation

uses MiTeC_Dialogs, MiTeC_Routines;

{$R *.dfm}

procedure Twnd_dm_Main.AddLog(AText: string);
begin
  Box.Items.Add(Format('%s > %s',[DatetimetoStr(now),AText]));
  Box.ItemIndex:=Box.Items.Count-1;
end;

procedure Twnd_dm_Main.BoxDblClick(Sender: TObject);
var
  ts,t,s: string;
  p: Integer;
begin
  if Box.ItemIndex>-1 then begin
    s:=Box.Items[Box.ItemIndex];
    p:=Pos('>',s);
    ts:=Trim(Copy(s,1,p-1));
    t:=Trim(Copy(s,p+1,Length(s)));
    InputQuery(ts,'',t);
  end;
end;

procedure Twnd_dm_Main.BoxDrawItem(Control: TWinControl; Index: Integer;
  Rect: TRect; State: TOwnerDrawState);
var
  R: TRect;
  pc,fc: TColor;
  ts,t: string;
  b: Boolean;
  p: Integer;
begin
  inherited;
  with TListBox(Control) do begin
    p:=Pos('>',Items[Index]);
    ts:=Trim(Copy(Items[Index],1,p-1));
    t:=Trim(Copy(Items[Index],p+1,Length(Items[Index])));
    p:=Pos('*',t);
    b:=p=0;
    if p=1 then
      t:=Copy(t,2,Length(t));
    Canvas.FillRect(Rect);
    fc:=Canvas.Font.Color;
    pc:=Canvas.Pen.Color;
    if not(odSelected in State) then
      Canvas.Font.Color:=clGray;
    CopyRect(R,Rect);
    R.Right:=110;
//    Canvas.FillRect(R);
    if not(odSelected in State) then
      Canvas.Pen.Color:=clGray
    else
      Canvas.Pen.Color:=clWhite;
    Canvas.MoveTo(R.Right,R.Top);
    Canvas.LineTo(R.Right,R.Bottom);
    Canvas.Pen.Color:=pc;
    Canvas.TextOut(Rect.Left+3,Rect.Top+(ItemHeight-Canvas.TextHeight(ts)) div 2,ts);
    Canvas.Font.Color:=fc;
    if b then
      Canvas.Font.Style:=[fsBold];
    Canvas.TextOut(Rect.Left+120,Rect.Top+(ItemHeight-Canvas.TextHeight(t)) div 2,t);
  end;
end;

procedure Twnd_dm_Main.Button1Click(Sender: TObject);
begin
  Close;
end;

procedure Twnd_dm_Main.Button2Click(Sender: TObject);
begin
  sd.FileName:=ChangeFileExt(Application.ExeName,'.log');
  if sd.Execute then
    Box.Items.SaveToFile(sd.Filename);
end;

procedure Twnd_dm_Main.Button3Click(Sender: TObject);
begin
  if YesNo('Clear log?') then
    Box.Items.Clear;
end;

procedure Twnd_dm_Main.cbxACtiveClick(Sender: TObject);
begin
  DeviceMonitor.Active:=cbxActive.Checked;
end;

procedure Twnd_dm_Main.DeviceMonitorDeviceConnect(Sender: TObject;
  DeviceDesc: TDeviceDesc);
begin
  if cbxUSB.Checked and not SameText(DeviceDesc.GUID,GUIDToString(GUID_DEVINTERFACE_USB_DEVICE)) then
    Exit;
  if DeviceDesc.Name<>'' then
    AddLog(Format('%s (%s) connected.',[DeviceDesc.Location,DeviceDesc.Name]))
  else if DeviceDesc.Description<>'' then
    AddLog(Format('%s (%s) connected.',[DeviceDesc.Location,DeviceDesc.Description]))
  else if DeviceDesc.SymbolicName<>'' then
    AddLog(Format('Device (%s) connected.',[ExtractFilename(Uppercase(DeviceDesc.SymbolicName))]))
  else
    AddLog('Device connected.');
end;

procedure Twnd_dm_Main.DeviceMonitorDeviceDisconect(Sender: TObject;
  DeviceDesc: TDeviceDesc);
begin
  if cbxUSB.Checked and not SameText(DeviceDesc.GUID,GUIDToString(GUID_DEVINTERFACE_USB_DEVICE)) then
    Exit;
  if DeviceDesc.Name<>'' then
    AddLog(Format('%s (%s) disconnected.',[DeviceDesc.Location,DeviceDesc.Name]))
  else if DeviceDesc.Description<>'' then
    AddLog(Format('%s (%s) disconnected.',[DeviceDesc.Location,DeviceDesc.Description]))
  else if DeviceDesc.SymbolicName<>'' then
    AddLog(Format('Device (%s) disconnected.',[DeviceDesc.SymbolicName]))
  else
    AddLog('Device disconnected.');
end;

procedure Twnd_dm_Main.DeviceMonitorMessage(Sender: TObject;
  Msg: TMessage);
var
  m,d: string;
begin
  if not cbxAll.Checked then
    Exit;
  m:=GetMessageType(Msg.wParam);
  case Msg.wParam of
    DBT_DEVICEARRIVAL..DBT_DEVICETYPESPECIFIC: begin
      d:=GetDeviceType(PDevBroadcastHdr(Msg.lParam).dbch_devicetype);
      case PDevBroadcastHdr(Msg.lParam).dbch_devicetype of
        DBT_DEVTYP_OEM,
        DBT_DEVTYP_DEVNODE,
        DBT_DEVTYP_PORT: AddLog(Format('*%s - %s',[m,d]));
        DBT_DEVTYP_VOLUME: AddLog(Format('*%s - %s - 0x%x - 0x%x',[m,d,
                                                              PDevBroadcastVolume(Msg.lParam).dbcv_unitmask,
                                                              PDevBroadcastVolume(Msg.lParam).dbcv_flags]));
        DBT_DEVTYP_NET: AddLog(Format('*%s - %s - 0x%x',[m,d,PDevBroadcastNet(Msg.lParam).dbcn_resource]));
        DBT_DEVTYP_DEVICEINTERFACE:
          try
            AddLog(Format('*%s - %s - %s - %s',[m,d,
                                          string(PChar(@PDevBroadcastDeviceInterface(Msg.lParam).dbcc_name)),
                                          GUIDToString(PDevBroadcastDeviceInterface(Msg.lParam).dbcc_classguid)]));
          except
            AddLog(Format('*%s - %s',[m,d]));
          end;
        else AddLog(Format('*%s - %s',[m,d]));
      end;
    end;
    else AddLog(Format('*%s - 0x%x',[m,Msg.lParam]));
  end;
end;

procedure Twnd_dm_Main.DeviceMonitorVolumeConnect(Sender: TObject; Drive: Char;
  Remote: Boolean);
begin
  if Remote then
    AddLog(Format('Network drive %s: connected.',[Drive]))
  else
    AddLog(Format('Drive %s: connected.',[Drive]));
end;

procedure Twnd_dm_Main.DeviceMonitorVolumeDisconnect(Sender: TObject;
  Drive: Char; Remote: Boolean);
begin
  if Remote then
    AddLog(Format('Network drive %s: disconnected.',[Drive]))
  else
    AddLog(Format('Drive %s: disconnected.',[Drive]));
end;

procedure Twnd_dm_Main.FormCreate(Sender: TObject);
begin
  cbxUSB.Enabled:=IsXP;
end;

end.