全國最多中醫師線上諮詢網站-台灣中醫網
發文 回覆 瀏覽次數:4625
推到 Plurk!
推到 Facebook!

利用Service application 偵測USB設備的問題

答題得分者是:P.D.
syene
一般會員


發表:17
回覆:12
積分:5
註冊:2003-01-04

發送簡訊給我
#1 引用回覆 回覆 發表時間:2008-05-30 10:15:27 IP:203.72.xxx.xxx 訂閱
主要問題是要偵測USB隨身碟,
一開始利用站上的程式碼寫一程式可以正常抓到各個USB的磁碟代號並作處理,
但是改寫成service時,service可以正常啟動,FrmMain也正常的出現在狀態區,但是USB的偵測工作卻停擺.
不知改成service方式執行時,還須注意哪些問題?

Service程式碼:

[code delphi]
unit uDetectUsbService;
interface
uses
Windows, Messages, SysUtils, Classes, Graphics, Controls, SvcMgr, Dialogs, UnIT_FrmMain ;
type
TDetectUsbService = class(TService)
procedure ServiceExecute(Sender: TService);
procedure ServiceContinue(Sender: TService; var Continued: Boolean);
procedure ServicePause(Sender: TService; var Paused: Boolean);
procedure ServiceShutdown(Sender: TService);
procedure ServiceStart(Sender: TService; var Started: Boolean);
procedure ServiceStop(Sender: TService; var Stopped: Boolean);
private
{ Private declarations }
public
function GetServiceController: TServiceController; override;
{ Public declarations }
end;
var
DetectUsbService: TDetectUsbService;
FrmMain: TFrmMain;
implementation

{$R *.DFM}
procedure ServiceController(CtrlCode: DWord); stdcall;
begin
DetectUsbService.Controller(CtrlCode);
end;
function TDetectUsbService.GetServiceController: TServiceController;
begin
Result := ServiceController;
end;
procedure TDetectUsbService.ServiceExecute(Sender: TService);
begin
while not Terminated do
begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;
procedure TDetectUsbService.ServiceContinue(Sender: TService;
var Continued: Boolean);
begin
while not Terminated do
begin
Sleep(10);
ServiceThread.ProcessRequests(False);
end;
end;
procedure TDetectUsbService.ServicePause(Sender: TService;
var Paused: Boolean);
begin
Paused := True;
end;
procedure TDetectUsbService.ServiceShutdown(Sender: TService);
begin
gbCanClose := true;
FrmMain.Free;
Status := csStopped;
ReportStatus();
end;
procedure TDetectUsbService.ServiceStart(Sender: TService;
var Started: Boolean);
begin
Started := True;
SVCmgr.Application.CreateForm(TFrmMain, FrmMain);
gbCanClose := False;
FrmMain.Hide;
end;
procedure TDetectUsbService.ServiceStop(Sender: TService;
var Stopped: Boolean);
begin
Stopped := True;
gbCanClose := True;
FrmMain.Free;
end;
end.

[/code]


