Solved

How to fill my TListview with solely virtual drives?

Posted on 2006-07-14
3
265 Views
Last Modified: 2013-11-15
Hi my dear friends!

At this moment I'm occupied with making some Virtual Drives Manager program. Now I'm figuring out how to distinguish hard drives & cdrom from the virtual drives to prevent the first from bubbling up in my TListview. In the form create event it adds the items to the TListview. It currently adds all drives & cdroms. Now I would like to leave out all harddrives & cdroms.

All is based upon RLibby's post: http://www.experts-exchange.com/Programming/Programming_Languages/Delphi/Q_20855893.html. So the solution should interact with the SymLink.pas unit prefferably.

All yours :)

Regs Peter

0
Comment
Question by:PeterdeB
  • 2
3 Comments
 
LVL 26

Accepted Solution

by:
Russell Libby earned 250 total points
Comment Utility
Example code

Regads,
Russell

----

unit Unit1;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  ComCtrls;

type
  TForm1 = class(TForm)
    ListView1: TListView;
    procedure FormCreate(Sender: TObject);
  private
    { Private declarations }
  public
    { Public declarations }
  end;

var
  Form1: TForm1;

implementation
{$R *.DFM}

function GetSymbolicLink(Drive: String): String;
var  lpszPath:      Array [0..MAX_PATH] of Char;
     lpszDrive:     Array [0..2] of Char;
     lpszReturn:    PChar;
     dwSize:        DWORD;
begin

  // Copy the first 2 bytes of the drive over (we only need the X:)
  StrPLCopy(@lpszDrive, Drive, 2);

  // Null terminate
  lpszDrive[2]:=#0;

  // Allocate space for the result
  SetLength(result, MAX_PATH);

  // Query the DOS device
  dwSize:=QueryDosDevice(@lpszDrive, @lpszPath, MAX_PATH);

  // Set the length of the result
  if (dwSize > 0) then
  begin
     // Get pointer to string
     lpszReturn:=@lpszPath;
     // Check for path setting
     if (StrLComp(lpszReturn, '\??\', 4) = 0) or (StrLComp(lpszReturn, '\\.\', 4) = 0) then Inc(lpszReturn, 4);
     // Convert to string result
     SetString(result, lpszReturn, StrLen(lpszReturn));
  end
  else
     SetLength(result, 0);

end;

function DeleteSymbolicLink(Drive: String): Boolean;
var  lpszDrive:  Array [0..2] of Char;
begin

  // Copy the first 2 bytes of the drive over (we only need the X:)
  StrPLCopy(@lpszDrive, Drive, 2);

  // Null terminate
  lpszDrive[2]:=#0;

  // Delete the symbolic link
  result:=DefineDosDevice(DDD_REMOVE_DEFINITION, @lpszDrive, nil);

end;

function AddSymbolicLink(Drive: String; Path: String): Boolean;
var  lpszDrive:  Array [0..2] of Char;
begin

  // Copy the first 2 bytes of the drive over (we only need the X:)
  StrPLCopy(@lpszDrive, Drive, 2);

  // Null terminate
  lpszDrive[2]:=#0;

  // Define the DOS device
  if (Length(Path) > 0) then
  begin
     // Check for \ starting the path, which is an indicator for raw type
     if (Path[1] = '\') then
        result:=DefineDosDevice(DDD_RAW_TARGET_PATH, @lpszDrive, PChar(Path))
     else
        result:=DefineDosDevice(0, @lpszDrive, PChar(Path));
  end
  else
     // No path specified
     result:=False;

end;

procedure TForm1.FormCreate(Sender: TObject);
var  dwIndex:       Integer;
     dwBits:        Integer;
     szDrive:       String;
     szPath:        String;
begin

  ListView1.Items.BeginUpdate;
  try
     ListView1.Items.Clear;
     dwBits:=GetLogicalDrives;
     for dwIndex:=0 to 25 do
     begin
        if ((dwBits and (1 shl dwIndex)) <> 0) then
        begin
           szDrive:=Chr(Ord('A') + dwIndex)+':';
           szPath:=GetSymbolicLink(szDrive);
           if (Length(szPath) > 2) and (szPath[2] = ':') then
           begin
              with ListView1.Items.Add do
              begin
                 Caption:=szDrive;
                 SubItems.Add(szPath);
              end;
           end;
        end;
     end;
  finally
     ListView1.Items.EndUpdate;
  end;

end;

end.

--- dfm ---
object Form1: TForm1
  Left = 185
  Top = 159
  Width = 652
  Height = 295
  Caption = 'Form1'
  Color = clBtnFace
  Font.Charset = DEFAULT_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'MS Sans Serif'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object ListView1: TListView
    Left = 12
    Top = 12
    Width = 621
    Height = 225
    Columns = <
      item
        Caption = 'Drive'
        Width = 80
      end
      item
        Caption = 'Path'
        Width = 400
      end>
    TabOrder = 0
    ViewStyle = vsReport
  end
end

0
 

Author Comment

by:PeterdeB
Comment Utility
Oeps you did it again!

Regs Paul :)
0
 
LVL 26

Expert Comment

by:Russell Libby
Comment Utility
Lol, thanks.
Russell
0

Featured Post

Find Ransomware Secrets With All-Source Analysis

Ransomware has become a major concern for organizations; its prevalence has grown due to past successes achieved by threat actors. While each ransomware variant is different, we’ve seen some common tactics and trends used among the authors of the malware.

Join & Write a Comment

By default, Carbonite Server Backup manages your encryption key for you using Advanced Encryption Standard (AES) 128-bit encryption. If you choose to manage your private encryption key, your backups will be encrypted using AES 256-bit encryption.
Microservice architecture adoption brings many advantages, but can add intricacy. Selecting the right orchestration tool is most important for business specific needs.
This tutorial will walk an individual through the steps necessary to install and configure the Windows Server Backup Utility. Directly connect an external storage device such as a USB drive, or CD\DVD burner: If the device is a USB drive, ensure i…
This tutorial will walk an individual through setting the global and backup job media overwrite and protection periods in Backup Exec 2012. Log onto the Backup Exec Central Administration Server. Examine the services. If all or most of them are stop…

743 members asked questions and received personalized solutions in the past 7 days.

Join the community of 500,000 technology professionals and ask your questions.

Join & Ask a Question

Need Help in Real-Time?

Connect with top rated Experts

16 Experts available now in Live!

Get 1:1 Help Now