求助：把以下代码做成DLL，并能在VB里调用。

Question

求助：以下代码是读取USB序列号的，本人对Delphi不熟悉，搞了半天(lstrcpy,PChar......)，就是无法做成DLL让VB调用。盼高手帮忙。把它做成可以让VB调用的DLL。
unit   Unit1;      
  interface       
  uses   
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms, Dialogs,   StdCtrls;       
  const   
          DIGCF_PRESENT   =   2;   
          DIGCF_INTERFACEDEVICE   =   16;   
  type   
    
    PSP_DEVINFO_DATA   =   ^SP_DEVINFO_DATA;   
    SP_DEVINFO_DATA   =   packed   record   
          cbSize   :DWORD;   
          ClassGuid   :TGUID;   
          DevInst   :DWORD   ;         //   DEVINST   handle   
          Reserved   :DWORD;   
    end;   
    
      HDEVINFO   =   Pointer;   
    
      pulong   =   ^ulong;   
    
      PSP_INTERFACE_DEVICE_DATA   =   ^SP_INTERFACE_DEVICE_DATA;   
      SP_INTERFACE_DEVICE_DATA   =   packed   record   
            cbSize   :ulong;   
            InterfaceClassGuid   :   TGuid;   
            Flags     :ulong;   
            Reserved   :ulong;   
      end;   
    
      PSP_INTERFACE_DEVICE_DETAIL_DATA   =   ^PSP_INTERFACE_DEVICE_DETAIL_DATA;   
      SP_DEVICE_INTERFACE_DETAIL_DATA   =   packed   record   
          cbSize   :DWORD;   
          DevicePath:   Char;   
      end;   
    
    
    PUSB_DEVICE_DESCRIPTOR   =   ^USB_DEVICE_DESCRIPTOR;   
    USB_DEVICE_DESCRIPTOR     =   packed   record   
        bLength   :UCHAR;   
        bDescriptorType   :UCHAR;   
        bcdUSB   :WORD;   
        bDeviceClass   :UCHAR;   
        bDeviceSubClass   :UCHAR;   
        bDeviceProtocol   :UCHAR;   
        bMaxPacketSize0   :UCHAR;   
        idVendor   :Word;   
        idProduct   :Word;   
        bcdDevice   :Word;   
        iManufacturer   :UCHAR;   
        iProduct   :UCHAR;   
        iSerialNumber   :UCHAR;   
        bNumConfigurations   :UCHAR;   
      end;   
    
  function   SetupDiGetDeviceInterfaceDetail(   
        DeviceInfoSet   :   HDEVINFO;   
        DeviceInterfaceData:     PSP_INTERFACE_DEVICE_DATA;   
        DeviceInterfaceDetailData:     PSP_INTERFACE_DEVICE_DETAIL_DATA;   
        DeviceInterfaceDetailDataSize   :   DWORD;   
        RequiredSize   :   PDWORD;   
        DeviceInfoData   :   PSP_DEVINFO_DATA   
          ):   BOOL;   stdcall;   external   'SETUPAPI.dll'   name   'SetupDiGetDeviceInterfaceDetailA';   
    
  function   SetupDiGetClassDevsEx(   
            ClassGuid   :PGUID;   
          Enumerator   :PChar;   
          hwndParent   :HWND;   
          Flags   :   DWORD;   
          MachineName   :PChar;   
          Reserved   :Pointer   
          ):   HDEVINFO;   stdcall;   external   'SETUPAPI.dll'   name   'SetupDiGetClassDevsExA';   
    
  function   SetupDiGetClassDevs(   
          ClassGuid   :PGUID   ;   
          Enumerator:   PChar;   
          hwndParent:   HWND;   
          Flags   :   DWORD   
          ):   HDEVINFO;   stdcall;   external   'SETUPAPI.dll'   name   'SetupDiGetClassDevsA';   
    
  function   SetupDiEnumDeviceInterfaces(   
              DeviceInfoSet   :HDEVINFO;   
              DeviceInfoData   :PSP_DEVINFO_DATA;   
              InterfaceClassGuid   :PGUID;   
              MemberIndex   :DWORD;   
              DeviceInterfaceData   :PSP_INTERFACE_DEVICE_DATA   
          ):   BOOL;   stdcall;   external   'SETUPAPI.dll'   name   'SetupDiEnumDeviceInterfaces';   
    
  function   SetupDiDestroyDeviceInfoList(   
                DeviceInfoSet   :HDEVINFO   
          ):BOOL;   stdcall;   external   'SETUPAPI.dll'   name   'SetupDiEnumDeviceInterfaces';   
    
  type   
      TOnGetStrEvent   =   procedure(AStr   :string)   of   object;   
    
  //以下代码可枚举所有设备   
    
  const   //USBIODS_GUID   :   TGuid   =   '{745a17a0-74d3-11d0-b6fe-00a0c90f57da}';   
              USBIODS_GUID   :   TGuid   =   '{a5dcbf10-6530-11d2-901f-00c04fb951ed}';   
    
  type   
      TForm1   =   class(TForm)   
          Button1:   TButton;   
          Memo1:   TMemo;   
          procedure   Button1Click(Sender:   TObject);   
      private   
          {   Private   declarations   }   
      public   
          {   Public   declarations   }   
      end;   
    
  var   
      Form1:   TForm1;   
    
  implementation   
    
  {$R   *.dfm}   
    
  procedure   TForm1.Button1Click(Sender:   TObject);   
  var   b   :integer;   
          bRst   :BOOL;   
          hInfo   :HDEVINFO;   
  //         USBIODS_GUID   :TGuid;   
          deviceInterfaceData   :SP_INTERFACE_DEVICE_DATA;   
          DeviceDetailData   :SP_DEVICE_INTERFACE_DETAIL_DATA;   
    
          predictedLength   :   ULONG;   
          requiredLength     :ULONG;   
          nCount:   integer;   
  begin   
          Memo1.Clear;   
    
  {         USBIODS_GUID.D1   :=   $a5dcbf10;   
          USBIODS_GUID.D2   :=   $6530;   
          USBIODS_GUID.D3   :=   $11d2;   
          USBIODS_GUID.D4[0]   :=   $90;   
          USBIODS_GUID.D4[1]   :=   $1f;   
          USBIODS_GUID.D4[2]   :=   $00;   
          USBIODS_GUID.D4[3]   :=   $c0;   
          USBIODS_GUID.D4[4]   :=   $4f;   
          USBIODS_GUID.D4[5]   :=   $b9;   
          USBIODS_GUID.D4[6]   :=   $51;   
          USBIODS_GUID.D4[7]   :=   $ed;   
    }   
  //   USBIODS_GUID   :=   '{a5dcbf10-6530-11d2-901f-00c04fb951ed}';   
    
          predictedLength   :=   0;   
          requiredLength   :=   0;   
          hInfo   :=   nil;   
          hInfo   :=   SetupDiGetClassDevs(@USBIODS_GUID,   nil,   0,   
                                        DIGCF_PRESENT   OR   DIGCF_INTERFACEDEVICE);   
    
          bRst   :=   true;   
          nCount   :=   0;   
    
          deviceInterfaceData.cbSize   :=   Sizeof(SP_INTERFACE_DEVICE_DATA);   
          DeviceDetailData.cbSize   :=   sizeof(SP_DEVICE_INTERFACE_DETAIL_DATA);   
    
          if   hInfo   =   nil   then   
          begin   
              showmessage('failed   0');   
              exit;   
          end;   
    
          while   bRst   do   
          begin   
              deviceInterfaceData.cbSize   :=   Sizeof(deviceInterfaceData);   
    
              bRst   :=   SetupDiEnumDeviceInterfaces(hInfo,   nil,   @USBIODS_GUID,   
                                                                                            nCount,   @deviceInterfaceData);   
    
              if   bRst   then   
              begin   
                    SetupDiGetDeviceInterfaceDetail(hInfo,   @deviceInterfaceData,   
                                            nil,   0,   @requiredLength,   nil);   
    
    
                    predictedLength   :=   requiredLength;   
                    DeviceDetailData.cbSize   :=   sizeof(SP_DEVICE_INTERFACE_DETAIL_DATA);   
                    bRst   :=   SetupDiGetDeviceInterfaceDetail(hInfo,   @deviceInterfaceData,   
                                            @DeviceDetailData,   predictedLength,   @requiredLength,   nil);   
    
                    if   bRst   then   
                    begin   
                  //       showmessage('ok'+inttostr(nCount));   
                      /////   pszDevicePath[nCount]   :=   string(PChar(@(DeviceDetailData.DevicePath)));   
                        showmessage(string(PChar(@(DeviceDetailData.DevicePath))));   
                      ////   Memo1.Lines.Add(pszDevicePath[nCount]);   
          //               Memo1.Lines.Add(string(PChar(@(DeviceDetailData.DevicePath))));   
                        Inc(nCount);   
                    end;   
              end;   
          end;   //end   while   
          showmessage('finished');   
  //       SetupDiDestroyDeviceInfoList(hInfo);   
  end;     
  end. 

