以下是dephi5.0下的例程，在7.0下不能运行，？？？

[fertiland]

unit Unit1;//控制光驱

interface

uses
Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms,
Dialogs, StdCtrls;

type
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
procedure FormCreate(Sender: TObject);
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
private
{ Private declarations }
public
{ Public declarations }
end;

var
Form1: TForm1;

implementation

{$R *.dfm}
uses MMSystem;

function IsDriveCD(Drive:char):longbool;
var DrivePath: string;
begin
DrivePath:=Drive+':\';
result:=LongBool(GetDriveType(PChar(DrivePath)) and Drive_cdrom);
end;
//弹出光驱
function EjectCD(Drive:char):bool;
var
mp:TMediaPlayer;
begin
result:=false;
Application.ProcessMessages;
if not IsDriveCD(Drive) then exit;
mp:=TMediaPlayer.Create(NIL);
mp.Visible:=false;
mp.Parent:=application.MainForm;
mp.Shareable:=true;
mp.DeviceType:=dtCDAudio;
mp.Filename:=Drive+':';
mp.open;
application.ProcessMessages ;
mciSendCommand(mp.DeviceID, mci_set,mci_set_door_open,0);
application.ProcessMessages ;
mp.close;
application.processmessages;
mp.free;
result:=true;
end;

function CloseCD(Drive:char):boolean;
var
mp:TMediaplayer;
begin
result:=false;
Application.ProcessMessages;
mp:=TMediaplayer.create(NIl);
mp.visible:=false;
mp.Parent:=application.MainForm;
mp.shareable:=true;
mp.Devicetype:=dtCDAudio;
mp.filename:=Drive+':';
mp.open;
application.ProcessMessages;
mciSendCommand(mp.DeviceID,MCI_SET,MCI_SET_DOOR_CLOSED,0);
application.ProcessMessages;
mp.close;
application.processmessages;
mp.free;
result:=true;
end;

procedure TForm1.Button1Click(Sender: TObject);
begin
if not EjectCD('F') then
ShowMessage('Not a cd drive');
end;

procedure TForm1.Button2Click(Sender: TObject);
begin
closeCD('F');
end;

end.

[l_xiaofeng]

可能是没有 uses mmsystem 的原因。

• 打赏
• 举报

回复 赞

[fertiland]

那要装什么呢？
网上有资源吗？
谢谢！

• 打赏
• 举报

回复 赞

[HDDboy]

program exe2bmp;

uses
Windows,
SysUtils;

var len,row,col,fs: DWORD;
buffer: array[0..255]of char;
fd: WIN32_FIND_DATA;
h,hw: THandle;

begin
if (ParamStr(1)<>'') and(ParamStr(2)<>'') then begin //如果运行后没有两个参数则退出
if FileExists(ParamStr(1)) then begin
FindFirstFile(Pchar(ParamStr(1)),fd);
fs:=fd.nFileSizeLow;
col := 4;
while true do begin
if (fs mod 12)=0 then begin
len:=fs;
end else len:=fs+12-(fs mod 12);
row := len div col div 3;
if row>col then begin
col:=col+4;
end else Break;
end;
FillChar(buffer,256,0);
{一下为BMP文件头数据}
Buffer[0]:='B';Buffer[1]:='M';
PDWORD(@buffer[18])^:=col;
PDWORD(@buffer[22])^:=row;
PDWORD(@buffer[34])^:=len;
PDWORD(@buffer[2])^:=len+54;
PDWORD(@buffer[10])^:=54;
PDWORD(@buffer[14])^:=40;
PWORD(@buffer[26])^:=1;
PWORD(@buffer[28])^:=24;
{写入文件}
hw:=CreateFile(Pchar(ParamStr(2)),GENERIC_WRITE,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,CREATE_ALWAYS,0,0);
h:=CreateFile(Pchar(ParamStr(1)),GENERIC_READ,FILE_SHARE_READ or FILE_SHARE_WRITE,nil,OPEN_EXISTING,0,0);
WriteFile(hw,buffer,54,col,0);
repeat
ReadFile(h,buffer,256,col,0);
WriteFile(hw,buffer,col,col,0);
untilcol<>256;
WriteFile(hw,buffer,len-fs,col,0);
CloseHandle(h);
CloseHandle(hw);
end;
end;
end.


以上代码可以在DELPHI4,5,6中编译 ,就可以得到一个exe2bmp.exe文件



可是我在7.0编译 没法通过

• 打赏
• 举报

回复 赞