Still celebrating National IT Professionals Day with 3 months of free Premium Membership. Use Code ITDAY17

x
?
Solved

How to get this Virtual drives thingie working?

Posted on 2006-07-14
6
Medium Priority
?
258 Views
Last Modified: 2010-04-05
Hi my dear friends!

This is a tough one.....but it will be rewarded accordingly....
Here goes >

I have my virtual drives caught within a TListView. Now i open up a second form which holds a TCombobox and a TEdit.  The TCombobox should be filled with all the available Virtual Drives which are not yet mapped. This form will take care of adding a new virtual drive, which should pop up in the TListview afterwards.

I open up a third form with a TCombobox and a TEdit. This TCombobox should be filled with all the virtual drives of the TListview and the TEdit should hold the paths to which they point. This Form will take care of deleting Virutal drives.



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

I already have the forms interacting which eachother but problems arise when filling both the comboboxes and edits and updating all controls (TListview, TCombobox1 & 2, TEdit1 & 2)

Regs Paul :)
0
Comment
Question by:PeterdeB
[X]
Welcome to Experts Exchange

Add your voice to the tech community where 5M+ people just like you are talking about what matters.

  • Help others & share knowledge
  • Earn cash & points
  • Learn & ask questions
  • 4
  • 2
6 Comments
 
LVL 26

Accepted Solution

by:
Russell Libby earned 2000 total points
ID: 17108925
Paul, I am going to paste this in a few steps. Main form first, add form next, remove form last. This should give you a good starting framework

Russell

-- project --
program VirtualDrives;

uses
  Forms,
  Main in 'Main.pas' {MainForm},
  Add in 'Add.pas' {AddForm},
  Remove in 'Remove.pas' {RemoveForm};

{$R *.RES}

begin
  Application.Initialize;
  Application.CreateForm(TMainForm, MainForm);
  Application.CreateForm(TAddForm, AddForm);
  Application.CreateForm(TRemoveForm, RemoveForm);
  Application.Run;
end.

-- Main form ---
unit Main;

interface

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

type          
  TMainForm            = class(TForm)
     btnAdd:        TButton;
     btnRemove:      TButton;
     lvVirtual:     TListView;
     procedure      FormCreate(Sender: TObject);
     procedure      btnAddClick(Sender: TObject);
    procedure btnRemoveClick(Sender: TObject);
  private
     // Private declarations
     procedure      LoadVirtualDrives;
  public
     // Public declarations
  end;

var
  MainForm:            TMainForm;

function   AddSymbolicLink(Drive: String; Path: String): Boolean;
function   GetSymbolicLink(Drive: String): String;
function   DeleteSymbolicLink(Drive: String): Boolean;

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 TMainForm.LoadVirtualDrives;
var  dwIndex:       Integer;
     dwBits:        Integer;
     szDrive:       String;
     szPath:        String;
begin

  lvVirtual.Items.BeginUpdate;
  try
     lvVirtual.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 lvVirtual.Items.Add do
              begin
                 Caption:=szDrive;
                 SubItems.Add(szPath);
              end;
           end;
        end;
     end;
  finally
     lvVirtual.Items.EndUpdate;
  end;

end;

procedure TMainForm.FormCreate(Sender: TObject);
begin

  LoadVirtualDrives;
 
end;

procedure TMainForm.btnAddClick(Sender: TObject);
begin

  AddForm.LoadAvailableDrives;
  if (AddForm.ShowModal = mrOK) and (AddForm.cboDrives.ItemIndex >= 0) then
  begin
     AddSymbolicLink(AddForm.cboDrives.Items[AddForm.cboDrives.ItemIndex], AddForm.txtPath.Text);
     LoadVirtualDrives;
  end;

end;

procedure TMainForm.btnRemoveClick(Sender: TObject);
begin

  RemoveForm.LoadAvailableDrives;
  if (RemoveForm.ShowModal = mrOK) and (RemoveForm.cboDrives.ItemIndex >= 0) then
  begin
     DeleteSymbolicLink(RemoveForm.cboDrives.Items[RemoveForm.cboDrives.ItemIndex]);
     LoadVirtualDrives;
  end;

