在DELPHI中，无窗体的程序如何获取系统关机或注销的消息
写一个类，给类分配一个窗口句柄，然后在窗口过程里查询关机或注销消息，然后再显示；不明白可以参考TTimer类
给你个例子吧，两个单元，拿回去保存编译一下就行了：
program NoFormMsg;
uses
SysUtils,
Windows,
Messages,
Classes,
NoFormMsgCls in ’NoFormMsgCls.pas’;
var
MyNoForm: TNoFormMsgCls;
msg: tagMsg;
begin
{ TODO -oUser -cConsole Main : Insert code here }
MyNoForm := TNoFormMsgCls.Crerte;
try
while True do begin
PeekMessage(msg, MyNoForm.Handle, 0, 0, PM_NOREMOVE);
if msg.message = WM_CLOSE then break;
TranslateMessage(msg);
DispatchMessage(msg);
Sleep(1);
end;
finally
MyNoForm.Free;
end;
end.
unit NoFormMsgCls;
interface
uses
Windows, Classes, Messages, SysUtils;
type
TNoFormMsgCls = class
private
FHandle: THandle;
procedure WndProc(var msg: TMessage);
public
constructor Crerte();
destructor Destroy(); override;
property Handle: THandle read FHandle;
end;
implementation
{ TNoFormMsgCls }
constructor TNoFormMsgCls.Crerte;
begin
FHandle := Classes.AllocateHWnd(WndProc);
end;
destructor TNoFormMsgCls.Destroy;
begin
Classes.DeallocateHWnd(FHandle);
inherited;
end;
procedure TNoFormMsgCls.WndProc(var msg: TMessage);
begin
with Msg do
if Msg = WM_QUERYENDSESSION then begin
if (LParam and ENDSESSION_LOGOFF) 》 0 then begin
Result := 0;
MessageBox(FHandle, ’注销啦！’, ’结束任务’, MB_OK);
//PostMessage(FHandle, WM_CLOSE, 0, 0);
end
else begin
Result := 0;
MessageBox(FHandle, ’关机啦！’, ’结束任务’, MB_OK);
//PostMessage(FHandle, WM_CLOSE, 0, 0);
end;
end
else
Result := DefWindowProc(FHandle, Msg, wParam, lParam);
end;
end.
delphi托盘弹出信息
你用的什么版本的Delphi啊？Delphi2005以上系统已经自带的托盘控件，如果是之前版本的，可以找第三方控件,下面的代码是Delphi2006自带的控件的源码，你可以保存成文件，直接引用，也可以注册成控件，直接放控件到Form上：
TCustomTrayIcon = class(TComponent)
private
FAnimate: Boolean;
FData: TNotifyIconData;
FIsClicked: Boolean;
FCurrentIcon: TIcon;
FIcon: TIcon;
FIconList: TImageList;
FPopupMenu: TPopupMenu;
FTimer: TTimer;
FHint: String;
FIconIndex: Integer;
FVisible: Boolean;
FOnMouseMove: TMouseMoveEvent;
FOnClick: TNotifyEvent;
FOnDblClick: TNotifyEvent;
FOnMouseDown: TMouseEvent;
FOnMouseUp: TMouseEvent;
FOnAnimate: TNotifyEvent;
FBalloonHint: string;
FBalloonTitle: string;
FBalloonFlags: TBalloonFlags;
class var
RM_TaskbarCreated: DWORD;
protected
procedure SetHint(const Value: string);
function GetAnimateInterval: Cardinal;
procedure SetAnimateInterval(Value: Cardinal);
procedure SetAnimate(Value: Boolean);
procedure SetBalloonHint(const Value: string);
function GetBalloonTimeout: Integer;
procedure SetBalloonTimeout(Value: Integer);
procedure SetBalloonTitle(const Value: string);
procedure SetVisible(Value: Boolean); virtual;
procedure SetIconIndex(Value: Integer); virtual;
procedure SetIcon(Value: TIcon);
procedure SetIconList(Value: TImageList);
procedure WindowProc(var Message: TMessage); virtual;
procedure DoOnAnimate(Sender: TObject); virtual;
property Data: TNotifyIconData read FData;
function Refresh(Message: Integer): Boolean; overload;
public
constructor Create(Owner: TComponent); override;
destructor Destroy; override;
procedure Refresh; overload;
procedure SetDefaultIcon;
procedure ShowBalloonHint; virtual;
property Animate: Boolean read FAnimate write SetAnimate default False;
property AnimateInterval: Cardinal read GetAnimateInterval write SetAnimateInterval default 1000;
property Hint: string read FHint write SetHint;
property BalloonHint: string read FBalloonHint write SetBalloonHint;
property BalloonTitle: string read FBalloonTitle write SetBalloonTitle;
property BalloonTimeout: Integer read GetBalloonTimeout write SetBalloonTimeout default 3000;
property BalloonFlags: TBalloonFlags read FBalloonFlags write FBalloonFlags default bfNone;
property Icon: TIcon read FIcon write SetIcon;
property Icons: TImageList read FIconList write SetIconList;
property IconIndex: Integer read FIconIndex write SetIconIndex default 0;
property PopupMenu: TPopupMenu read FPopupMenu write FPopupMenu;
property Visible: Boolean read FVisible write SetVisible default False;
property OnClick: TNotifyEvent read FOnClick write FOnClick;
property OnDblClick: TNotifyEvent read FOnDblClick write FOnDblClick;
property OnMouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove;
property OnMouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp;
property OnMouseDown: TMouseEvent read FOnMouseDown write FOnMouseDown;
property OnAnimate: TNotifyEvent read FOnAnimate write FOnAnimate;
end;
TTrayIcon = class(TCustomTrayIcon)
published
property Animate;
property AnimateInterval;
property Hint;
property BalloonHint;
property BalloonTitle;
property BalloonTimeout;
property BalloonFlags;
property Icon;
property Icons;
property IconIndex;
property PopupMenu;
property Visible;
property OnClick;
property OnDblClick;
property OnMouseMove;
property OnMouseUp;
property OnMouseDown;
property OnAnimate;
end;
{ TTrayIcon}
constructor TCustomTrayIcon.Create(Owner: TComponent);
begin
inherited;
FAnimate := False;
FBalloonFlags := bfNone;
BalloonTimeout := 3000;
FIcon := TIcon.Create;
FCurrentIcon := TIcon.Create;
FTimer := TTimer.Create(Nil);
FIconIndex := 0;
FVisible := False;
FIsClicked := False;
FTimer.Enabled := False;
FTimer.OnTimer := DoOnAnimate;
FTimer.Interval := 1000;
if not (csDesigning in ComponentState) then
begin
FillChar(FData, SizeOf(FData), 0);
FData.cbSize := SizeOf(FData);
FData.Wnd := Classes.AllocateHwnd(WindowProc);
FData.uID := FData.Wnd;
FData.uTimeout := 3000;
FData.hIcon := FCurrentIcon.Handle;
FData.uFlags := NIF_ICON or NIF_MESSAGE;
FData.uCallbackMessage := WM_SYSTEM_TRAY_MESSAGE;
StrPLCopy(FData.szTip, Application.Title, SizeOf(FData.szTip) – 1);
if Length(Application.Title) 》 0 then
FData.uFlags := FData.uFlags or NIF_TIP;
Refresh;
end;
end;
destructor TCustomTrayIcon.Destroy;
begin
if not (csDesigning in ComponentState) then
Refresh(NIM_DELETE);
FCurrentIcon.Free;
FIcon.Free;
FTimer.Free;
Classes.DeallocateHWnd(FData.Wnd);
inherited;
end;
procedure TCustomTrayIcon.SetVisible(Value: Boolean);
begin
if FVisible 《》 Value then
begin
FVisible := Value;
if (not FAnimate) or (FAnimate and FCurrentIcon.Empty) then
SetDefaultIcon;
if not (csDesigning in ComponentState) then
begin
if FVisible then
begin
if not Refresh(NIM_ADD) then
raise EOutOfResources.Create(STrayIconCreateError);
end
else if not (csLoading in ComponentState) then
begin
if not Refresh(NIM_DELETE) then
raise EOutOfResources.Create(STrayIconRemoveError);
end;
if FAnimate then
FTimer.Enabled := Value;
end;
end;
end;
procedure TCustomTrayIcon.SetIconList(Value: TImageList);
begin
if FIconList 《》 Value then
begin
FIconList := Value;
if not (csDesigning in ComponentState) then
begin
if Assigned(FIconList) then
FIconList.GetIcon(FIconIndex, FCurrentIcon)
else
SetDefaultIcon;
Refresh;
end;
end;
end;
procedure TCustomTrayIcon.SetHint(const Value: string);
begin
if CompareStr(FHint, Value) 《》 0 then
begin
FHint := Value;
StrPLCopy(FData.szTip, FHint, SizeOf(FData.szTip) – 1);
if Length(Hint) 》 0 then
FData.uFlags := FData.uFlags or NIF_TIP
else
FData.uFlags := FData.uFlags and not NIF_TIP;
Refresh;
end;
end;
function TCustomTrayIcon.GetAnimateInterval: Cardinal;
begin
Result := FTimer.Interval;
end;
procedure TCustomTrayIcon.SetAnimateInterval(Value: Cardinal);
begin
FTimer.Interval := Value;
end;
procedure TCustomTrayIcon.SetAnimate(Value: Boolean);
begin
if FAnimate 《》 Value then
begin
FAnimate := Value;
if not (csDesigning in ComponentState) then
begin
if (FIconList 《》 nil) and (FIconList.Count 》 0) and Visible then
FTimer.Enabled := Value;
if (not FAnimate) and (not FCurrentIcon.Empty) then
FIcon.Assign(FCurrentIcon);
end;
end;
end;
{ Message handler for the hidden shell notification window. Most messages
use WM_SYSTEM_TRAY_MESSAGE as the Message ID, with WParam as the ID of the
shell notify icon data. LParam is a message ID for the actual message, e.g.,
WM_MOUSEMOVE. Another important message is WM_ENDSESSION, telling the shell
notify icon to delete itself, so Windows can shut down.
Send the usual events for the mouse messages. Also interpolate the OnClick
event when the user clicks the left button, and popup the menu, if there is
one, for right click events. }
procedure TCustomTrayIcon.WindowProc(var Message: TMessage);
{ Return the state of the shift keys. }
function ShiftState: TShiftState;
begin
Result := ;
if GetKeyState(VK_SHIFT) 《 0 then
Include(Result, ssShift);
if GetKeyState(VK_CONTROL) 《 0 then
Include(Result, ssCtrl);
if GetKeyState(VK_MENU) 《 0 then
Include(Result, ssAlt);
end;
var
Point: TPoint;
Shift: TShiftState;
begin
case Message.Msg of
WM_QUERYENDSESSION:
Message.Result := 1;
WM_ENDSESSION:
begin
if TWmEndSession(Message).EndSession then
Refresh(NIM_DELETE);
end;
WM_SYSTEM_TRAY_MESSAGE:
begin
case Message.lParam of
WM_MOUSEMOVE:
begin
if Assigned(FOnMouseMove) then
begin
Shift := ShiftState;
GetCursorPos(Point);
FOnMouseMove(Self, Shift, Point.X, Point.Y);
end;
end;
WM_LBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
FOnMouseDown(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
FIsClicked := True;
end;
WM_LBUTTONUP:
begin
Shift := ShiftState + [ssLeft];
GetCursorPos(Point);
if FIsClicked and Assigned(FOnClick) then
begin
FOnClick(Self);
FIsClicked := False;
end;
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, mbLeft, Shift, Point.X, Point.Y);
end;
WM_RBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
FOnMouseDown(Self, mbRight, Shift, Point.X, Point.Y);
end;
end;
WM_RBUTTONUP:
begin
Shift := ShiftState + [ssRight];
GetCursorPos(Point);
if Assigned(FOnMouseUp) then
FOnMouseUp(Self, mbRight, Shift, Point.X, Point.Y);
if Assigned(FPopupMenu) then
begin
SetForegroundWindow(Application.Handle);
Application.ProcessMessages;
FPopupMenu.AutoPopup := False;
FPopupMenu.PopupComponent := Owner;
FPopupMenu.Popup(Point.x, Point.y);
end;
end;
WM_LBUTTONDBLCLK, WM_MBUTTONDBLCLK, WM_RBUTTONDBLCLK:
if Assigned(FOnDblClick) then
FOnDblClick(Self);
WM_MBUTTONDOWN:
begin
if Assigned(FOnMouseDown) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseDown(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
end;
WM_MBUTTONUP:
begin
if Assigned(FOnMouseUp) then
begin
Shift := ShiftState + [ssMiddle];
GetCursorPos(Point);
FOnMouseUp(Self, mbMiddle, Shift, Point.X, Point.Y);
end;
end;
NIN_BALLOONHIDE, NIN_BALLOONTIMEOUT:
begin
FData.uFlags := FData.uFlags and not NIF_INFO;
end;
end;
end;
else if (Message.Msg = RM_TaskBarCreated) and Visible then
Refresh(NIM_ADD);
end;
end;
procedure TCustomTrayIcon.Refresh;
begin
if not (csDesigning in ComponentState) then
begin
FData.hIcon := FCurrentIcon.Handle;
if Visible then
Refresh(NIM_MODIFY);
end;
end;
function TCustomTrayIcon.Refresh(Message: Integer): Boolean;
begin
Result := Shell_NotifyIcon(Message, @FData);
end;
procedure TCustomTrayIcon.SetIconIndex(Value: Integer);
begin
if FIconIndex 《》 Value then
begin
FIconIndex := Value;
if not (csDesigning in ComponentState) then
begin
if Assigned(FIconList) then
FIconList.GetIcon(FIconIndex, FCurrentIcon);
Refresh;
end;
end;
end;
procedure TCustomTrayIcon.DoOnAnimate(Sender: TObject);
begin
if Assigned(FOnAnimate) then
FOnAnimate(Self);
if Assigned(FIconList) and (FIconIndex 《 FIconList.Count – 1) then
IconIndex := FIconIndex + 1
else
IconIndex := 0;
Refresh;
end;
procedure TCustomTrayIcon.SetIcon(Value: TIcon);
begin
FIcon.Assign(Value);
FCurrentIcon.Assign(Value);
Refresh;
end;
procedure TCustomTrayIcon.SetBalloonHint(const Value: string);
begin
if CompareStr(FBalloonHint, Value) 《》 0 then
begin
FBalloonHint := Value;
StrPLCopy(FData.szInfo, FBalloonHint, SizeOf(FData.szInfo) – 1);
Refresh(NIM_MODIFY);
end;
end;
procedure TCustomTrayIcon.SetDefaultIcon;
begin
if not FIcon.Empty then
FCurrentIcon.Assign(FIcon)
else
FCurrentIcon.Assign(Application.Icon);
Refresh;
end;
procedure TCustomTrayIcon.SetBalloonTimeout(Value: Integer);
begin
FData.uTimeout := Value;
end;
function TCustomTrayIcon.GetBalloonTimeout: Integer;
begin
Result := FData.uTimeout;
end;
procedure TCustomTrayIcon.ShowBalloonHint;
begin
FData.uFlags := FData.uFlags or NIF_INFO;
FData.dwInfoFlags := Integer(FBalloonFlags);
Refresh(NIM_MODIFY);
end;
procedure TCustomTrayIcon.SetBalloonTitle(const Value: string);
begin
if CompareStr(FBalloonTitle, Value) 《》 0 then
begin
FBalloonTitle := Value;
StrPLCopy(FData.szInfoTitle, FBalloonTitle, SizeOf(FData.szInfoTitle) – 1);
Refresh(NIM_MODIFY);
end;
end;
initialization
// 这段代码是为了让通知窗口重建的时候通知应用程序
TCustomTrayIcon.RM_TaskBarCreated := RegisterWindowMessage(’TaskbarCreated’);
delphi最小化
点最小化的时候，直接隐藏窗口，用下面的代码实现：
procedure WMSysCommand(var Message: TWMSysCommand);message WM_SYSCOMMAND;//响应WM_SYSCOMMAND消息，当最小化的时候隐藏
procedure TYMessageMainForm.WMSysCommand(var Message: TWMSysCommand);
begin
if (Message.CmdType and $FFF0 = SC_MINIMIZE) or (Message.CmdType and $FFF0 = SC_CLOSE) then
begin //把最小化当隐藏处理
YMessageMainForm.Hide;
ShowWindow(Application.Handle, SW_HIDE);
end else Inherited;//调用上级类的处理
end;
在系统栏放一个图表，让鼠标单击、双击、右键实现一定的功能，使用下面的代码实现：
{$WARN SYMBOL_DEPRECATED OFF}
unit TrayIcon;
interface
uses
SysUtils, Windows, Messages, Classes, Graphics, Controls, ShellAPI, Forms, menus;
const WM_TOOLTRAYICON = WM_USER+1;
WM_RESETTOOLTIP = WM_USER+2;
type
TTrayIcon = class(TComponent)
private
{ Field Variables }
IconData: TNOTIFYICONDATA;
fIcon : TIcon;
fToolTip : String;
fWindowHandle : HWND;
fActive : boolean;
fShowDesigning : Boolean;
{ Events }
fOnClick : TNotifyEvent;
fOnDblClick : TNotifyEvent;
fOnRightClick : TMouseEvent;
fPopupMenu : TPopupMenu;
function AddIcon : boolean;
function ModifyIcon : boolean;
function DeleteIcon : boolean;
procedure SetActive(Value : boolean);
procedure SetShowDesigning(Value : boolean);
procedure SetIcon(Value : TIcon);
procedure SetToolTip(Value : String);
procedure WndProc(var msg : TMessage);
procedure FillDataStructure;
procedure DoRightClick( Sender : TObject );
protected
public
constructor create(aOwner : TComponent); override;
destructor destroy; override;
published
property Active : boolean read fActive write SetActive;
property ShowDesigning : boolean read fShowDesigning write SetShowDesigning;
property Icon : TIcon read fIcon write SetIcon;
property ToolTip : string read fTooltip write SetToolTip;
property OnClick : TNotifyEvent read FOnClick write FOnClick;
property OnDblClick : TNotifyEvent read FOnDblClick write FOnDblClick;
property OnRightClick : TMouseEvent read FOnRightClick write FonRightClick;
property PopupMenu : TPopupMenu read fPopupMenu write fPopupMenu;
end;
procedure Register;
implementation
{$R TrayIcon.res}
procedure TTrayIcon.SetActive(Value : boolean);
begin
if value 《》 fActive then begin
fActive := Value;
if not (csdesigning in ComponentState) then begin
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;
procedure TTrayIcon.SetShowDesigning(Value : boolean);
begin
if csdesigning in ComponentState then begin
if value 《》 fShowDesigning then begin
fShowDesigning := Value;
if Value then begin
AddIcon;
end else begin
DeleteIcon;
end;
end;
end;
end;
procedure TTrayIcon.SetIcon(Value : Ticon);
begin
if Value 《》 fIcon then
begin
fIcon.Assign(value);
ModifyIcon;
end;
end;
procedure TTrayIcon.SetToolTip(Value : string);
begin
// This routine ALWAYS re-sets the field value and re-loads the
// icon. This is so the ToolTip can be set blank when the component
// is first loaded. If this is changed, the icon will be blank on
// the tray when no ToolTip is specified.
if length( Value ) 》 62 then
Value := copy(Value,1,62);
fToolTip := value;
ModifyIcon;
end;
constructor TTrayIcon.create(aOwner : Tcomponent);
begin
inherited create(aOwner);
FWindowHandle := AllocateHWnd( WndProc );
FIcon := TIcon.Create;
end;
destructor TTrayIcon.destroy;
begin
if (not (csDesigning in ComponentState) and fActive)
or ((csDesigning in ComponentState) and fShowDesigning) then
DeleteIcon;
FIcon.Free;
DeAllocateHWnd( FWindowHandle );
inherited destroy;
end;
procedure TTrayIcon.FillDataStructure;
begin
with IconData do begin
cbSize := sizeof(TNOTIFYICONDATA);
wnd := FWindowHandle;
uID := 0; // is not passed in with message so make it 0
uFlags := NIF_MESSAGE + NIF_ICON + NIF_TIP;
hIcon := fIcon.Handle;
StrPCopy(szTip,fToolTip);
uCallbackMessage := WM_TOOLTRAYICON;
end;
end;
function TTrayIcon.AddIcon : boolean;
begin
FillDataStructure;
result := Shell_NotifyIcon(NIM_ADD,@IconData);
// For some reason, if there is no tool tip set up, then the icon
// doesn’t display. This fixes that.
if fToolTip = ’’ then
PostMessage( fWindowHandle, WM_RESETTOOLTIP,0,0 );
end;
function TTrayIcon.ModifyIcon : boolean;
begin
FillDataStructure;
if fActive then
result := Shell_NotifyIcon(NIM_MODIFY,@IconData)
else
result := True;
end;
procedure TTrayIcon.DoRightClick( Sender : TObject );
var MouseCo: Tpoint;
begin
GetCursorPos(MouseCo);
if assigned( fPopupMenu ) then begin
SetForegroundWindow( Application.Handle );
Application.ProcessMessages;
fPopupmenu.Popup( Mouseco.X, Mouseco.Y );
end;
if assigned( FOnRightClick ) then
begin
FOnRightClick(self,mbRight,,MouseCo.x,MouseCo.y);
end;
end;
function TTrayIcon.DeleteIcon : boolean;
begin
result := Shell_NotifyIcon(NIM_DELETE,@IconData);
end;
procedure TTrayIcon.WndProc(var msg : TMessage);
begin
with msg do
if (msg = WM_RESETTOOLTIP) then
SetToolTip( fToolTip )
else if (msg = WM_TOOLTRAYICON) then begin
case lParam of
WM_LBUTTONDBLCLK : if assigned (FOnDblClick) then FOnDblClick(self);
WM_LBUTTONUP : if assigned(FOnClick)then FOnClick(self);
WM_RBUTTONUP : DoRightClick(self);
end;
end
else // Handle all messages with the default handler
Result := DefWindowProc(FWindowHandle, Msg, wParam, lParam);
end;
procedure Register;
begin
RegisterComponents(’Win95’, [TTrayIcon]);
end;
end.
如何得到其他程序的Richedit中的RTF数据
uses RichEdit;
{$WARN SYMBOL_DEPRECATED OFF}
type
TRichEditStreamReader = class
private
FStream: TStream;
FHandle: THandle;
protected
procedure WndProc(var Message: TMessage); virtual;
public
constructor Create(AStream: TStream);
destructor Destroy; override;
property Handle: THandle read FHandle;
end;
{ TRichEditStreamReader }
constructor TRichEditStreamReader.Create(AStream: TStream);
begin
FStream := AStream;
FHandle := AllocateHWnd(WndProc);
end;
destructor TRichEditStreamReader.Destroy;
begin
DeallocateHWnd(FHandle);
inherited;
end;
procedure TRichEditStreamReader.WndProc(var Message: TMessage);
begin
case Message.Msg of
WM_COPYDATA:
begin
if not Assigned(FStream) then Exit;
FStream.Write(PCopyDataStruct(Message.LParam)^.lpData^,
PCopyDataStruct(Message.LParam)^.cbData);
end;
end;
end;
function Process_ReadRichEditStream(
AHandle: THandle; AStream: TStream; AFormat: Longword): Boolean;
type
TVclApi = packed record //JMP DWORD PTR [$HHHHHHHH]
rJmp: Word; // FF 25
rAddress: PInteger; // API实际地址
end;
PVclApi = ^TVclApi;
const
EditStreamCallBackBytes =
#$55 + // PUSH EBP
#$8B#$EC + // MOV EBP,ESP
#$83#$C4#$F4 + // ADD ESP,$F4
#$8B#$45#$10 + // MOV EAX,DWORD PTR [EBP+$10]
#$8B#$55#$14 + // MOV EDX,DWORD PTR [EBP+$14]
#$89#$02 + // MOV DWORD PTR [EDX],EAX
#$33#$D2 + // XOR EDX,EDX
#$89#$55#$F4 + // MOV DWORD PTR [EBP-$0C],EDX
#$89#$45#$F8 + // MOV DWORD PTR [EBP-$08],EAX
#$8B#$45#$0C + // MOV EAX,DWORD PTR [EBP+$0C]
#$89#$45#$FC + // MOV DWORD PTR [EBP-$04],EAX
#$8D#$45#$F4 + // LEA EAX,DWORD PTR [EBP-$0C]
#$50 + // PUSH EAX
#$6A#$00 + // PUSH $00
#$6A#$4A + // PUSH $4A
#$8B#$45#$08 + // MOV EAX,DWORD PTR [EBP+$08]
#$50 + // PUSH EAX
#$FF#$15#$00#$00#$00#$00 + // CALL DWORD PTR [H] — String Index:43
#$33#$C0 + // XOR EAX,EAX
#$8B#$E5 + // MOV ESP,EBP
#$5D + // POP EBP
#$C2#$10#$00 + // RET $0010
#$00#$00#$00#$00 + // Api Address — String Index:55
#$00#$00#$00#$00 + // _editstream : dwCookie — String Index:59
#$00#$00#$00#$00 + // _editstream : dwError
#$00#$00#$00#$00; // _editstream : pfnCallback
type
PEditStream = ^TEditStream;
var
vEditStreamCallBack: string;
vProcessId: DWORD;
vProcess: THandle;
vPointer: Pointer;
vNumberOfBytesRead: Cardinal;
vRichEditStreamReader: TRichEditStreamReader;
begin
Result := False;
if not Assigned(AStream) then Exit;
if not IsWindow(AHandle) then Exit;
GetWindowThreadProcessId(AHandle, @vProcessId);
vProcess := OpenProcess(PROCESS_VM_OPERATION or PROCESS_VM_READ or
PROCESS_VM_WRITE, False, vProcessId);
try
vPointer := VirtualAllocEx(vProcess, nil, 4096, MEM_RESERVE or MEM_COMMIT,
PAGE_READWRITE);
vRichEditStreamReader := TRichEditStreamReader.Create(AStream);
try
vEditStreamCallBack := EditStreamCallBackBytes;
PInteger(@vEditStreamCallBack)^ := Integer(vPointer) + 55 – 1;
PInteger(@vEditStreamCallBack)^ := PVclApi(@SendMessage)^.rAddress^;
PEditStream(@vEditStreamCallBack)^.dwCookie := vRichEditStreamReader.Handle;
PEditStream(@vEditStreamCallBack)^.pfnCallback := vPointer;
WriteProcessMemory(vProcess, vPointer, @vEditStreamCallBack,
Length(vEditStreamCallBack), vNumberOfBytesRead);
SendMessage(AHandle, EM_STREAMOUT, AFormat, Integer(Integer(vPointer) + 59 – 1));
finally
vRichEditStreamReader.Free;
VirtualFreeEx(vProcess, vPointer, 0, MEM_RELEASE);
end;
finally
CloseHandle(vProcess);
end;
end; { Process_ReadRichEditStream }
procedure TForm1.Button1Click(Sender: TObject);
var
vHandle: THandle;
vMemoryStream: TMemoryStream;
begin
vHandle := FindWindow(’WordPadClass’, nil);
if vHandle = 0 then Exit;
vHandle := FindWindowEx(vHandle, 0, ’RICHEDIT50W’, nil);
if vHandle = 0 then Exit;
vMemoryStream := TMemoryStream.Create;
try
Process_ReadRichEditStream(vHandle, vMemoryStream, SF_RTF);
vMemoryStream.Position := 0;
RichEdit1.PlainText := False;
RichEdit1.Lines.LoadFromStream(vMemoryStream);
finally
vMemoryStream.Free;
end;
end;
delphi usb拔除的是哪个guid
delphi 获取USB口拔出和插入的状态
unit USBDeviceNotify
//USB Device arrival or remove
interface
use
Windows, Messages, SysUtils, Classes, Form
type
PDevBroadcastHdr = ^DEV_BROADCAST_HDR
DEV_BROADCAST_HDR = packed record
dbch_size: DWORD
dbch_devicetype: DWORD
dbch_reserved: DWORD
end
PDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACE
DEV_BROADCAST_DEVICEINTERFACE = record
dbcc_size: DWORD
dbcc_devicetype: DWORD
dbcc_reserved: DWORD
dbcc_classguid: TGUID
dbcc_name: short
end
const
GUID_DEVINTERFACE_USB_DEVICE: TGUID = ’{A5DCBF10-6530-11D2-901F-00C04FB951ED}’
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface cla
type
TUSBDeviceEvent = procedure(Sender: TObject; pDeviceData: PDevBroadcastDeviceInterface) of object
TUSBDeviceNotify = class(TComponent)
rivate
FWindowHandle: HWND
FOnUSBArrival: TUSBDeviceEvent
FOnUSBRemove: TUSBDeviceEvent
rocedure WndProc(var Msg: TMessage)
function USBRegister: Boolea
rotected
rocedure WMDeviceChange(var Msg: TMessage); dynamic
ublic
constructor Create(AOwner: TComponent); override
destructor Destroy; override
ublished
roperty OnUSBArrival: TUSBDeviceEvent read FOnUSBArrival write FOnUSBArrival
roperty OnUSBRemove: TUSBDeviceEvent read FOnUSBRemove write FOnUSBRemove
end
implementatio
constructor TUSBDeviceNotify.Create(AOwner: TComponent)
egi
inherited Create(AOwner)
FWindowHandle := AllocateHWnd(WndProc)
USBRegister
end
destructor TUSBDeviceNotify.Destroy
egi
DeallocateHWnd(FWindowHandle)
inherited Destroy
end
rocedure TUSBDeviceNotify.WndProc(var Msg: TMessage)
egi
if (Msg.Msg = WM_DEVICECHANGE) the
egi
try
WMDeviceChange(Msg)
except
Application.HandleException(Self)
end
end
else
Msg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam)
end
rocedure TUSBDeviceNotify.WMDeviceChange(var Msg: TMessage)
var
devType: Integer
Datos: PDevBroadcastHdr
Data: PDevBroadcastDeviceInterface
egi
if (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) the
egi
Datos := PDevBroadcastHdr(Msg.lParam)
devType := Datos^.dbch_devicetype
if devType = DBT_DEVTYP_DEVICEINTERFACE the
egin // USB Device
Data := PDevBroadcastDeviceInterface(Msg.LParam)
if Msg.wParam = DBT_DEVICEARRIVAL the
egi
if Assigned(FOnUSBArrival) the
FOnUSBArrival(Self, pData)
end
else
egi
if Assigned(FOnUSBRemove) the
FOnUSBRemove(Self, pData)
end
end
end
end
function TUSBDeviceNotify.USBRegister: Boolea
var
dbi: DEV_BROADCAST_DEVICEINTERFACE
Size: Integer
r: Pointer
egi
Result := False
Size := SizeOf(DEV_BROADCAST_DEVICEINTERFACE)
ZeroMemory(@dbi, Size)
dbi.dbcc_size := Size
dbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACE
dbi.dbcc_reserved := 0
dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICE
dbi.dbcc_name := 0
r := RegisterDeviceNotification(FWindowHandle, @dbi,
DEVICE_NOTIFY_WINDOW_HANDLE
if Assigned(r) the
Result := True
end
end.