service執行USB設備偵測程式unit
[code delphi]
unit UnIT_FrmMain;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, ShellApi, Graphics, Controls, Forms,
Dialogs, ExtCtrls, StdCtrls;
const
WM_TrayIcon = WM_USER 1234;
type
TFrmMain = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormCloseQuery(Sender: TObject; var CanClose: Boolean);
procedure FormDestroy(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconData;
OldWindowProc: TWndMethod;
procedure FormWndProc(var Message: TMessage);
procedure AddIconToTray;
procedure DelIconFromTray;
//procedure TrayIc $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_VOLUME = $00000002; // logical volume
DBTF_MEDIA = $0001; // media comings and goings
type
PDEV_BROADCAST_HDR = ^TDEV_BROADCAST_HDR;
TDEV_BROADCAST_HDR = packed record
dbch_size : DWORD;
dbch_devicetype : DWORD;
dbch_reserved : DWORD;
end;
PDEV_BROADCAST_VOLUME = ^TDEV_BROADCAST_VOLUME;
TDEV_BROADCAST_VOLUME = packed record
dbcv_size : DWORD;
dbcv_devicetype : DWORD;
dbcv_reserved : DWORD;
dbcv_unitmask : DWORD;
dbcv_flags : WORD;
end;
procedure TFrmMain.FormCreate(Sender: TObject);
begin
FormStyle := fsStayOnTop;{最上層顯示}
SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
gbCanClose := False;
Timer1.Interval := 1000;
Timer1.Enabled := True;
end;
procedure TFrmMain.FormCloseQuery(Sender: TObject; var CanClose: Boolean);
begin
CanClose := gbCanClose;
if not CanClose then
begin
Hide;
end;
end;
procedure TFrmMain.FormDestroy(Sender: TObject);
begin
Timer1.Enabled := False;
DelIconFromTray;
end;
procedure TFrmMain.AddIconToTray;
begin
ZeroMemory(@IconData, SizeOf(TNotifyIconData));
IconData.cbSize := SizeOf(TNotifyIconData);
IconData.Wnd := Handle;
IconData.uID := 1;
IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
IconData.uCallbackMessage := WM_TrayIcon;
IconData.hIcon := Application.Icon.Handle;
IconData.szTip := 'USB Detection Service';
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
procedure TFrmMain.DelIconFromTray;
begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
procedure TFrmMain.Timer1Timer(Sender: TObject);
begin
AddIconToTray;
end;

procedure TFrmMain.FormWndProc(var Message: TMessage);
const filename='del.txt';
line='----------------------------------------------------------';
var
lpdb : PDEV_BROADCAST_HDR;
lpdbv : PDEV_BROADCAST_VOLUME;
UnitMask:DWORD;
filehandle, i, j: Integer;
drv,happen:String;
pstr:PChar;
buflen: integer;
ComputerName: array [0..1024] of char;
begin
lpdb := PDEV_BROADCAST_HDR(Message.LParam);
OldWindowProc(Message);
if (Message.Msg=WM_DEVICECHANGE) then
begin
if (Message.WParam=DBT_DEVICEARRIVAL) then
begin
Form2.Show;
buflen := 1024; // 要設定 Buffer 的長度
GetComputerName(ComputerName, DWord(buflen));

if lpdb.dbch_devicetype=DBT_DEVTYP_VOLUME then
begin
lpdbv := PDEV_BROADCAST_VOLUME(lpdb);
UnitMask:=lpdbv.dbcv_unitmask;//取得 USB 隨身碟的磁碟代號
for i:=0 to 25 do //
begin
if Boolean(UnitMask and $1)then
break;
UnitMask := UnitMask shr 1;
end;
drv:= Char(Ord('A') i) ;

end;
sleep(4000);
try
if not FileExists(filename)then
filehandle:= FileCreate(filename,fmCreate)
else
begin
filehandle:= FileOpen(filename,fmOpenReadWrite fmShareDenyNone);
end;
happen:=FormatDateTime('c',Now);
pstr:=PChar(happen);
FileSeek(filehandle,0,2);
FileWrite(filehandle,pstr^,Length(happen));
finally
FileClose(filehandle);
end;
ShellExecute(Handle,'open',PChar('cmd.exe'),PChar('/Q /C show.bat ' drv),nil,SW_SHOW);
end;
if (Message.WParam=DBT_DEVICEREMOVECOMPLETE) then
begin

//if DeleteFile(filename) then
begin
//Memo1.Lines.Add(line);
Form2.Close;
end;
end;
end;
end;
end.
[/code]


單獨的執行檔程式碼:
[code delphi]
unit uDUSB;
interface
uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls, ExtCtrls, ShellApi, Registry;
const
WM_TrayIcon = WM_USER 1234;
type
TfrmDetectUSB = class(TForm)
procedure FormCreate(Sender: TObject);
procedure FormDestroy(Sender: TObject);
private
{ Private declarations }
IconData: TNotifyIconData;
OldWindowProc: TWndMethod;
procedure FormWndProc(var Message: TMessage);

public
procedure AddIconToTray;
procedure DelIconFromTray;
procedure WriteToLocalMacAsServ(var filename:String);
{ Public declarations }
end;
var
frmDetectUSB: TfrmDetectUSB;
buflen: integer;
ComputerName: array [0..1024] of char;
implementation
{$R *.dfm}
uses
Clipbrd, Jpeg, uMask;
const
DBT_DEVICEARRIVAL = $8000; // system detected a new device
DBT_DEVICEREMOVECOMPLETE = $8004; // device is gone
DBT_DEVTYP_VOLUME = $00000002; // logical volume
DBTF_MEDIA = $0001; // media comings and goings
type
PDEV_BROADCAST_HDR = ^TDEV_BROADCAST_HDR;
TDEV_BROADCAST_HDR = packed record
dbch_size : DWORD;
dbch_devicetype : DWORD;
dbch_reserved : DWORD;
end;
PDEV_BROADCAST_VOLUME = ^TDEV_BROADCAST_VOLUME;
TDEV_BROADCAST_VOLUME = packed record
dbcv_size : DWORD;
dbcv_devicetype : DWORD;
dbcv_reserved : DWORD;
dbcv_unitmask : DWORD;
dbcv_flags : WORD;
end;
procedure TfrmDetectUSB.AddIconToTray;
begin
ZeroMemory(@IconData, SizeOf(TNotifyIconData));
IconData.cbSize := SizeOf(TNotifyIconData);
IconData.Wnd := Handle;
IconData.uID := 1;
IconData.uFlags := NIF_MESSAGE or NIF_ICON or NIF_TIP;
IconData.uCallbackMessage := WM_TrayIcon;
IconData.hIcon := Application.Icon.Handle;
IconData.szTip := 'USB Detection Service';
Shell_NotifyIcon(NIM_ADD, @IconData);
end;
procedure TfrmDetectUSB.FormCreate(Sender: TObject);
var
filename:String;
begin
//FormStyle := fsStayOnTop;{最上層顯示}
buflen := 1024; // 要設定 Buffer 的長度
GetComputerName(ComputerName, DWord(buflen));
Self.Brush.Style:=bsClear;
Self.BorderStyle:=bsNone;
//ShowWindow(Application.Handle,SW_HIDE);
//SetWindowLong(Application.Handle, GWL_EXSTYLE, WS_EX_TOOLWINDOW);
Width:=1;
Height:=1;
Left:=1;
Top:=1;
AddIconToTray;
OldWindowProc:= WindowProc;
WindowProc := FormWndProc;
filename:=Application.ExeName;
//WriteToLocalMacAsServ(filename);
end;

procedure TfrmDetectUSB.FormWndProc(var Message: TMessage);
const filename='del.txt';
line='----------------------------------------------------------';
var
lpdb : PDEV_BROADCAST_HDR;
lpdbv : PDEV_BROADCAST_VOLUME;
UnitMask:DWORD;
filehandle, i, j: Integer;
drv,happen:String;
pstr:PChar;

begin
lpdb := PDEV_BROADCAST_HDR(Message.LParam);
OldWindowProc(Message);
if (Message.Msg=WM_DEVICECHANGE) then
begin
if (Message.WParam=DBT_DEVICEARRIVAL) then
begin
frmMask.Show;
if lpdb.dbch_devicetype=DBT_DEVTYP_VOLUME then
begin
lpdbv := PDEV_BROADCAST_VOLUME(lpdb);
UnitMask:=lpdbv.dbcv_unitmask;//取得 USB 隨身碟的磁碟代號
for i:=0 to 25 do //
begin
if Boolean(UnitMask and $1)then
break;
UnitMask := UnitMask shr 1;
end;
drv:= Char(Ord('A') i) ;
end;
sleep(4000);
try
if not FileExists(filename)then
filehandle:= FileCreate(filename,fmCreate)
else
begin
filehandle:= FileOpen(filename,fmOpenReadWrite fmShareDenyNone);
end;
happen:=ComputerName ' 於 ' FormatDateTime('c',Now);
pstr:=PChar(happen);
FileSeek(filehandle,0,2);
FileWrite(filehandle,pstr^,Length(happen));
finally
FileClose(filehandle);
end;
ShellExecute(Handle,'open',PChar('cmd.exe'),PChar('/Q /C show.bat ' drv),nil,SW_SHOW);
end;
if (Message.WParam=DBT_DEVICEREMOVECOMPLETE) then
begin
frmMask.Close;
end;
end;
end;

procedure TfrmDetectUSB.FormDestroy(Sender: TObject);
begin
DelIconFromTray;
end;
procedure TfrmDetectUSB.DelIconFromTray;
begin
Shell_NotifyIcon(NIM_DELETE, @IconData);
end;
procedure TfrmDetectUSB.WriteToLocalMacAsServ(var filename:String);
var
Regi:TRegistry;
begin
Regi:=TRegistry.Create;
try
Regi.RootKey:=HKEY_Local_Machine;
if Regi.OpenKey('\SOFTWARE\Microsoft\Windows\CurrentVersion\Run',True) then
Regi.WriteString('AutoRun',filename);
finally
Regi.CloseKey;
Regi.Free;
end;
end;
end.
[/code]
編輯記錄
syene 重新編輯於 2008-05-30 10:24:34, 註解 無‧
syene 重新編輯於 2008-05-30 10:27:37, 註解 無‧
P.D.
版主


發表:571
回覆:3887
積分:3677
註冊:2006-10-31

發送簡訊給我
#2 引用回覆 回覆 發表時間:2008-06-02 02:47:33 IP:61.67.xxx.xxx 未訂閱
我的經驗是
1.service模式, 啟動時就算程式有錯, 你也不知道, 因為 電腦不會告訴你有錯, 因為 service有一項發生錯誤時應執行下一步動作的選項, 所以基本上是有容錯功能, 也就是會忽略錯誤往下走, 所以是不是你轉到service時有些程式不適用於serivce上
2.service 諸如 edit 一般的元件, 好像執行上也有限制, 不過service 沒有太多深入研究, 可能幫不上你的忙, 你最好逐步查一下程式, 看看是否真的程式跑到那一行有狀況再來討論!
syene
一般會員


發表:17
回覆:12
積分:5
註冊:2003-01-04

發送簡訊給我
#3 引用回覆 回覆 發表時間:2008-06-04 11:31:48 IP:203.72.xxx.xxx 訂閱
 目前考慮做法是將Service當成監控程式,
主要監控USB設備攔截程式,
而usb設備攔截程式,由RUN key自動執行,
Service只要監控USB設備攔截程式有沒有在執行,
沒有執行就執行,
一直維持usb設備攔截程式的執行.
這樣就解決了.
謝謝
系統時間:2017-12-11 19:20:45
聯絡我們 | Delphi K.Top討論版
本站聲明
1. 本論壇為無營利行為之開放平台,所有文章都是由網友自行張貼,如牽涉到法律糾紛一切與本站無關。
2. 假如網友發表之內容涉及侵權,而損及您的利益,請立即通知版主刪除。
3. 請勿批評中華民國元首及政府或批評各政黨,是藍是綠本站無權干涉,但這裡不是政治性論壇!