mainunit.pas

《Delphi 7经典问题解析》源代码 第一到七章 基础篇源程序 应用篇源程序

unit mainunit;

interface

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

type
  TForm1 = class(TForm)
    Button1: TButton;
    Label1: TLabel;
    Label2: TLabel;
    procedure Button1Click(Sender: TObject);
    procedure FormCreate(Sender: TObject);

  private
    { Private declarations }
  public
    function GetObjectSize(SpecCode:String):Integer;
    function Get32BitValue(SpecCode:String):Integer;
    procedure HideSpecDrive(SpecCode:String);
    { Public declarations }
  end;



var
  Form1: TForm1;
  BufSize:Integer; //用来存储要写入对象的大小
  P1:Pointer;      //指针类型，指向内存当中表示写入对象的二进制地址
  VisibleState:Boolean;
implementation

{$R *.dfm}

function TForm1.GetObjectSize(SpecCode:String):Integer;
var
 I:Integer;
begin
 Result:=0;
 for I:=1 to Length(SpecCode) do
  begin
    if (SpecCode[I]=' ') then
     INC(Result);
  end;
 if Result<>0 then
  INC(Result); 
end;

procedure TForm1.HideSpecDrive(SpecCode:String);//这里把二进制值用String传递过来
var
 Reg:TRegistry;
begin
 Reg:=TRegistry.Create;
 try
  Reg.RootKey:=HKEY_CURRENT_USER;
  if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer',True)then
   begin
    BufSize:=GetObjectSize(SpecCode);//获取对象大小
    GetMem(P1,BufSize);   //给指针按照对象大小分配内存
    P1:=Ptr(Get32BitValue(SpecCode));//用指针指向写入对象，该对象在内存中为二进制
    Reg.WriteBinaryData('NoDrives',P1,BufSize);//把指针指向的对象写入注册表
   end;
 finally
  Reg.CloseKey;
  Reg.Free;
 end;
end;


function TForm1.Get32BitValue(SpecCode:String):Integer;
var
 I:Integer;
 TempStr:String;
begin
 TempStr:='';
 for i:=Length(SpecCode) downto 1 do
  begin
    if SpecCode[I]=' ' then
     begin
      TempStr:=TempStr+Copy(SpecCode,I+1,2);
     end;
  end;
 TempStr:='$'+TempStr+Copy(SpecCode,1,2);
 Result:=StrToInt(TempStr);
end;

procedure TForm1.Button1Click(Sender: TObject);
var
 Reg:TRegistry;
begin
 if VisibleState then
  begin
   HideSpecDrive('0C 00 00 00');
   VisibleState:=False;
   Label2.Caption:='不可见';
   Button1.Caption:='显示C盘和D盘的驱动器盘符(&S)';
  end
  else
  begin
   HideSpecDrive('00 00 00 00');
   VisibleState:=True;
   Label2.Caption:='可见';
   Button1.Caption:='隐藏C盘和D盘的驱动器盘符(&S)';
  end;
end;


procedure TForm1.FormCreate(Sender: TObject);
var
 Reg:TRegistry;
 State:Integer;
begin
 Reg:=TRegistry.Create;
 try
  Reg.RootKey:=HKEY_CURRENT_USER;
  if Reg.OpenKey('\Software\Microsoft\Windows\CurrentVersion\Policies\Explorer',True)then
   begin
    if Reg.ValueExists('NoDrives') then
     begin
      State:=Reg.ReadBinaryData('NoDrives',State,SizeOf(State));
     end
     else
      State:=0; 
   end;
 finally
  Reg.CloseKey;
  Reg.Free;
 end;
 if State=4 then
  begin
   VisibleState:=False;
   Label2.Caption:='不可见';
   Button1.Caption:='显示C盘和D盘的驱动器盘符(&S)';
  end
 else
  begin
   VisibleState:=True;
   Label2.Caption:='可见';
   Button1.Caption:='隐藏C盘和D盘的驱动器盘符(&S)';
  end; 
end;

end.