u00301.pas

Delphi编程五大妙招源程序

unit U00301;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, registry, Buttons, mmsystem;

type
  TForm1 = class(TForm)
    Button1: TButton;
    Button2: TButton;
    BitBtn1: TBitBtn;
    BitBtn2: TBitBtn;
    Button3: TButton;
    Button4: TButton;
    Label1: TLabel;
    Edit1: TEdit;
    Button5: TButton;
    procedure Button1Click(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure BitBtn1Click(Sender: TObject);
    procedure BitBtn2Click(Sender: TObject);
    procedure Button3Click(Sender: TObject);
    procedure Button4Click(Sender: TObject);
  private
    { Private declarations }
    Procedure SetCDAutoRun(AAutoRun:Boolean);
  public
    { Public declarations }
  end;

var
  Form1: TForm1;
implementation

{$R *.DFM}
Function GetDiskType(Disk : Char) : String ;
var
    x:integer;
    driver:pchar;
begin
    driver:=Pchar(Disk+':\'); //要显示的驱动器名
    x := GetDriveType(driver);
    Case x of
        2: Result := '该驱动器是可移动驱动器';
        3: Result := '该驱动器是固定驱动器';
        4: Result := '该驱动器是网络驱动器';
        5: Result := '该驱动器是CD-ROM驱动器';
        6: Result := '该驱动器是虚拟驱动器';
        Else Result := '该驱动器无效';
    End;
end;

Function GetDiskLarge(Disk : Char) : String;
var
    driver:pchar;
    sec1, byt1, cl1, cl2:longword;
begin
    driver:=PChar(Disk+':\');  //要显示的驱动器名
    GetDiskFreeSpace(driver, sec1, byt1, cl1, cl2);
    cl1 := cl1 * sec1 * byt1;
    cl2 := cl2 * sec1 * byt1;
    Result := '该驱动器总共容量' + Formatfloat('###,##0',cl2) + '字节' +#13+#13+
              '该驱动器可用容量' + Formatfloat('###,##0',cl1) + '字节' ;

end;

Procedure TForm1.SetCDAutoRun(AAutoRun:Boolean);
const
  DoAutoRun : array[Boolean] of Integer = (0,1);
var
  Reg:TRegistry;
begin
  Reg := TRegistry.Create;
  try
    Reg.RootKey := HKEY_LOCAL_MACHINE;
    if Reg.KeyExists('System\CurrentControlSet\Services\Class\CDROM') then
      if Reg.OpenKey('System\CurrentControlSet\Services\Class\CDROM',FALSE) then
        Reg.WriteBinaryData('AutoRun',DoAutoRun[AAutoRun],1);
  finally
    Reg.Free;
  end;
  MessageBox(handle,'你的设置在Windows重新启动后将生效','信息',MB_IconInformation+MB_OK);
End ;

procedure TForm1.Button1Click(Sender: TObject);
begin
  SetCDAutoRun(True);
end;

function DiskInDrive(Drive: Char): Boolean;
var
  ErrorMode: word;
begin
  if Drive in ['a'..'z'] then Dec(Drive, $20); //make it upper case
  if not (Drive in ['A'..'Z']) then //make sure it's a letter
  raise
    EConvertError.Create('Not a valid drive ID'); //turn off critical errors
    ErrorMode :=SetErrorMode(SEM_FailCriticalErrors);
  try

  if DiskSize(Ord(Drive) - $40)=-1 then //drive 1=a, 2=b, 3=c, etc.
                                         Result :=False
                                    else Result :=True;
  finally
  SetErrorMode(ErrorMode); //restore old error mode
  End ;
end;

function GetDiskVolSerialID(cDriveName : char ) : DWord;
var
  dwTemp1,
  dwTemp2 : DWord;
begin
  GetVolumeInformation(
    PChar( cDriveName + ':\' ),  // address of root directory of the file system
    Nil,                          // address of name of the volume
    0,                            // length of lpVolumeNameBuffer
    @Result,                      // address of volume serial number
    dwTemp1,                      // address of system's maximum filename length
    dwTemp2,                      // address of file system flags
    Nil,                          // address of name of file system
    0                             // length of lpFileSystemNameBuffer
   );
end;


procedure TForm1.Button2Click(Sender: TObject);
Var
  TempStr : String ;
begin
  TempStr := Edit1.Text ;
  if DiskInDrive(TempStr[1]) Then ShowMessage('有盘')
                             Else ShowMessage('无盘')
end;

procedure TForm1.BitBtn1Click(Sender: TObject);
begin
  mciSendString('Set cdaudio door open wait', nil, 0, handle);  //打开光驱
end;

procedure TForm1.BitBtn2Click(Sender: TObject);
begin
  mciSendString('Set cdaudio door closed wait', nil, 0, handle); //关闭光驱
end;

procedure TForm1.Button3Click(Sender: TObject);
Var
  tempStr : String ;
begin
  TempStr := Edit1.Text ;
  TempStr := GetDiskType(TempStr[1]) ;
  ShowMessage(TempStr) ;
end;

procedure TForm1.Button4Click(Sender: TObject);
Var
  tempStr : string;
begin
  TempStr := Edit1.Text ;
  TempStr := GetDiskLarge(TempStr[1]) ;
  ShowMessage(TempStr) ;
end;

end.