本文目录
- 在DELPHI中，无窗体的程序如何获取系统关机或注销的消息
- delphi托盘弹出信息
- delphi最小化
- 如何得到其他程序的Richedit中的RTF数据
- delphi usb拔除的是哪个guid
在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;interfaceuses 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 onm ouseMove: TMouseMoveEvent read FOnMouseMove write FOnMouseMove; property onm ouseUp: TMouseEvent read FOnMouseUp write FOnMouseUp; property onm ouseDown: 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 onm ouseMove; property onm ouseUp; property onm ouseDown; 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;interfaceuses 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 : pfnCallbacktype 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 removeinterfaceuseWindows, Messages, SysUtils, Classes, FormtypePDevBroadcastHdr = ^DEV_BROADCAST_HDRDEV_BROADCAST_HDR = packed recorddbch_size: DWORDdbch_devicetype: DWORDdbch_reserved: DWORDendPDevBroadcastDeviceInterface = ^DEV_BROADCAST_DEVICEINTERFACEDEV_BROADCAST_DEVICEINTERFACE = recorddbcc_size: DWORDdbcc_devicetype: DWORDdbcc_reserved: DWORDdbcc_classguid: TGUIDdbcc_name: shortendconstGUID_DEVINTERFACE_USB_DEVICE: TGUID = ’{A5DCBF10-6530-11D2-901F-00C04FB951ED}’DBT_DEVICEARRIVAL = $8000; // system detected a new deviceDBT_DEVICEREMOVECOMPLETE = $8004; // device is goneDBT_DEVTYP_DEVICEINTERFACE = $00000005; // device interface clatypeTUSBDeviceEvent = procedure(Sender: TObject; pDeviceData: PDevBroadcastDeviceInterface) of objectTUSBDeviceNotify = class(TComponent)rivateFWindowHandle: HWNDFOnUSBArrival: TUSBDeviceEventFOnUSBRemove: TUSBDeviceEventrocedure WndProc(var Msg: TMessage)function USBRegister: Boolearotectedrocedure WMDeviceChange(var Msg: TMessage); dynamicublicconstructor Create(AOwner: TComponent); overridedestructor Destroy; overrideublishedroperty OnUSBArrival: TUSBDeviceEvent read FOnUSBArrival write FOnUSBArrivalroperty OnUSBRemove: TUSBDeviceEvent read FOnUSBRemove write FOnUSBRemoveendimplementatioconstructor TUSBDeviceNotify.Create(AOwner: TComponent)egiinherited Create(AOwner)FWindowHandle := AllocateHWnd(WndProc)USBRegisterenddestructor TUSBDeviceNotify.DestroyegiDeallocateHWnd(FWindowHandle)inherited Destroyendrocedure TUSBDeviceNotify.WndProc(var Msg: TMessage)egiif (Msg.Msg = WM_DEVICECHANGE) theegitryWMDeviceChange(Msg)exceptApplication.HandleException(Self)endendelseMsg.Result := DefWindowProc(FWindowHandle, Msg.Msg, Msg.wParam, Msg.lParam)endrocedure TUSBDeviceNotify.WMDeviceChange(var Msg: TMessage)vardevType: IntegerDatos: PDevBroadcastHdrData: PDevBroadcastDeviceInterfaceegiif (Msg.wParam = DBT_DEVICEARRIVAL) or (Msg.wParam = DBT_DEVICEREMOVECOMPLETE) theegiDatos := PDevBroadcastHdr(Msg.lParam)devType := Datos^.dbch_devicetypeif devType = DBT_DEVTYP_DEVICEINTERFACE theegin // USB DeviceData := PDevBroadcastDeviceInterface(Msg.LParam)if Msg.wParam = DBT_DEVICEARRIVAL theegiif Assigned(FOnUSBArrival) theFOnUSBArrival(Self, pData)endelseegiif Assigned(FOnUSBRemove) theFOnUSBRemove(Self, pData)endendendendfunction TUSBDeviceNotify.USBRegister: Booleavardbi: DEV_BROADCAST_DEVICEINTERFACESize: Integerr: PointeregiResult := FalseSize := SizeOf(DEV_BROADCAST_DEVICEINTERFACE)ZeroMemory(@dbi, Size)dbi.dbcc_size := Sizedbi.dbcc_devicetype := DBT_DEVTYP_DEVICEINTERFACEdbi.dbcc_reserved := 0dbi.dbcc_classguid := GUID_DEVINTERFACE_USB_DEVICEdbi.dbcc_name := 0r := RegisterDeviceNotification(FWindowHandle, @dbi,DEVICE_NOTIFY_WINDOW_HANDLEif Assigned(r) theResult := Trueendend.