Solved

How to get this Virtual drives thingie working?

Posted on 2006-07-14
6
251 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
  • 4
  • 2
6 Comments
 
LVL 26

Accepted Solution

by:
Russell Libby earned 500 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 500 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 500 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
Netscaler Common Configuration How To guides

If you use NetScaler you will want to see these guides. The NetScaler How To Guides show administrators how to get NetScaler up and configured by providing instructions for common scenarios and some not so common ones.

 

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

Microsoft Certification Exam 74-409

Veeam® is happy to provide the Microsoft community with a study guide prepared by MVP and MCT, Orin Thomas. This guide will take you through each of the exam objectives, helping you to prepare for and pass the examination.

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…
Email security requires an ever evolving service that stays up to date with counter-evolving threats. The Email Laundry perform Research and Development to ensure their email security service evolves faster than cyber criminals. We apply our Threat…
Nobody understands Phishing better than an anti-spam company. That’s why we are providing Phishing Awareness Training to our customers. According to a report by Verizon, only 3% of targeted users report malicious emails to management. With compan…

770 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