怎样写这个Activex.谢谢！ ( 积分: 50 )

在Delphi6中怎样编写一个得到硬盘序列号的ocx或dll提供给ASP调用？
具体一点，谢谢！

在Delphi6中怎样编写一个得到硬盘序列号的ocx或dll提供给ASP调用？
具体一点，谢谢！

都快找不到帖子了。
没人回答？待答中！！！！！

关 注！

不懂，帮顶。

不是吧！没人回答，还是太难了的原因呢？？/？

你是写Activex不会还是读硬盘序列号不会

写Activex不会
1/
http://www.gislab.ecnu.edu.cn/delphibbs/DispQ.asp?LID=315264
如何在VB中使用Delphi的控件 南京南自总厂开发中心 张玉洲 南京理工大学98研
王静 ---- 　　
用过Delphi的编程爱好者们都知道，Delphi中Visual Component Library(VCL)中具有大
量的组件，尤其是第三方设计的VCL，如Ahm系列，LMD系列，VenusPro等，在程序中适当
的使用它们会让你的程序在界面上或者功能上增色不少，这让许多VB迷们馋的掉口水，
因为毕竟免费的并且功能强大的ActiveX控件太少了，本文就是为那些到处找控件的VB迷
写的。 ---- 　　为方便讲述，以Delphi4 中Samples 标签下的ColorGrid组件为例，
描述如何将ColorGrid导出成ActiveX控件。 ---- 1、打开delphi4，运行File- >New，
弹出NewItems对话框，点取"ActiveX"标签，选择ActivexControl，选择"OK&quot
----
2、在出现的ActiveX Control Wizard的对话框中，有如下选择： ----
VCL Class Name：选择要导出的或继承的VCL组件(注意非TwinControl继承的VCL不
再列表中，之后再讨论)，选择TColorGrid ---- New Activex Name：要导出的ActiveX控
件名，取默认值ColorGridX即可 ---- Implementation Unit：实现单元，取缺省名称
---- Project Name：创建的工程名，取缺省名称 ---- Thread Model：线程模式，
详看Delphi帮助，这里取默认值Apartment（单线程） ---- Include Design-Time
License：是否包含使用许可信息 ---- Include About Box：是否包含"About"对话框
---- Include Version Informaion：是否包含版本信息 ---- 单击"OK"，此时Delphi
为我们创建了三个文件： ---- 库文件　　ColorGridXControl1 ---- 实现单元　
ColorGridImpl1 ---- 类型文件　ColorGridXControl1_TLB ----
3、选择菜单Run->Register ActiveX Server，会出现注册成功的信息：
"Successfully Registered ActiveX Server,'.../ColorGridControl1.ocx'
"---- 这里的ColorGridXControl1.ocx就是你所需要的颜色选取控件。
---- 现用VB6对其进行测试： ---- 1、新建一VB6工程，选取菜单"工程->部件"，在
出现的对话框中选中ColorGridXControl1 Library，选"确定"。 ---- 2、在窗体Form1上
放置控件ColorGridX，取默认名称"ColorGridX1"。 ---- 3、如何利用它的属性和方法：
以获得选取
颜色为例，在它的OnClick事件中添加监视ColorGridX1，发现其属性Object返回对Delphi
控件的引用，ForegroundColor属性值代表选中的颜色，虽然在"ColorGridX1.Object."后
没有代码提示，但仍然可以用ColorGridX1.Object.ForegroundColor可得到颜色值。 ----
如果你想完善这个控件，在键入"ColorGridX1."后直接得到ForegroundColor的属性提示，
那就必须手工在Delphi中为ColorGridX填加属性/方法，步骤如下： ---- 1、选中实现单元
ColorGridImpl1，选菜单"Edit->Add To Interface",在出现的对话框中的Declaration填
写"Property ForegroundColor:integer"，选"OK"，这时Delphi自动为你填加了两个过程

