怎样锁定光驱,输入正确的用户名和密码,才能进入?(30分)

  • 主题发起人 主题发起人 samecaoyh
  • 开始时间 开始时间
elan,谢谢,也给我一份?
Jianglingsheng@netease.com
 
我们都有些不好意思了.
g622@xju.edu.cn
 
俺们。。。
tingweb@990.net
谢谢
 
elan大虾,我也要!最好能够谈谈技术问题,怎么实现的呢?
wind@linux.shtdu.edu.cn
 
假设E:是cdrom,下面代码在nt下有效,win95就不知道了
HANDLE h=CreateFile("////.//E:",GENERIC_READ,0,NULL,OPEN_EXISTING,0,NULL);
if(h==INVALID_HANDLE_VALUE)
RaiseLastWin32Error();
DWORD n;
PREVENT_MEDIA_REMOVAL s={true};
if(!DeviceIoControl(h,IOCTL_STORAGE_MEDIA_REMOVAL,&s,sizeof s,NULL,0,&n,NULL))
RaiseLastWin32Error();
CloseHandle(h);
 
是在对不起各位朋友,最近一段时间以来我特别忙,我已经2个月没有使用心爱的delphi了。
但是,等忙过这周后,我会把源码整理一下贴出来,ok?
另外,我想在网页上实现这么一个功能。我想判断另一个网站是否已经通了,如果通了,就显示一张图片,告诉访问者可以到这浏览。请各位高手指教,谢谢!
 
你可以自己通过winsocket去尝试连接该网站的80端口呀,
 
等你的源代码!
 
elan大虾,叶酸俺一个!!
tomas_yu@263.net
 
elan大虾:
我也要,sdsssl@163.net
 
Elan 大虾,
我,我,实在不好意思,那么多人问你要我还问……
suquandao@263.net
 
我也想要一个,要不这样吧,放到你的主页上,大家去下吧
lidazhao@cmmail.com
 
情人节的问题,现在又拿出来,不只斑竹是怎么当的,为何不结束此问题的讨论??
 
好象 WM_DEVICECHANGE 中有一个东东可以禁止 cdrom 出来。
 
好了,贴在这儿吧。本来想着手进行对多个光驱的设置的,但现在看来。。。。
这只是一个vcl,大家自己改改吧。不好意思 :-)
unit eLanCDRom;
{ ==================================================== }
{ Component TeLanCDRomMonitor }
{ ==================================================== }
{ 作 者 :eLan }
{ E-mail : eLan@126.com }
{ 创建时间 :1998-09-04 }
{ 最后修改时间:1998-11-18 }
{ ==================================================== }
{ You are free to use, modify and distribute this code }
{ as you like. But I ask you to send me a copy of new }
{ versions. And please give me credit when you use }
{ parts of my code in other components or applications.}
{ ==================================================== }
{ Properties, Methods and Events : }
{ ---------------------------------------------------- }
{ DrvName
MonitorState
Close
Eject
StartMonitor
EndMonitor
Lock
StartOnMonitor
OnDiscArrive
OnDiscRemove
}
{ ==================================================== }
{ 修改记录: }
{
1998-09-05 晚 第一次调试成功
1998-10-31 修改
1998-11-09 添加 TCDNotifyEvent 类型,以便给响应事件传
递盘符参数
}
{ ---------------------------------------------------- }
interface
uses
MMSystem, Classes, Messages, Controls, SysUtils, Windows,
WinProcs, Forms;
const
DBT_DeviceArrival =32768;
DBT_DeviceRemoveComplete=32772;
DBT_DEVTYP_OEM =1;
//OEM- or IHV-defined device type
DBT_DEVTYP_VOLUME =2;
//Logical volume.
DBT_DEVTYP_PORT =3;
//Port device (serial or parallel)
DBTF_MEDIA =1;
type
DEVIOCTL_REGISTERS = packed record
reg_EBX : DWORD;
reg_EDX : DWORD;
reg_ECX : DWORD;
reg_EAX : DWORD;
reg_EDI : DWORD;
reg_ESI : DWORD;
reg_Flags : DWORD;
end;
PDEVIOCTL_REGISTERS = ^DEVIOCTL_REGISTERS;
{ MID = packed record //Interrupt 21h Function 440Dh Minor Code 66h
midInfoLevel : WORD ;
midSerialNum : DWORD ;
midVolLabel : array[0..10] of byte;
midFileSysType: array[0..8] of byte;
end;
PMID = ^ MID;}
PARAMBLOCK = packed record
Operation : WORD;
//Interrupt 21h Function 440Dh Minor Code 48h
NumLocks : WORD;
end;

