在Delphi6中怎样编写一个得到硬盘序列号的ocx提供给ASP调用？!!!!!!!!(100分)

在Delphi6中怎样编写一个得到硬盘序列号的ocx提供给ASP调用？

请参考以下文章(摘自中国计算机报)：

用硬盘序列号验证用户身份

叶梁

　　进行用户身份验证是网站用户管理和有偿信息服务的必要步骤?一般的实现方法无法控制合法用户将自己的验证信息扩散给他人使用，对于不以流量计费的有偿信息服务网站，将造成信息资源的流失。

　　本文介绍名为GetDiskKeyNo的ActiveX控件的开发技术，该控件能够读取用户登录所用微机的硬盘序列号并进行加密后随表单信息一同传送至服务器，与服务器数据库内的值相比较，用户名、密码、序列号都符合，则验证通过，从而限制了一个合法用户只能在一台客户机上登录，防止了信息资源流失。


　　开发GetDiskKeyNo控件


　　本文以Visual Basic开发工具为例，说明GetDiskKeyNo控件的开发过程。

　　1．新建工程

　　用VB新建一个“ActiveX控件”类型的工程并命名保存，本例工程名取GetDiskKeyNo.vbp，编译生成的控件名称为GetDiskKeyNo.ocx。

　　从主选单的“工程→属性”选单项调出工程属性设置对话框，设置工程生成的控件版本号为“自动升级”，这样VB每次编译控件时就会自动增加控件版本号。

　　2．声明取硬盘序列号的函数

　　在工程中建立一个模块并作如下声明，注意Declare语句需在一行内写完：

　　Declare Function GetVolumeInformation Lib "kernel32" Alias "GetVolumeInformationA" (ByVal lpRootPathName As String, ByVal lpVolumeNameBuffer As String, ByVal nVolumeNameSize As Long, lpVolumeSerialNumber As Long, lpMaximumComponentLenth As Long, lpFileSystemFlags As Long, ByVal lpFileSystemNameBuffer As String, ByVal nFileSystemNameSize As Long) As Long

　　Global GetVal As Long

　　3．写ActiveX控件程序

　　进入控件代码窗口，从选单项“工具→添加过程”新建控件的keyno和sm属性，再建立加密自定义函数过程encrypt，并写出相互间的调用代码，程序代码摘要如下：

　　Private strSMW As String '用于传递数值

　　Public Property Let sm(ByVal vNewValue As Variant)

　　'本属性取得动态加密规则码

　　strSMW = Trim(Str(vNewValue))

　　End Property

　　Public Property Get keyno() As Variant

　　'本属性返回已加密的硬盘序列号

　　Dim Str1 As String?256, Str2 As String?256,Lon1 As Long, Lon2 As Long, strT As String

　　Call GetVolumeInformation("C:/", Str1, 256, GetVal, Lon1, Lon2, Str2, 256)

　　'取得硬盘序列号

　　strT = Right(Str(GetVal), 8) '取8位

　　keyno = encrypt(strT) '调用加密函数

　　End Property

　　Private Function encrypt(strS As String) As String

　　'用动态加密规则码strSMW进行加密

　　'根据加密规则编写程序，具体程序略

　　encrypt=… '返回已加密的硬盘序列号

　　End Funtction

　　4．编译GetDiskKeyNo控件

　　调用VB主选单“文件”选单下的“生成GetDiskKeyNo.ocx”选单项，设置控件名和保存目录，编译生成控件。


　　分发GetDiskKeyNo控件


　　GetDiskKeyNo控件开发完成后，就可以在各种应用程序中使用，下面介绍它在网站用户验证机制中的应用，这需要在Web服务器上分发该控件，以便客户机浏览器在访问登录表单时能够自动下载该控件并安装运行。具体步骤如下：

　　1.将已生成的GetDiskKeyNo.ocx控件拷贝到Web服务器的一个目录下，本例是拷贝至Web服务器的根目录下。

　　2.在Web服务器中建立Login.asp登录页面引用该控件，源码摘要如下：

　　＜html＞＜head＞＜title＞＜/title＞＜/head＞＜body＞

　　＜form name="t1" method="post" action="CheckUser.asp"＞＜p＞

　　＜OBJECT ID="GetDiskKey"