框架： procedure TColorGridX.Set_ForeColor(Value: Integer);function TColorGridX.
Get_ForeColor: Integer;2、在Get_ForeColor中添加代码result:=FDelphiControl.
ForegroundColor;由于ColorGrid的ForegroundColor属性为只读，Set_ForeColor过程
不用写了。---- 3、编译执行，Run->Register ActiveX Server，会出现注册成功的信
息。再到VB中，会发现控件ColorGridX新增了ForeColor属性，代表选中的颜色值。
---- 依此类推，可以增加其它有用的属性供VB等显式调用。用这种办法，可以把
大多数由TWinControl继承下来的组件导出，那么非TWinControl的组件以及没有列
出的组件怎么导出呢？且看下文。 ---- 　　前面提到创建ActiveX控件时，
在ActiveX Control Wizard的对话框的VCLClassName下拉列表中找不到想导
出的VCL组件，这是因为该组件不是由TwinControl继承下来的，属"Windowless"那

一种，这时我们可以用ActiceForm的形式把它导出来，以第三方控件TColorPickerButton
为例： ---- 1、选菜单"File->New",在出现的"New Items"对话框中选择"ActiveX"标签,
选中ActiveXForm,选择"OK&quot
---- 2、在出现的"ActiveForm Wizard"的"New ActiveX Name"
中填写输出的控件名"ColorPicker",选择"OK&quot
---- 3、在Delphi为我们创建的窗体上放
置TColorPickerButton组件，名为"ColorPickerButton1",将窗体调整到合适大小，选菜