const
WIN95_IOCTL_DEV = '//./vwin32';
VWIN32_DIOC_DOS_IOCTL = 1;
Type
TCDRomAct = (eEject, eClose);
TMonitorState = (eMonitorOn, eMonitorOff);
TDEV_BROADCAST_VOLUME = record
dbcv_Size :Byte ;
dbcv_DeviceType:Integer ;
dbcv_Reserved :Integer ;
dbcv_UnitMask :Integer ;
dbcv_Flags :Smallint ;
end;
PDEV_BROADCAST_VOLUME =^TDEV_BROADCAST_VOLUME;
TCDNotifyEvent = procedure(Sender: TObject;Drv:String) of object;
TeLanCDRomMonitor = Class(TComponent)
private
MyOwner : TForm;
MyOwnerHandle : THandle;
fDrvName : String;
fOnDiscArrive : TCDNotifyEvent;
fOnDiscRemove : TCDNotifyEvent;
fMonitorState : TMonitorState;
fStartOnMonitor: Boolean;
fLocked : Boolean;
//fP : PDEV_BROADCAST_VOLUME;
function GetDrvName(fDrvMask:Integer):String;
procedure CDRomAction(Action:TCDRomAct);
procedure SetStartOnMonitor(const Value: Boolean);
procedure do
LockCDRom(const fLock:Boolean;
const Drv:String);
protected
OldWndProc : TFarProc;
NewWndProc : Pointer;
procedure HookWin;
procedure UnhookWin;
procedure HookWndProc(var AMsg: TMessage);
public
procedure Eject;
procedure Close;
procedure Lock;
overload;
procedure Lock(const DrvName:Char);overload;
procedure Unlock;overload;
procedure Unlock(const DrvName:Char);overload;
procedure StartMonitor;
procedure EndMonitor;
property MonitorState :TMonitorState read fMonitorState;
property DrvName : String read FDrvName;
constructor Create(AOwner:tComponent);Override;
destructor Destroy;Override;
procedure Loaded;override;
published
property OnDiscArrive:TCDNotifyEvent read fOnDiscArrive Write fOnDiscArrive;
property OnDiscRemove:TCDNotifyEvent read fOnDiscRemove write fOnDiscRemove;
property StartOnMonitor:Boolean read FStartOnMonitor write SetStartOnMonitor default True;
property Locked:boolean read fLocked;
end;

procedure Register;
implementation
procedure Register;
begin
RegisterComponents('eLan Soft',[TeLanCDRomMonitor]);
end;

{ TeLanCDRom }
procedure TeLanCDRomMonitor.CDRomAction(Action: TCDRomAct);
var
MCIDevice:TMCI_Open_Parms;
begin
MCIDevice.lpstrDeviceType :='CDAudio';
mciSendCommand(0,MCI_OPEN,MCI_OPEN_TYPE ,Integer(@MCIDevice ));
case Action of
eEject: mciSendCommand(MCIDevice.wDeviceID,MCI_SET, MCI_SET_DOOR_OPEN ,0);
eClose: mciSendCommand(MCIDevice.wDeviceID,MCI_SET, MCI_SET_DOOR_CLOSED ,0);
end;
mciSendCommand(MCIDevice.wDeviceID,MCI_CLOSE,0,0);
end;

procedure TeLanCDRomMonitor.Close;
begin
CDRomAction(eClose);
end;

procedure TeLanCDRomMonitor.Eject;
begin
CDRomAction(eEject);
end;

