Chinaunix首页 | 论坛 | 博客
  • 博客访问: 1228822
  • 博文数量: 788
  • 博客积分: 4000
  • 博客等级: 上校
  • 技术积分: 7005
  • 用 户 组: 普通用户
  • 注册时间: 2008-08-19 15:52
文章存档

2017年(81)

2011年(1)

2009年(369)

2008年(337)

分类:

2009-02-11 16:54:28



如题多谢。

unit   Unit1;  
   
  interface  
   
  uses  
      Windows,   Messages,   SysUtils,   Variants,   Classes,   Graphics,   Controls,   Forms,  
      Dialogs,   StdCtrls;  
   
  type  
      TForm1   =   class(TForm)  
          btn1:   TButton;  
          procedure   btn1Click(Sender:   TObject);  
          procedure   FormCreate(Sender:   TObject);  
          procedure   FormDestroy(Sender:   TObject);  
      private  
          {   Private   declarations   }  
          nmg_tsTemp:   TStringList;  
          function   DriveAvail:   Boolean;  
      public  
          {   Public   declarations   }  
      end;  
   
  var  
      Form1:   TForm1;  
   
  implementation  
   
  {$R   *.dfm}  
   
  function   TForm1.DriveAvail:Boolean;  
  var  
      r   :   LongWord;  
      Drives:   array[0..128]   of   Char;  
      pDrive:   PChar;  
  begin  
      Result:=False;  
      ZeroMemory(@Drives,   SizeOf(Drives));  
      r   :=   GetLogicalDriveStrings(SizeOf(Drives),   Drives);  
      if   r   =   0   then   Exit;  
      if   r   >   SizeOf(Drives)   then  
      begin  
          raise   Exception.Create(SysErrorMessage(ERROR_OUTOFMEMORY));  
      end;  
      pDrive   :=   Drives;  
      while   pDrive^   <>   #0   do  
      begin  
          if   GetDriveType(pDrive)   =   DRIVE_FIXED   then  
          begin  
              nmg_tsTemp.Add(StrPas(pDrive));  
          end;  
          inc(pDrive,   4);  
      end;  
      Result   :=   True;  
  end;  
   
  procedure   TForm1.btn1Click(Sender:   TObject);  
  var  
      I:   Integer;  
  begin  
      DriveAvail;  
      for   I   :=   nmg_tsTemp.Count   -   1   downto   0   do  
          ShowMessage(nmg_tsTemp.Strings[i]);  
  end;  
   
  procedure   TForm1.FormCreate(Sender:   TObject);  
  begin  
      nmg_tsTemp   :=   TStringList.Create;  
  end;  
   
  procedure   TForm1.FormDestroy(Sender:   TObject);  
  begin  
      nmg_tsTemp.Free;  
  end;  
   
  end.

5分,楼主没"人性",呵呵,

阅读(500) | 评论(0) | 转发(0) |
给主人留下些什么吧!~~