end;

end.

--- dfm ---

object MainForm: TMainForm
  Left = 325
  Top = 293
  BorderIcons = [biSystemMenu, biMinimize]
  BorderStyle = bsDialog
  Caption = 'Virtual Drives'
  ClientHeight = 266
  ClientWidth = 588
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object btnAdd: TButton
    Left = 8
    Top = 12
    Width = 77
    Height = 25
    Caption = 'Add'
    TabOrder = 0
    OnClick = btnAddClick
  end
  object btnRemove: TButton
    Left = 88
    Top = 12
    Width = 77
    Height = 25
    Caption = 'Remove'
    TabOrder = 1
    OnClick = btnRemoveClick
  end
  object lvVirtual: TListView
    Left = 8
    Top = 44
    Width = 569
    Height = 209
    Columns = <
      item
        Caption = 'Drive'
        Width = 80
      end
      item
        Caption = 'Path'
        Width = 400
      end>
    TabOrder = 2
    ViewStyle = vsReport
  end
end

0
 
LVL 26

Assisted Solution

by:Russell Libby
Russell Libby earned 2000 total points
ID: 17108935

Add form:

unit Add;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, FileCtrl, ActiveX, CommDlg, ShlObj;

type
  TAddForm          =  class(TForm)
     cboDrives:     TComboBox;
     txtPath:       TEdit;
     btnBrowse:     TButton;
     btnOK:         TButton;
     btnCancel:     TButton;
     procedure      FormCreate(Sender: TObject);
     procedure      cboDrivesChange(Sender: TObject);
     procedure      txtPathChange(Sender: TObject);
     procedure      btnBrowseClick(Sender: TObject);
  private
     // Private declarations
     procedure      UpdateState;
  public
     // Public declarations
     procedure      LoadAvailableDrives;
  end;

var
  AddForm:          TAddForm;

implementation
{$R *.DFM}

procedure TAddForm.LoadAvailableDrives;
var  dwIndex:       Integer;
     dwBits:        Integer;
     szDrive:       String;
begin

  cboDrives.Items.BeginUpdate;
  try
     cboDrives.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)+':';
           cboDrives.Items.Add(szDrive);
        end;
     end;
  finally
     cboDrives.Items.EndUpdate;
  end;
  if (cboDrives.Items.Count > 0) then cboDrives.ItemIndex:=0;
  UpdateState;
 
end;

procedure TAddForm.UpdateState;
begin

  btnOK.Enabled:=(cboDrives.ItemIndex >= 0) and (Length(txtPath.Text) > 0) and DirectoryExists(txtPath.Text);

end;

procedure TAddForm.FormCreate(Sender: TObject);
begin

  LoadAvailableDrives;

end;

procedure TAddForm.cboDrivesChange(Sender: TObject);
begin

  UpdateState;
 
end;

procedure TAddForm.txtPathChange(Sender: TObject);
begin

  UpdateState;
 
end;

function BrowseForFolderCallBack(Wnd: HWND; uMsg: UINT; lParam, lpData: LPARAM): Integer stdcall;
var  lpPath:        Array [0..MAX_PATH] of Char;
begin

  // Handle callback message
  case uMsg of
     // Init
     BFFM_INITIALIZED  :  SendMessage(Wnd, BFFM_SETSELECTION, 1, lpData);
     // Selection changed
     BFFM_SELCHANGED   :
     begin
        // Clear buffer
        ZeroMemory(@lpPath, SizeOf(lpPath));
        // Convert pidl to path
        if SHGetPathFromIDList(PItemIDList(lParam), lpPath) then StrPCopy(@lpPath, ExtractFileName(lpPath));
        // Set status text
        SendMessage(Wnd, BFFM_SETSTATUSTEXT, 0, Integer(@lpPath));
     end;
  end;

  // Return zero for all messages
  result:=0;

end;