constructor TeLanCDRomMonitor.Create(AOwner: tComponent);
var I:Integer;
begin
for I:=0 to AOwner.ComponentCount -1do
if AOwner.Components is Self.ClassType then
raise Exception.Create(
Self.ClassName + ' component Duplicated');
inherited Create(aOwner);
with AOwner as TFormdo
begin
MyOwner := TForm(AOwner);
{ My pointer to my owner form }
MyOwnerHandle := MyOwner.Handle;
//New(fP);
FStartOnMonitor :=true;
end;

fLocked:=False;
end;

destructor TeLanCDRomMonitor.Destroy;
begin
if fLocked then
Unlock;
if fMonitorState = eMonitorOn then
UnhookWin;
//if Assigned(fP) then
Dispose(fP);
inherited Destroy;
{Call default processing.}
end;

procedure TeLanCDRomMonitor.Loaded;
begin
if (fStartOnMonitor) and not (csDesigning in MyOwner.ComponentState) then
begin
HookWin;
fMonitorState :=eMonitorOn;
end
else
fMonitorState :=eMonitorOff;
end;

procedure TeLanCDRomMonitor.EndMonitor;
begin
if fMonitorState = eMonitorOn then
begin
UnhookWin;
fMonitorState := eMonitorOff;
end;
end;

procedure TeLanCDRomMonitor.StartMonitor;
begin
if fMonitorState = eMonitorOff then
begin
HookWin;
fMonitorState :=eMonitorOn;
end;
end;

function TeLanCDRomMonitor.GetDrvName(fDrvMask: Integer): String;
{ ----------------------------------------------------- }
{ 98-8-29 陈华珊编写 }
{ 用于将 TDEV_BROADCAST_VOLUME 结构的 dbcv_unitmask 成员}
{ 掩码转换成 000001 格式的字符串,按顺序分别代表 A、B、 }
{ D、… 驱动器,其中 1 表示该对应的驱动器发生变化。 }
{ 在弹出或关闭光驱时返回光驱所在的盘符 }
{ ----------------------------------------------------- }
var
TemStr:string;
iPos :integer;
begin
//MessageBox(0,pchar(IntToStr(fdrvmask)),'',mb_OK);
while fDrvMask>1do
begin
TemStr := TemStr+IntToStr(fDrvMask mod 2);
fDrvMask := fDrvMask div 2;
end;
TemStr := TemStr+IntToStr(fDrvMask);
{ 找到第一个 1 出现的位置 }
iPos := Integer(StrPos(PChar(TemStr),'1')) - Integer(Pchar(TemStr));
iPos := iPos+65;
{A 的ASCII值为65}
Result := Char(iPos)+':/';
end;

procedure TeLanCDRomMonitor.SetStartOnMonitor(const Value: Boolean);
begin
//if (csDesigning in MyOwner.ComponentState) then
FStartOnMonitor := Value;
end;

procedure TeLanCDRomMonitor.HookWin;
begin
OldWndProc := TFarProc(GetWindowLong(MyOwnerHandle, GWL_WNDPROC));
NewWndProc := MakeObjectInstance(HookWndProc);
SetWindowLong(MyOwnerHandle, GWL_WNDPROC, LongInt(NewWndProc));
end;
{ HookWin }
procedure TeLanCDRomMonitor.HookWndProc(var AMsg: TMessage);
var fP : PDEV_BROADCAST_VOLUME;
begin
New(fP);
try
if AMsg.Msg = WM_DeviceChange then
begin
if (AMsg.LParam <> 0) then
begin
fP:=PDEV_BROADCAST_VOLUME(AMsg.LParam);
case AMsg.WParam of
DBT_DeviceArrival :
begin
if (fP.dbcv_DeviceType = dbt_DEVTYP_VOLUME) and
(Assigned(fOnDiscArrive)) then
begin
fDrvName :=GetDrvName(fP.dbcv_UnitMask);
fOnDiscArrive(self,fDrvName);
end;
end;