　　classid="clsid:CBF07105-2110-11D5-BBD1-00A0C99041D3" codebase="http://202.101.3.1/getdiskkeyno.ocx#version=1,0,0,18"

　　width=6

　　height=6＞＜/object＞＜br＞

　　用户名：＜input type="text" size="8" name="username"＞＜br＞

　　密码：＜input type="text" size="8" name="password"＞＜br＞

　　＜input type="hidden" name="smw" value="＜% call gesmw %＞"＞

　　＜input type="submit" name="tj" value=" 登 录 " ＞

　　＜/p＞＜/form＞＜/body＞＜/html＞

　　＜script language=VBScript＞

　　sub tj_onclick()

　　a=document.t1.smw.value

　　document.t1.getdiskkey.sm=a

　　document.t1.smw.value=document.t1.getdiskkey.keyno

　　end sub

　　＜/script＞

　　＜% private sub gesmw

　　… '随机产生动态加密规则码的程序代码

　　end sub %＞

　　以上Codebase的值是分发控件的路径、控件名和控件版本号。

　　GetDiskKeyNo控件的classid号用以下方法取得：当编译生成控件时VB已自动注册控件，可在开发控件的微机上运行指令Regedit查看Windows注册表的注册信息，将“HKEY_CLASSES_ROOT”项展开，GetDiskKeyNo项目下子数据项Clsid的数值即是。

　　3.新建验证页面CheckUser.asp，对Login.asp表单Post来的客户登录信息进行解密和验证，具体程序在此不做介绍，但注意要加入一个判断，即用户第一次登录时数据库中硬盘序列号值为空，此时应根据用户名和密码予以验证通过并将Login.asp页面返回的硬盘序列号存入数据库该用户记录中。此外，如果用户确需变更上网用的客户机时需要通知网管，由网管将数据库中该用户记录硬盘序列号域的值删去，用户就可以在新的客户机上登录，显而易见此后该用户就不能在原先的客户机登录了。


　　验证原理


　　结合前两节ActiveX控件VB代码和VBScritpt程序可见，ASP页面和GetDiskKeyNo控件相互配合的工作过程是：

　　1.当用户在IE浏览器中打开这个ASP页面进行登录时，浏览器将检查客户机是否已注册了GetDiskKeyNo控件，若客户机中未注册这一控件，IE立即自动下载该控件后在Windows中注册，并运行生成该控件的实例；

　　2.当用户填写好用户名、密码提交表单时，表单中的脚本程序tj_onclick将从表单的隐藏控件smw中取得动态加密规则码赋值给GetDiskKeyNo控件的sm属性，再取得GetDiskKeyNo的keyno属性值赋予smw隐藏控件，该值即为已动态加密的硬盘序列号；

　　3.服务器端验证页面CheckUser.asp接收从Login.asp页面中Post来的Username、Password、smw控件的值，将smw域的值解密还原得到硬盘序列号用于用户身份验证。

　　使用之前，我们需设置客户机IE浏览器的安全特性，在“可信站点”中加入发布控件站点的URL地址，并允许启用该站点的ActiveX控件，否则浏览器将拒绝执行GetDiskKeyNo控件程序，当然也就无法登录。


　　动态加密原理


　　将硬盘序列号随机动态加密后传送，能使每次从客户机传送到服务器的数值均不相同，目的是杜绝非法用户在网页中伪造序列号后提交的可能性。

　　动态加密的原理为：在服务器的ASP表单中产生随机动态加密规则码，将该码存放在一个Session变量中待解密时使用，同时在表单的隐藏Text控件smw存放该码，当在客户机中GetDiskKeyNo控件程序运行时，根据该码对硬盘序列号动态加密。

　　动态加密规则码的意义由程序设计员指定，可以设计出许多加密规则,一旦程序设计者修改GetDiskKeyNo控件的加密规则，就要同时修改Login.asp文件中控件的版本号和CheckUser.asp页面内的解密程序，然后再分发GetDiskKeyNo控件。分发的过程十分简单，只要将GetDiskKeyNo.ocx控件拷贝到服务器中替换原先的文件即可，客户机的浏览器将会自动检测控件的版本号，发现有升级将自动下载安装注册新控件，无需手工在客户机上做任何改动，大大降低了系统维护成本。


--------------------------------------------------------------------------------
结束语

