delphi怎么实现USB数据的传输控制 ( 积分: 100 )

zglikai · 2005-09-30

我们有一个机子，里面有一些大图片，想做一个通过USB接口，对每次从机子拷走的图片，进行统计：图片数，图片名称。超过一定数量，禁止USB数据的传输.的小程序。 请个位仁兄，提拱宝贵资料，将十分感激。

zglikai · 2005-09-30

我们有一个机子，里面有一些大图片，想做一个通过USB接口，对每次从机子拷走的图片，进行统计：图片数，图片名称。超过一定数量，禁止USB数据的传输.的小程序。 请个位仁兄，提拱宝贵资料，将十分感激。

chinapr · 2005-10-08

用驱动

foxphone2003 · 2005-10-08

做个文件夹映射就可以了 不要你写驱动的

vpanel · 2005-10-10

这段代码可以监控所有的设备操作，当你监控到USB设备有读写操作时，即可进行统计，自己修改吧。 能用了，最好是发一份给我。 unit Unit1; interface uses  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,  StdCtrls, shlobj, Activex; const  SHCNE_RENAMEITEM = $1;  SHCNE_CREATE = $2;  SHCNE_DELETE = $4;  SHCNE_MKDIR = $8;  SHCNE_RMDIR = $10;  SHCNE_MEDIAINSERTED = $20;  SHCNE_MEDIAREMOVED = $40;  SHCNE_DRIVEREMOVED = $80;  SHCNE_DRIVEADD = $100;  SHCNE_NETSHARE = $200;  SHCNE_NETUNSHARE = $400;  SHCNE_ATTRIBUTES = $800;  SHCNE_UPDATEDIR = $1000;  SHCNE_UPDATEITEM = $2000;  SHCNE_SERVERDISCONNECT = $4000;  SHCNE_UPDATEIMAGE = $8000;  SHCNE_DRIVEADDGUI = $10000;  SHCNE_RENAMEFOLDER = $20000;  SHCNE_FREESPACE = $40000;  SHCNE_ASSOCCHANGED = $8000000;  SHCNE_DISKEVENTS = $2381F;  SHCNE_GLOBALEVENTS = $C0581E0;  SHCNE_ALLEVENTS = $7FFFFFFF;  SHCNE_INTERRUPT = $80000000;  SHCNF_IDLIST = 0;                                                             //  LPITEMIDLIST  SHCNF_PATHA = $1;                                                             // path name  SHCNF_PRINTERA = $2;                                                          // printer friendly name  SHCNF_DWORD = $3;                                                             // DWORD  SHCNF_PATHW = $5;                                                             // path name  SHCNF_PRINTERW = $6;                                                          // printer friendly name  SHCNF_TYPE = $FF;  SHCNF_FLUSH = $1000;  SHCNF_FLUSHNOWAIT = $2000;  SHCNF_PATH = SHCNF_PATHW;  SHCNF_PRINTER = SHCNF_PRINTERW;  WM_SHNOTIFY = $401;  NOERROR = 0; type  TForm1 = class(TForm)    Button1: TButton;    Memo1: TMemo;    procedure FormClose(Sender: TObject; var Action: TCloseAction);    procedure Button1Click(Sender: TObject);    procedure FormCreate(Sender: TObject);  private    { Private declarations }    procedure WMShellReg(var Message: TMessage); message WM_SHNOTIFY;  public    { Public declarations }  end; type PSHNOTIFYSTRUCT = ^SHNOTIFYSTRUCT;  SHNOTIFYSTRUCT = record    dwItem1: PItemIDList;    dwItem2: PItemIDList;  end; type PSHFileInfoByte = ^SHFileInfoByte;  _SHFileInfoByte = record    hIcon: Integer;    iIcon: Integer;    dwAttributes: Integer;    szDisplayName: array[0..259] of char;    szTypeName: array[0..79] of char;  end;  SHFileInfoByte = _SHFileInfoByte; type PIDLSTRUCT = ^IDLSTRUCT;  _IDLSTRUCT = record    pidl: PItemIDList;    bWatchSubFolders: Integer;  end;  IDLSTRUCT = _IDLSTRUCT; function SHNotify_Register(hWnd: Integer): Bool; function SHNotify_UnRegister: Bool; function SHEventName(strPath1, strPath2: string; lParam: Integer): string; function SHChangeNotifyDeregister(hNotify: Integer): Integer; stdcall; external 'Shell32.dll' index 4; function SHChangeNotifyRegister(hWnd, uFlags, dwEventID, uMSG, cItems: longWord;  lpps: PIDLSTRUCT): Integer; stdcall; external 'Shell32.dll' index 2; function SHGetFileInfoPidl(pidl: PItemIDList;  dwFileAttributes: Integer;  psfib: PSHFileInfoByte;  cbFileInfo: Integer;  uFlags: Integer): Integer; stdcall; external 'Shell32.dll' name 'SHGetFileInfoA'; var  Form1: TForm1;  m_hSHNotify: Integer;  m_pidlDesktop: PItemIDList; implementation {$R *.DFM} function SHEventName(strPath1, strPath2: string; lParam: Integer): string; var  sEvent: string; begin  case lParam of    SHCNE_RENAMEITEM: sEvent := '重命名文件' + strPath1 + '为' + strPath2;    SHCNE_CREATE: sEvent := '建立文件文件名：' + strPath1;    SHCNE_DELETE: sEvent := '删除文件文件名：' + strPath1;    SHCNE_MKDIR: sEvent := '新建目录目录名：' + strPath1;    SHCNE_RMDIR: sEvent := '删除目录目录名：' + strPath1;    SHCNE_MEDIAINSERTED: sEvent := strPath1 + '中插入可移动存储介质';    SHCNE_MEDIAREMOVED: sEvent := strPath1 + '中移去可移动存储介质' + strPath1 + ' ' + strPath2;    SHCNE_DRIVEREMOVED: sEvent := '移去驱动器' + strPath1;    SHCNE_DRIVEADD: sEvent := '添加驱动器' + strPath1;    SHCNE_NETSHARE: sEvent := '设置目录' + strPath1 + '的共享属性';    SHCNE_NETUNSHARE: sEvent := '取消目录' + strPath1 + '的共享属性';    SHCNF_PRINTERW: sEvent := '****打印*****';    SHCNE_ATTRIBUTES: sEvent := '改变文件目录属性文件名' + strPath1;    SHCNE_UPDATEDIR: sEvent := '更新目录' + strPath1;    SHCNE_UPDATEITEM: sEvent := '更新文件文件名：' + strPath1;    SHCNE_SERVERDISCONNECT: sEvent := '断开与服务器的连接' + strPath1 + ' ' + strPath2;    SHCNE_UPDATEIMAGE: sEvent := 'SHCNE_UPDATEIMAGE';    SHCNE_DRIVEADDGUI: sEvent := 'SHCNE_DRIVEADDGUI';    SHCNE_RENAMEFOLDER: sEvent := '重命名文件夹' + strPath1 + '为' + strPath2;    SHCNE_FREESPACE: sEvent := '磁盘空间大小改变';    SHCNE_ASSOCCHANGED: sEvent := '改变文件关联';  else    sEvent := '未知操作' + IntToStr(lParam);  end;  Result := sEvent; end; function SHNotify_Register(hWnd: Integer): Bool; var  ps: PIDLSTRUCT; begin {$R-}  Result := False;  if m_hSHNotify = 0 then  begin    if SHGetSpecialFolderLocation(0, CSIDL_DESKTOP,      m_pidlDesktop) <> NOERROR then      Form1.close;    if Boolean(m_pidlDesktop) then    begin //      MoveMemory(ps, nil, sizeof(ps));      ps := GetMemory(sizeof(ps));      ps.pidl := m_pidlDesktop; //      MoveMemory(ps.pidl, m_pidlDesktop, (m_pidlDesktop));      ps.bWatchSubFolders := 1;      // 利用SHChangeNotifyRegister函数注册系统消息处理      m_hSHNotify := SHChangeNotifyRegister(hWnd,        (SHCNF_TYPE or SHCNF_IDLIST),        (SHCNE_ALLEVENTS or SHCNE_INTERRUPT),        WM_SHNOTIFY, 1, ps);      Result := Boolean(m_hSHNotify);      FreeMemory(ps);    end    else      // 如果出现错误就使用 CoTaskMemFree函数来释放句柄      CoTaskMemFree(m_pidlDesktop);  end; {$R+} end; function SHNotify_UnRegister: Bool; begin  Result := False;  if Boolean(m_hSHNotify) then    //取消系统消息监视，同时释放桌面的Pidl    if Boolean(SHChangeNotifyDeregister(m_hSHNotify)) then    begin {$R-}      m_hSHNotify := 0;      CoTaskMemFree(m_pidlDesktop);      Result := True; {$R-}    end; end; procedure TForm1.WMShellReg(var Message: TMessage);                             //系统消息处理函数 var  strPath1, strPath2: string;  charPath: array[0..259] of char;  pidlItem: PSHNOTIFYSTRUCT; begin  pidlItem := PSHNOTIFYSTRUCT(Message.wParam);  //获得系统消息相关得路径  SHGetPathFromIDList(pidlItem.dwItem1, charPath);  strPath1 := charPath;  SHGetPathFromIDList(pidlItem.dwItem2, charPath);  strPath2 := charPath;  Memo1.Lines.Add(SHEventName(strPath1, strPath2, Message.lParam) + chr(13) + chr(10));  Application.ProcessMessages; end; procedure TForm1.FormClose(Sender: TObject; var Action: TCloseAction); begin  //在程序退出的同时删除监视  if Boolean(m_pidlDesktop) then    SHNotify_UnRegister; end; procedure TForm1.Button1Click(Sender: TObject);                                 //Button1的Click消息 begin  m_hSHNotify := 0;  if SHNotify_Register(Form1.Handle) then  begin                                                                         //注册Shell监视    ShowMessage('Shelling...');    Button1.Enabled := False;  end  else    ShowMessage('Shell Error'); end; procedure TForm1.FormCreate(Sender: TObject); begin  Button1.Caption := 'Go!'; end; end.

阿舍 · 2005-10-14

to vpanel 可以编译通过并运行,但是一些不准,比如: 打印方面,就识别为对文件属性的操作.但文件名是空的. 未识给出 LPTn  USBn 等文件名. U盘操作方面是正确的(文件系统操作正确). 不知各位用过的朋友用得如何??

delphi怎么实现USB数据的传输控制 ( 积分: 100 )

zglikai

Unregistered / Unconfirmed

zglikai

Unregistered / Unconfirmed

chinapr

Unregistered / Unconfirmed

foxphone2003

Unregistered / Unconfirmed

vpanel

Unregistered / Unconfirmed

阿舍

Unregistered / Unconfirmed

Similar threads