DBT_DeviceRemoveComplete:
begin
if (fP.dbcv_DeviceType = dbt_DEVTYP_VOLUME) and
(Assigned(fOnDiscRemove)) then
begin
fDrvName :=GetDrvName(fP.dbcv_UnitMask);
fOnDiscRemove(self,fDrvName);
end;
end;
end;
end;
end;
finally
fP:=nil;
Dispose(fP);
end;
AMsg.Result := CallWindowProc(OldWndProc,MyOwnerHandle, AMsg.Msg, AMsg.wParam, AMsg.lParam);
end;

procedure TeLanCDRomMonitor.UnhookWin;
begin
if Assigned(NewWndProc) then
begin
SetWindowLong(MyOwnerHandle, GWL_WNDPROC, LongInt(OldWndProc));
FreeObjectInstance(NewWndProc);
NewWndProc := nil;
end;
end;
{ UnHookWin }
procedure TeLanCDRomMonitor.Lock;
var DrvName : Char;
begin
if fLocked then
Exit;
DrvName:='a';
repeat
if GetDriveType(pchar(drvname+':/')) = DRIVE_CDROM then
do
LockCDRom(True,DrvName);
Inc(DrvName);
until DrvName = 'z';
end;

procedure TeLanCDRomMonitor.Lock(const DrvName: Char);
begin
if fLocked then
Exit;
do
LockCDRom(True,DrvName);
end;

procedure TeLanCDRomMonitor.Unlock;
var DrvName : Char;
begin
if not fLocked then
Exit;
DrvName:='a';
repeat
if GetDriveType(pchar(drvname+':/')) = DRIVE_CDROM then
do
LockCDRom(FAlse,DrvName);
Inc(DrvName);
until DrvName = 'z';
end;

procedure TeLanCDRomMonitor.Unlock(const DrvName: Char);
begin
if not fLocked then
Exit;
do
LockCDRom(FAlse,DrvName);
end;

procedure TeLanCDRomMonitor.DoLockCDRom(const fLock: Boolean;
const Drv: String);
functiondo
IOCTL(Reg : DEVIOCTL_REGISTERS):BOOL;
var
hDevice : THandle;
fResult : BOOL;
cb : DWORD ;
begin
Result:=False;
hDevice :=0;
Reg.reg_Flags := $8000;
// assume error (carry flag set)
try
hDevice := CreateFile('//./vwin32',
GENERIC_READ, FILE_SHARE_READ or FILE_SHARE_WRITE,
nil, OPEN_EXISTING,
FILE_ATTRIBUTE_NORMAL, 0);
if hDevice = 0 then
Exit
else
begin
fResult := DeviceIoControl(hDevice,
VWIN32_DIOC_DOS_IOCTL,
@reg, sizeof(reg),
@reg, sizeof(reg), cb, nil);
if not fResult then
Exit;
Result:= TRUE;
end;
finally
CloseHandle(hDevice);
end;
end;

var
reg : DEVIOCTL_REGISTERS;
ParamB : PARAMBLOCK;
begin
if fLock then
ParamB.Operation :=0
else
ParamB.Operation :=1;
reg.reg_EAX := $440D;
// IOCTL for block devices
reg.reg_EBX := Integer(LowerCase(Drv)) - Integer('a') + 1;
// zero-based drive ID
reg.reg_ECX := $0848;
// Get LockStatus
reg.reg_EDX := DWORD(@ParamB);
// receives media ID info
do
IOCTL(reg);
fLocked :=not fLocked;
end;

end.

哎呀,分怎么那么少啊!
 
elan兄,我今天才见到程序,正在测试.你认为需要多少分?
 
呵呵,多多益善啦,我花了7个月时间才琢磨出来的。 怎么我收不到email呢?
 
elan兄,我正在测试.请到samecaoyh的"给elan兄的分"
 
多人接受答案了。
 

Similar threads

S
回复
0
查看
3K
SUNSTONE的Delphi笔记
S
S
回复
0
查看
2K
SUNSTONE的Delphi笔记
S
D
回复
0
查看
2K
DelphiTeacher的专栏
D
D
回复
0
查看
1K
DelphiTeacher的专栏
D
后退
顶部