　　采用动态加密技术的GetDiskKeyNo控件能够读取客户机的硬盘序列号并动态加密，
在网站上结合ASP登录页面和验证程序，
可以惟一地验证合法用户并限制用户仅在一台客户机上登录。
进行GetDiskKeyNo控件的分发、升级管理十分简单，
本文所述技术特别适用于提供有偿信息服务，且用户较多、分布范围广的网站使用。



==============================文章完===========================================
我现在想用delphi6 做这个OCX控件，要求返回硬盘的序列号，在ASP脚本中调用，验证用户。
但我没做过OCX,请大家指教。 很很急！！！！！！！！！！！

得先new一个ActiveX Library
再new一个Active Server Object
通过Type library Edit添加一个方法.
再在实现方法的单元里实现加法.

编译好后用regsvr32 your.dll注册.
就可以通过 server.createobject调用了.
呵呵,简单吧.

按leeChange说的，没错，如果你要带窗体的那就用activeform。

能在Activex中定义函数吗？它生成的都是procedure，谁有没有试过？

当然可以定义函数
较早用vb写过的，你试试看
asp中的代码：

heipi是我VB设计的一个obj,
webconn是一个class，db2好像是个heipi中的一个函数
如果用delphi，应该是published的函数db2
就是procedure
<%
set co =server.createobject("heipi.webconn")
db=co.db2()
%.>
没有用delphi做过，你可以试试看
我再找找原来VB的代码告诉你[8D]
对了，当时注册的是一个dll，ocx应该是一样，因为ocx需要下载
而且能取一些客户机上的资料而我那个不需要

to heipi2002:
谢谢，我试试

asp 调用时，要怎么做？

to LeeChange:
但是在 activex 中不能定义函数，我要一个返回值到ASP中，咋办呀

这个问题还没解决，大家赶快献计献策呀
怎样在ASP中取得ACTIVE的函数返回值？在ACTIVE中好象不能定义函数，???

我也有个问题,大家帮忙一下
http://www.delphibbs.com/delphibbs/dispq.asp?lid=1749287

不是记了个ocx的代码给你了吗?

to LeeChange:

非常感谢，我收到了，不过我回了一个EMAIL 给你，你没看吗？

LeeChange:

取硬盘应该用这个吧。