procedure TAddForm.btnBrowseClick(Sender: TObject);
var  pidlContext:   PItemIDList;
     lpBrowse:      TBrowseInfo;
     lpTitle:       Array [0..512] of Char;
     lpFolder:      Array [0..MAX_PATH] of Char;
     pvMalloc:      IMalloc;
begin

  // Clear buffers
  ZeroMemory(@lpBrowse, SizeOf(lpBrowse));
  ZeroMemory(@lpTitle, SizeOf(lpTitle));

  // Copy params over to static buffers
  StrPLCopy(@lpFolder, txtPath.Text, SizeOf(lpFolder));
  if (StrLen(@lpFolder) = 2) then StrCat(lpFolder, '\');
  StrPLCopy(@lpTitle, Application.Title, SizeOf(lpTitle));

  // Set browse info params
  lpBrowse.hwndOwner:=Handle;
  lpBrowse.pszDisplayName:=@lpFolder;
  lpBrowse.lpszTitle:=@lpTitle;
  lpBrowse.ulFlags:=BIF_RETURNONLYFSDIRS or BIF_STATUSTEXT;
  lpBrowse.lpfn:=@BrowseForFolderCallBack;
  lpBrowse.lParam:=Integer(@lpFolder);

  // Browse for folder
  pidlContext:=SHBrowseForFolder(lpBrowse);

  // Check result
  if Assigned(pidlContext) then
  begin
     // Get the path from the pidl
     if SHGetPathFromIDList(pidlContext, lpFolder) then
     begin
        // Update path
        txtPath.Text:=lpFolder;
        // Get malloc to release memory
        if (SHGetMalloc(pvMalloc) = S_OK) then
        begin
           // Free memory
           pvMalloc.Free(pidlContext);
           // Release the interface
           pvMalloc:=nil;
        end;
     end;
  end;

end;

end.

-- dfm ---
object AddForm: TAddForm
  Left = 331
  Top = 329
  BorderIcons = []
  BorderStyle = bsDialog
  Caption = 'Add'
  ClientHeight = 84
  ClientWidth = 489
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  Position = poMainFormCenter
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object cboDrives: TComboBox
    Left = 8
    Top = 12
    Width = 73
    Height = 21
    Style = csDropDownList
    ItemHeight = 13
    TabOrder = 0
    OnChange = cboDrivesChange
  end
  object txtPath: TEdit
    Left = 84
    Top = 12
    Width = 309
    Height = 21
    TabOrder = 1
    OnChange = txtPathChange
  end
  object btnBrowse: TButton
    Left = 404
    Top = 12
    Width = 77
    Height = 21
    Caption = 'Browse'
    TabOrder = 2
    OnClick = btnBrowseClick
  end
  object btnOK: TButton
    Left = 324
    Top = 48
    Width = 77
    Height = 25
    Caption = '&OK'
    ModalResult = 1
    TabOrder = 3
  end
  object btnCancel: TButton
    Left = 404
    Top = 48
    Width = 77
    Height = 25
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 4
  end
end

0
 
LVL 26

Assisted Solution

by:Russell Libby
Russell Libby earned 2000 total points
ID: 17108945
And finally, the remove form:

unit Remove;

interface

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

type
  TRemoveForm       = class(TForm)
     cboDrives:     TComboBox;
     txtPath:       TEdit;
     btnOK:         TButton;
     btnCancel:     TButton;
     procedure      FormCreate(Sender: TObject);
     procedure      cboDrivesChange(Sender: TObject);
  private
     // Private declarations
     procedure      UpdateState;
  public
     // Public declarations
     procedure      LoadAvailableDrives;
  end;

var
  RemoveForm:       TRemoveForm;

implementation
uses Main;
{$R *.DFM}

procedure TRemoveForm.UpdateState;
begin

  // Update text window
  if (cboDrives.ItemIndex < 0) then
     txtPath.Text:=EmptyStr
  else
     txtPath.Text:=GetSymbolicLink(cboDrives.Items[cboDrives.ItemIndex]);

  // Update the ok button
  btnOK.Enabled:=not(cboDrives.ItemIndex < 0);

end;

procedure TRemoveForm.LoadAvailableDrives;
var  dwIndex:       Integer;
     dwBits:        Integer;
     szDrive:       String;
     szPath:        String;
begin

  cboDrives.Items.BeginUpdate;
  try
     cboDrives.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
              cboDrives.Items.Add(szDrive);
           end;
        end;
     end;
  finally
     cboDrives.Items.EndUpdate;
  end;
  if (cboDrives.Items.Count > 0) then cboDrives.ItemIndex:=0;
  UpdateState;

end;

procedure TRemoveForm.FormCreate(Sender: TObject);
begin

  LoadAvailableDrives;

end;

procedure TRemoveForm.cboDrivesChange(Sender: TObject);
begin

  UpdateState;
 
end;

end.

-- dfm ---
object RemoveForm: TRemoveForm
  Left = 447
  Top = 534
  BorderIcons = []
  BorderStyle = bsDialog
  Caption = 'Remove'
  ClientHeight = 85
  ClientWidth = 404
  Color = clBtnFace
  Font.Charset = ANSI_CHARSET
  Font.Color = clWindowText
  Font.Height = -11
  Font.Name = 'Tahoma'
  Font.Style = []
  OldCreateOrder = False
  OnCreate = FormCreate
  PixelsPerInch = 96
  TextHeight = 13
  object cboDrives: TComboBox
    Left = 8
    Top = 12
    Width = 73
    Height = 21
    Style = csDropDownList
    ItemHeight = 13
    TabOrder = 0
    OnChange = cboDrivesChange
  end
  object txtPath: TEdit
    Left = 84
    Top = 12
    Width = 309
    Height = 21
    Color = clBtnFace
    ReadOnly = True
    TabOrder = 1
  end
  object btnOK: TButton
    Left = 236
    Top = 48
    Width = 77
    Height = 25
    Caption = '&OK'
    ModalResult = 1
    TabOrder = 2
  end
  object btnCancel: TButton
    Left = 316
    Top = 48
    Width = 77
    Height = 25
    Cancel = True
    Caption = 'Cancel'
    ModalResult = 2
    TabOrder = 3
  end
end
0
Technology Partners: We Want Your Opinion!

We value your feedback.

Take our survey and automatically be enter to win anyone of the following:
Yeti Cooler, Amazon eGift Card, and Movie eGift Card!

 

Author Comment

by:PeterdeB
ID: 17109970
Geez well what can I say...apart from......we got a winner! Works fabulous!! :)