单"Edit->Add To Interface",为它添加属性：Property SelectColor:integer，
选择"OK&quot
---- 4、在Delphi提供的框架中写下类似代码： ---- 读取颜色:
function TColorPicker.Get_SelectColor: Integer
begin
result:=ColorPickerButton1.SelectionColor;end;设置颜色:
procedure TColorPicker.Set_SelectColor(Value: Integer);
beginColorPickerButton1.SelectionColor:=Value
end;----
5、编译执行，Run->Register ActiveX Server，会得到注册成功的消息。
---- 6、用前面讲述的方法在VB6下实验，获得成功。
---- 关于添加属性的两点说明：
---- 1、原形为"Property {属性/方法名}:数值类型",其中数值类型有：
WordBool、WideString、Integer等 ---- 2、如果出现"SafeCall function
Requires a HResult return type"的错误提示，说明你添加的属性/方法名已经存在
，换个名字即可。 ---- 　　至此，我们已经成功导出了GridColor(属TWinControl继承类)
和ColorPicker(属"Windowless&quot，写此文仅为抛砖引玉，
还有许多功能强大的"For Delphi"的第三方控件的我们可以转化，
提醒一点，并不是所有的VCL组件都能转成ActiveX,如Delphi的通用对话对话框。
现在我们可以制作自己的ActiveX控件而不受限制了，最大的优点在于：
强大&免费!现在，你也能利用自己导出的ActiveX控件用VB写出漂亮的程序来了，
而且不用担心注册号之类的困绕！ ^_^

2/
一、进入Delphi，新建一个ActiveX Form，New ActiveX Name为"AFXComNgUpdate"。
二、菜单"View"-->"Type Library"，右击"IAFXComNgUpdate"-->"New"-->"Property"新建一属性，并将该属性重命名为"iaswsdl"，Type属性改为"BSTR"(或WideString)。按同样办法，新建一个字符串型属性"TableName"。
三、查看AFXComNgUpdateImpl1.pas单元，可看到以下代码:
function TAFXComNgUpdate.Get_iaswsdl: WideString;
begin

end;

procedure TAFXComNgUpdate.Set_iaswsdl(const Value: WideString);
begin

end;

function TAFXComNgUpdate.Get_TableName: WideString;
begin

end;

procedure TAFXComNgUpdate.Set_TableName(const Value: WideString);
begin

end;
四、定义全局变量
var
MyCount:integer;
iaswsdl,TableName:string;
五、在AFXComNgUpdate的OnCreate事件初始化MyCount为0：
procedure TAFXComNgUpdate.ActiveFormCreate(Sender: TObject);
begin
MyCount:=0;
end;
六、添加一个全局过程：
procedure TAFXComNgUpdate.DoMyApplication;
begin
inc(MyCount);
Showmessage(Format('MyCount=%d,iaswsdl=%s,TableName:=%s',[MyCount,iaswsdl,TableName]));
if MyCount=2 then ;//已接收到2个参数，可转入你自己定义的功能
end;
七、修改过程如下：
procedure TAFXComNgUpdate.Set_iaswsdl(const Value: WideString);
begin //此Value的值来自网页参数，得及时把它传给全局变量
iaswsdl:=Value;//<param name=&quot;iaswsdl&quot
value=&quot;http://10.79.1.168:7777/blob-tys-context-root/mypackage2.testblob&quot;>
DoMyApplication;
end;

procedure TAFXComNgUpdate.Set_TableName(const Value: WideString);
begin //此Value的值来自网页参数，得及时把它传给全局变量
TableName:=Value;//<param name=&quot;TableName&quot
value=&quot;OSIS_FWCL_B_FJ&quot;>
DoMyApplication;
end;
八、编译、发布网页AFXComNgUpdateProj1.htm，并修改网页内容如下：
<HTML>
<H1> Delphi 6 ActiveX Test Page </H1><p>
You should see your Delphi 6 forms or controls embedded in the form below.
<HR><center><P>
<OBJECT
classid=&quot;clsid:67D18AB3-3B9B-40F8-993E-FB3B0DD0D276&quot;
codebase=&quot;AFXComNgUpdateProj1.ocx#version=1,0,0,0&quot;
width=252
height=142
align=center
hspace=0
vspace=0
>
<param name=&quot;iaswsdl&quot
value=&quot;http://10.79.1.168:7777/blob-tys-context-root/mypackage2.testblob&quot;>
<param name=&quot;TableName&quot
value=&quot;OSIS_FWCL_B_FJ&quot;>
</OBJECT>
</HTML>
九、执行网页AFXComNgUpdateProj1.htm，成功！


读硬盘序列号不会？

http://www.delphibbs.com/delphibbs/dispq.asp?LID=1479167
function GetHDNumber(Drv : String): DWORD
//得到硬盘序列号
var
VolumeSerialNumber : DWORD;
MaximumComponentLength : DWORD;
FileSystemFlags : DWORD;
begin
if Drv[Length(Drv)] =':' then Drv := Drv + '/';
GetVolumeInformation(pChar(Drv),
nil,
0,
@VolumeSerialNumber,
MaximumComponentLength,
FileSystemFlags,
nil,
0);
Result:= (VolumeSerialNumber);

end;

function Serial(NumWORD):string
//这个号码是用户给你生成注册码的，它通过对硬盘序列号编码而来。
var sNum:string
inChar:array[1..4]of char;
begin

Num:=Num xor 8009211011;
sNum:=inttostr(Num);
inChar[1]:=char(((integer(sNum[1])+integer(sNum[2]))mod 5)+integer('a'));
inChar[2]:=char(((integer(sNum[3])+integer(sNum[4]))mod 5)+integer('a'));
inChar[3]:=char(((integer(sNum[5])+integer(sNum[6]))mod 5)+integer('a'));
inChar[4]:=char(((integer(sNum[7])+integer(sNum[8])+integer(sNum[9]))mod 5)+integer('a'));
insert(inChar[1],sNum,1);
insert(inChar[4],sNum,3);
insert(inChar[2],sNum,5);
insert(inChar[3],sNum,9);
Result:=sNum;

end;

function encode(License:string):string;
var str,sNum:string
number:dword
byte,byte1:array[1..4]of dword;
inChar:array[1..3]of char;
begin
str:=license;
delete(str,1,1);
delete(str,2,1);
delete(str,3,1);
delete(str,6,1);
number:=strtoint64(str);
number:=not number;
number:=number xor $1973122980;
byte[1]:=(number and $0ff000000) shr 24;
byte[2]:=(number and $0ff0000) shr 16;
byte[3]:=(number and $0ff00) shr 8;
byte[4]:=(number and $0ff);

byte1[1]:=((byte[1]and $0c0)+(byte[2]and $0c0)shr 2)+((byte[3]and $0c0)shr 4)+((byte[4]and $0c0)shr 6);
byte1[2]:=((byte[1]and $30)shl 2)+(byte[2]and $30)+((byte[3]and $30)shr 2)+((byte[4]and $30)shr 4);
byte1[3]:=((byte[1]and $0c)shl 4)+((byte[2]and $0c)shl 2)+(byte[3]and $0c)+((byte[4]and $0c)shr 2);
byte1[4]:=((byte[1]and $03)shl 6)+((byte[2]and $03)shl 4)+((byte[3]and $03)shl 2)+(byte[4]and $03);
number:=((byte1[1])shl 24)+((byte1[2])shl 16)
+((byte1[3])shl 8)+(byte1[4]);

byte[1]:=((number and $0ff000000)shr 24);//右移24位
byte[2]:=((number and $0ff0000)shr 16);
byte[3]:=((number and $0ff00)shr 8);
byte[4]:=(number and $0ff);

byte[1]:=(((byte[1] and $f0))shr 4)+(((byte[1] and $0f))shl 4);
byte[2]:=(((byte[2] and $f0))shr 4)+(((byte[2] and $0f))shl 4);
byte[3]:=(((byte[3] and $f0))shr 4)+(((byte[3] and $0f))shl 4);
byte[4]:=(((byte[4] and $f0))shr 4)+(((byte[4] and $0f))shl 4);

number:=((byte[2])shl 24)+((byte[1])shl 16)
+((byte[4])shl 8)+(byte[3]);

sNum:=inttostr(Number);
inChar[1]:=char(((integer(sNum[1])+integer(sNum[2]))mod 5)+integer('a'));
inChar[2]:=char(((integer(sNum[3])+integer(sNum[4]))mod 5)+integer('a'));
inChar[3]:=char(((integer(sNum[5])+integer(sNum[6]))mod 5)+integer('a'));
insert(inChar[1],sNum,1);
insert(inChar[2],sNum,5);
insert(inChar[3],sNum,9);
result:=sNum;


end;

function decode(code:string):dword;
var str:string
number:dword
byte,byte1:array[1..4]of dword;
begin

str:=code;
delete(str,1,1);
delete(str,4,1);
delete(str,7,1);
number:= strtoint64(str);
byte[1]:=(number and $0ff000000) shr 24;
byte[2]:=(number and $0ff0000) shr 16;
byte[3]:=(number and $0ff00) shr 8;
byte[4]:=(number and $0ff);

////0123 --> 1032
byte[1]:=(((byte[1] and $f0))shr 4)+(((byte[1] and $0f))shl 4);
byte[2]:=(((byte[2] and $f0))shr 4)+(((byte[2] and $0f))shl 4);
byte[3]:=(((byte[3] and $f0))shr 4)+(((byte[3] and $0f))shl 4);
byte[4]:=(((byte[4] and $f0))shr 4)+(((byte[4] and $0f))shl 4);

number:=((byte[2])shl 24)+((byte[1])shl 16)
+((byte[4])shl 8)+(byte[3]);

byte[1]:=((number and $0ff000000)shr 24);//右移24位
byte[2]:=((number and $0ff0000)shr 16);
byte[3]:=((number and $0ff00)shr 8);
byte[4]:=(number and $0ff);

byte1[1]:=(byte[1]and $0c0)+((byte[2]and $0c0)shr 2)+((byte[3]and $0c0)shr 4)+((byte[4]and $0c0)shr 6);
byte1[2]:=((byte[1]and $30)shl 2)+(byte[2]and $30)+((byte[3]and $30)shr 2)+((byte[4]and $30)shr 4);
byte1[3]:=((byte[1]and $0c)shl 4)+((byte[2]and $0c)shl 2)+(byte[3]and $0c)+((byte[4]and $0c)shr 2);
byte1[4]:=((byte[1]and $03)shl 6)+((byte[2]and $03)shl 4)+((byte[3]and $03)shl 2)+(byte[4]and $03);

number:=((byte1[1])shl 24)+((byte1[2])shl 16)
+((byte1[3])shl 8)+(byte1[4]);

number:=number xor $1973122980;
number:= not number;
result:= number;

end;

－－－－－－－－－－－－－－－－－－－－－－以上内容转自网络

我是写Activex不会。
我先看下你的方法，谢谢！