Answer 1

先放一个按钮和一个Memo,现贴以上代码。就能通过的。

Answer 2

试了一下你的代码,退出时报地址错误，而且写得很乱:)
参考一下此贴的做法http://community.csdn.net/Expert/topic/4671/4671823.xml?temp=9.42409E-04下面的是我修改好代码，我没有安装VB，看谁有空的帮你做成dll
unit Unit1;interfaceuses
  Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
  Dialogs, StdCtrls, SetupAPI, Hid;type
  TForm1 = class(TForm)
    Button1: TButton;
    procedure Button1Click(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;const MAX_DETAIL_BUFF_LEN = 256;var
  Form1: TForm1;implementation{$R *.dfm}procedure TForm1.Button1Click(Sender: TObject);
var MyGuid          : TGUID;
    hHDEVINFO       : HDEVINFO;
    MyInterface     : TSPDeviceInterfaceData;
    bSuccess        : Boolean;
    MyDetail        : array[0..MAX_DETAIL_BUFF_LEN-1] of byte;
    PMyDetail       : PSPDeviceInterfaceDetailData;
begin
   //这个是正确的guid：A5DCBF10-6530-11D2-901F-00C04FB951ED
    MyGuid.D1   := $A5DCBF10;
    MyGuid.D2   := $6530;
    MyGuid.D3   := $11D2;
    MyGuid.D4[0]:= $90;
    MyGuid.D4[1]:= $1F;
    MyGuid.D4[2]:= $00;
    MyGuid.D4[3]:= $C0;
    MyGuid.D4[4]:= $4F;
    MyGuid.D4[5]:= $B9;
    MyGuid.D4[6]:= $51;
    MyGuid.D4[7]:= $ED;
    hHDEVINFO := SetupDiGetClassDevs(@MyGuid, nil, 0, DIGCF_DEVICEINTERFACE+DIGCF_PRESENT);
    if  (DWORD(hHDEVINFO) <> INVALID_HANDLE_VALUE) then
       begin
         MyInterface.cbSize := sizeof(TSPDeviceInterfaceData);
         bSuccess := SetupDiEnumDeviceInterfaces(hHDEVINFO, nil, MyGuid, 0, MyInterface);
         if not bSuccess then
           SetupDiDestroyDeviceInfoList(hHDEVINFO)
        else
          begin
            ZeroMemory(@MyDetail, MAX_DETAIL_BUFF_LEN);
            PMyDetail := @MyDetail;
            PMyDetail.cbSize := sizeof(TSPDeviceInterfaceDetailData);
            if not SetupDiGetDeviceInterfaceDetail(hHDEVINFO,@MyInterface, @MyDetail, MAX_DETAIL_BUFF_LEN, nil, nil) then
             SetupDiDestroyDeviceInfoList(hHDEVINFO)
            else
               ShowMessage(StrPas(PMyDetail.DevicePath));
         end;
    end;
end;
end.

Answer 3

已经做成Dll了，能在Delphi下调用。留邮箱，发给你自己在VB下试试。

Answer 4

谢谢各位相助。
TO老之：
能给DLL源码吗？

Answer 5

谢谢老之。
怎么源码到我这边就不能通过？
[致命错误] MyDll.dpr(4): File not found: 'ModuleLoader.dcu'
这个：ModuleLoader.dcu怎么找到呢？

Answer 6

的确是少发了ModuleLoader.pas这个间接用到的单元，已经重发

Answer 7

TO老之：
我正在找相关内容，能给DLL源码吗？顺便问一下，是不是所有USB设备都有唯一标识号啊？