//得到计算机的硬盘序列号
function GetIdeSerialNumber: pchar;
const IDENTIFY_BUFFER_SIZE = 512;
type
TIDERegs = packed record
bFeaturesReg: BYTE; // Used for specifying SMART "commands".
bSectorCountReg: BYTE; // IDE sector count register
bSectorNumberReg: BYTE; // IDE sector number register
bCylLowReg: BYTE; // IDE low order cylinder value
bCylHighReg: BYTE; // IDE high order cylinder value
bDriveHeadReg: BYTE; // IDE drive/head register
bCommandReg: BYTE; // Actual IDE command.
bReserved: BYTE; // reserved for future use. Must be zero.
end;
TSendCmdInParams = packed record
// Buffer size in bytes
cBufferSize: DWORD;
// Structure with drive register values.
irDriveRegs: TIDERegs;
// Physical drive number to send command to (0,1,2,3).
bDriveNumber: BYTE;
bReserved: array[0..2] of Byte;
dwReserved: array[0..3] of DWORD;
bBuffer: array[0..0] of Byte; // Input buffer.
end;
TIdSector = packed record
wGenConfig: Word;
wNumCyls: Word;
wReserved: Word;
wNumHeads: Word;
wBytesPerTrack: Word;
wBytesPerSector: Word;
wSectorsPerTrack: Word;
wVendorUnique: array[0..2] of Word;
sSerialNumber: array[0..19] of CHAR;
wBufferType: Word;
wBufferSize: Word;
wECCSize: Word;
sFirmwareRev: array[0..7] of Char;
sModelNumber: array[0..39] of Char;
wMoreVendorUnique: Word;
wDoubleWordIO: Word;
wCapabilities: Word;
wReserved1: Word;
wPIOTiming: Word;
wDMATiming: Word;
wBS: Word;
wNumCurrentCyls: Word;
wNumCurrentHeads: Word;
wNumCurrentSectorsPerTrack: Word;
ulCurrentSectorCapacity: DWORD;
wMultSectorStuff: Word;
ulTotalAddressableSectors: DWORD;
wSingleWordDMA: Word;
wMultiWordDMA: Word;
bReserved: array[0..127] of BYTE;
end;
PIdSector = ^TIdSector;
TDriverStatus = packed record
// 驱动器返回的错误代码，无错则返回0
bDriverError: Byte;
// IDE出错寄存器的内容，只有当bDriverError 为 SMART_IDE_ERROR 时有效
bIDEStatus: Byte;
bReserved: array[0..1] of Byte;
dwReserved: array[0..1] of DWORD;
end;
TSendCmdOutParams = packed record
// bBuffer的大小
cBufferSize: DWORD;
// 驱动器状态
DriverStatus: TDriverStatus;
// 用于保存从驱动器读出的数据的缓冲区，实际长度由cBufferSize决定
bBuffer: array[0..0] of BYTE;
end;
var
hDevice: Thandle;
cbBytesReturned: DWORD;
SCIP: TSendCmdInParams;
aIdOutCmd: array[0..(SizeOf(TSendCmdOutParams) + IDENTIFY_BUFFER_SIZE - 1) - 1] of Byte;
IdOutCmd: TSendCmdOutParams absolute aIdOutCmd;
procedure ChangeByteOrder(var Data; Size: Integer);
var
ptr: Pchar;
i: Integer;
c: Char;
begin
ptr := @Data;
for I := 0 to (Size shr 1) - 1 do begin
c := ptr^;
ptr^ := (ptr + 1)^;
(ptr + 1)^ := c;
Inc(ptr, 2);
end;
end;
begin
Result := ''; // 如果出错则返回空串
if SysUtils.Win32Platform = VER_PLATFORM_WIN32_NT then begin // Windows NT, Windows 2000
// 提示! 改变名称可适用于其它驱动器，如第二个驱动器： '//./PhysicalDrive1/'
hDevice := CreateFile('//./PhysicalDrive0', GENERIC_READ or GENERIC_WRITE,
FILE_SHARE_READ or FILE_SHARE_WRITE, nil, OPEN_EXISTING, 0, 0);
end else // Version Windows 95 OSR2, Windows 98
hDevice := CreateFile('//./SMARTVSD', 0, 0, nil, CREATE_NEW, 0, 0);
if hDevice = INVALID_HANDLE_VALUE then Exit;
try
FillChar(SCIP, SizeOf(TSendCmdInParams) - 1, #0);
FillChar(aIdOutCmd, SizeOf(aIdOutCmd), #0);
cbBytesReturned := 0;
// Set up data structures for IDENTIFY command.
with SCIP do begin
cBufferSize := IDENTIFY_BUFFER_SIZE;
// bDriveNumber := 0;
with irDriveRegs do begin
bSectorCountReg := 1;
bSectorNumberReg := 1;
// if Win32Platform=VER_PLATFORM_WIN32_NT then bDriveHeadReg := $A0
// else bDriveHeadReg := $A0 or ((bDriveNum and 1) shl 4);
bDriveHeadReg := $A0;
bCommandReg := $EC;
end;
end;
if not DeviceIoControl(hDevice, $0007C088, @SCIP, SizeOf(TSendCmdInParams) - 1,
@aIdOutCmd, SizeOf(aIdOutCmd), cbBytesReturned, nil) then Exit;
finally
CloseHandle(hDevice);
end;
with PIdSector(@IdOutCmd.bBuffer)^ do begin
ChangeByteOrder(sSerialNumber, SizeOf(sSerialNumber));
(Pchar(@sSerialNumber) + SizeOf(sSerialNumber))^ := #0;
Result := Pchar(@sSerialNumber);
end;
end;

呵呵，那容易,你只要把
PanelImpl1.Pas文件里的
TPanelX.GetSerial的实现方法换成楼上的代码就可以了.

你得到的硬盘序列号不定准确，同时有的硬盘会运行死机。

to myyzg

有没有更好的，贴出来分享一下嘛

我原来试过几种方法，得到的均是硬盘卷标，有一种可以得到ID，但对于有些硬盘要死机，
而且用在WINDOWS2000下不行，因为2000无法访问硬件。

我认为获取IP地址和获取网卡的ID就可以了。

这个我试过，在2000/98下都可以的，有兴趣你试试吧

to LeeChanage:

我又发了Email给你，看看好吗？