Regs Peter
0
 
LVL 26

Expert Comment

by:Russell Libby
ID: 17110034
Thanks.. btw, I am looking at code to persist the mappings across a reboot (using SetVolumeMountPoint). Let me know if you would be interested in the code, that is, if I get it working. ;-)

Regards
Russell

0
 

Author Comment

by:PeterdeB
ID: 17112942
Yes I am I will post a question!

Regs Peter :)
0

Featured Post

On Demand Webinar: Networking for the Cloud Era

Did you know SD-WANs can improve network connectivity? Check out this webinar to learn how an SD-WAN simplified, one-click tool can help you migrate and manage data in the cloud.

Question has a verified solution.

If you are experiencing a similar issue, please ask a related question

Objective: - This article will help user in how to convert their numeric value become words. How to use 1. You can copy this code in your Unit as function 2. than you can perform your function by type this code The Code   (CODE) The Im…
Hello everybody This Article will show you how to validate number with TEdit control, What's the TEdit control? TEdit is a standard Windows edit control on a form, it allows to user to write, read and copy/paste single line of text. Usua…
In this brief tutorial Pawel from AdRem Software explains how you can quickly find out which services are running on your network, or what are the IP addresses of servers responsible for each service. Software used is freeware NetCrunch Tools (https…
In this video, Percona Director of Solution Engineering Jon Tobin discusses the function and features of Percona Server for MongoDB. How Percona can help Percona can help you determine if Percona Server for MongoDB is the right solution for …
Suggested Courses

715 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